Add From/ToPy instances for 2-tuples

Author: Shimuuar

cbits/python.c

@@ -43,6 +43,45 @@ PyObject *inline_py_function_wrapper(PyCFunction fun, int flags) {
     return f;    
 }
 
+int inline_py_unpack_iterable(PyObject *iterable, int n, PyObject **out) {
+    // Fill out with NULL. This way we can call XDECREF on them
+    for(int i = 0; i < n; i++) {
+        out[i] = NULL;
+    }
+    // Initialize iterator
+    PyObject* iter = PyObject_GetIter( iterable );
+    if( PyErr_Occurred() ) {
+        return -1;
+    }
+    if( !PyIter_Check(iter) ) {
+        goto err_iter;
+    }
+    // Fill elements
+    for(int i = 0; i < n; i++) {
+        out[i] = PyIter_Next(iter);
+        if( NULL==out[i] ) {
+            goto err_elem;
+        }
+    }
+    // End of iteration
+    PyObject* end = PyIter_Next(iter);
+    if( NULL != end || PyErr_Occurred() ) {
+        goto err_end;
+    }
+    return 0;
+    //----------------------------------------
+err_end:
+    Py_XDECREF(end);
+err_elem:
+    for(int i = 0; i < n; i++) {
+        Py_XDECREF(out[i]);
+    }
+err_iter:
+    Py_DECREF(iter);
+    return -1;
+}
+
+
 void inline_py_free_capsule(PyObject* py) {
     PyMethodDef *meth = PyCapsule_GetPointer(py, NULL);
     // HACK: We want to release wrappers created by wrapper. It

include/inline-python.h

@@ -10,6 +10,8 @@
 #define INLINE_PY_ERR_COMPILE 1
 #define INLINE_PY_ERR_EVAL    2
 
+
+
 // This macro checks for errors. If python exception is raised it
 // clear it and returns 1 otherwise retruns 0
 #define INLINE_PY_SIMPLE_ERROR_HANDLING() do {      \
@@ -29,6 +31,20 @@ void inline_py_export_exception(
     char** p_msg
     );
 
+// Unpack iterable into array of PyObjects. Iterable must contain
+// exactly N elements.
+//
+// On success returns 0 and fills `out` with N PyObjects
+//
+// On failure returns -1. Python exception is not cleared. It's
+// responsibility of caller to deal with it. Content of `out` is
+// undefined in this case.
+int inline_py_unpack_iterable(
+    PyObject  *iterable,
+    int        n,
+    PyObject **out
+    );
+
 // Allocate python function object which carrries its own PyMethodDef.
 // Returns function object or NULL with error raised.
 //

src/Python/Inline/Literal.hs

@@ -13,6 +13,7 @@ module Python.Inline.Literal
 import Control.Exception
 import Control.Monad
 import Control.Monad.IO.Class
+import Control.Monad.Trans.Class
 import Control.Monad.Trans.Cont
 import Data.Int
 import Data.Word
@@ -28,6 +29,7 @@ import Language.C.Inline.Unsafe  qualified as CU
 import Python.Types
 import Python.Internal.Types
 import Python.Internal.Eval
+import Python.Internal.Util
 
 
 ----------------------------------------------------------------
@@ -163,6 +165,38 @@ instance FromPy Bool where
       1 -> pure $ Just True
       _ -> pure $ Nothing
 
+instance (ToPy a, ToPy b) => ToPy (a,b) where
+  basicToPy (a,b) = do
+    p_a <- basicToPy a
+    p_b <- basicToPy b
+    Py [CU.exp| PyObject* { PyTuple_Pack(2, $(PyObject* p_a), $(PyObject* p_b)) } |]
+
+instance (FromPy a, FromPy b) => FromPy (a,b) where
+  basicFromPy p_tup = evalContT $ do
+    -- Unpack 2-tuple.
+    p_args    <- withPyAllocaArray 2
+    unpack_ok <- liftIO [CU.exp| int {
+      inline_py_unpack_iterable($(PyObject *p_tup), 2, $(PyObject **p_args))
+      }|]
+    -- We may want to extract exception to haskell side later
+    liftIO [CU.exp| void { PyErr_Clear() } |]
+    when (unpack_ok /= 0) $ abort $ pure Nothing
+    -- Unpack 2-elements
+    lift $ do
+      p_a <- liftIO $ peekElemOff p_args 0
+      p_b <- liftIO $ peekElemOff p_args 1
+      let parse = basicFromPy p_a >>= \case
+            Nothing -> pure Nothing
+            Just a  -> basicFromPy p_b >>= \case
+              Nothing -> pure Nothing
+              Just b  -> pure $ Just (a,b)
+          fini  = liftIO [CU.block| void {
+            Py_XDECREF( $(PyObject* p_a) );
+            Py_XDECREF( $(PyObject* p_b) );
+            } |]
+      parse `finallyPy` fini
+
+
 
 ----------------------------------------------------------------
 -- Functions marshalling

src/Python/Internal/Types.hs

@@ -10,6 +10,7 @@ module Python.Internal.Types
     PyObject(..)
   , PyError(..)
   , Py(..)
+  , finallyPy
     -- * inline-C
   , pyCtx
     -- * Patterns
@@ -20,6 +21,7 @@ module Python.Internal.Types
 
 import Control.Exception
 import Control.Monad.IO.Class
+import Data.Coerce
 import Data.Map.Strict           qualified as Map
 import Foreign.ForeignPtr
 import Foreign.C.Types
@@ -50,6 +52,8 @@ newtype Py a = Py (IO a)
   deriving newtype (Functor,Applicative,Monad,MonadIO,MonadFail)
 -- See NOTE: [Python and threading]
 
+finallyPy :: forall a b. Py a -> Py b -> Py a
+finallyPy = coerce (finally @a @b)
 
 ----------------------------------------------------------------
 -- inline-C

src/Python/Internal/Util.hs

@@ -25,6 +25,9 @@ withWCtring = withArray0 (CWchar 0) . map (fromIntegral . ord)
 withPyAlloca :: forall a r. Storable a => ContT r Py (Ptr a)
 withPyAlloca = coerce (alloca @a @r)
 
+withPyAllocaArray :: forall a r. Storable a => Int -> ContT r Py (Ptr a)
+withPyAllocaArray = coerce (allocaArray @a @r)
+
 withPyCString :: forall r. String -> ContT r Py CString
 withPyCString = coerce (withCString @r)
 

test/TST/FromPy.hs

@@ -34,6 +34,13 @@ tests = testGroup "FromPy"
         -- Segfaults if exception is not cleared
         [py_| 1+1 |]
     ]
+  , testGroup "Tuple2"
+    [ testCase "(2)->2" $ eq @(Int,Bool) (Just (2,True)) =<< [pye| (2,2) |]
+    , testCase "[2]->2" $ eq @(Int,Bool) (Just (2,True)) =<< [pye| [2,2] |]
+    , testCase "(1)->2" $ eq @(Int,Bool) Nothing =<< [pye| (1)     |]
+    , testCase "(3)->2" $ eq @(Int,Bool) Nothing =<< [pye| (1,2,3) |]
+    , testCase "X->2"   $ eq @(Int,Bool) Nothing =<< [pye| 2 |]
+    ]
   ]
 
 eq :: (Eq a, Show a, FromPy a) => Maybe a -> PyObject -> IO ()