packages feed

inline-python 0.1.1.1 → 0.2

raw patch · 14 files changed

+636/−126 lines, 14 filesdep ~bytestringdep ~text

Dependency ranges changed: bytestring, text

Files

ChangeLog.md view
@@ -1,3 +1,11 @@+0.2 [2025.05.04]+----------------+* `FromPy`/`ToPy` instances added for: `Complex`, both strict and lazy `Text` &+  `ByteString`, `ShortByteString`, `Maybe a`+* Module `Python.Inline.Eval` added which support for eval/exec with user+  supplied global and local variables.+* QuasiQuotes `Python.Inline.QQ.pycode` added for creating `PyQuote` data type.+ 0.1.1.1 [2025.03.10] -------------------- * Crash of python's main thread when one attempts to interrupt it fixed.
inline-python.cabal view
@@ -2,7 +2,7 @@ Build-Type:     Simple  Name:           inline-python-Version:        0.1.1.1+Version:        0.2 Synopsis:       Python interpreter embedded into haskell. Description:   This package embeds python interpreter into haskell program and@@ -57,7 +57,7 @@                    , stm              >=2.4                    , template-haskell -any                    , text             >=2-                   , bytestring+                   , bytestring       >=0.11.2                    , exceptions       >=0.10                    , vector           >=0.13   hs-source-dirs:    src@@ -70,6 +70,7 @@     Python.Inline     Python.Inline.Literal     Python.Inline.QQ+    Python.Inline.Eval     Python.Inline.Types   Other-modules:     Python.Internal.CAPI@@ -93,6 +94,8 @@                   , exceptions                   , containers                   , vector+                  , bytestring+                  , text   hs-source-dirs:   test   Exposed-modules:     TST.Run
+ src/Python/Inline/Eval.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE QuasiQuotes     #-}+{-# LANGUAGE TemplateHaskell #-}+-- |+-- Interface to python's @eval@ and @exec@ which gives programmer+-- control over local and global variables.+module Python.Inline.Eval+  ( -- * Python execution+    eval+  , exec+    -- * Source code+  , PyQuote(..)+  , Code+  , codeFromText+  , codeFromString+  , DictBinder+  , bindVar+    -- * Variable namespaces+  , Namespace(..)+  , Main(..)+  , Temp(..)+  , Dict(..)+  , Module(..)+  ) where++import Data.ByteString.Unsafe     qualified as BS+import Data.Text                  (Text)+import Data.Text.Encoding         qualified as T+import Language.C.Inline          qualified as C+import Language.C.Inline.Unsafe   qualified as CU++import Python.Internal.Types+import Python.Internal.Eval+import Python.Internal.Program+import Python.Inline.Literal+++----------------------------------------------------------------+C.context (C.baseCtx <> pyCtx)+C.include "<inline-python.h>"+----------------------------------------------------------------++-- | Bind variable in dictionary+bindVar+  :: (ToPy a)+  => Text -- ^ Variable name+  -> a    -- ^ Variable value+  -> DictBinder+bindVar name a = DictBinder $ \p_dict -> runProgram $ do+  p_key <- progIOBracket $ BS.unsafeUseAsCString (T.encodeUtf8 name)+  p_obj <- takeOwnership =<< progPy (throwOnNULL =<< basicToPy a)+  progPy $ do+    r <- Py [CU.block| int {+      PyObject* p_obj = $(PyObject* p_obj);+      return PyDict_SetItemString($(PyObject* p_dict), $(char* p_key), p_obj);+      } |]+    case r of+      0 -> pure ()+      _ -> mustThrowPyError+
src/Python/Inline/Literal.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE CPP                      #-} {-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE MagicHash                #-} {-# LANGUAGE QuasiQuotes              #-} {-# LANGUAGE TemplateHaskell          #-} -- |@@ -13,6 +14,7 @@   , fromPy'   ) where +import Control.Exception           (evaluate) import Control.Monad import Control.Monad.Catch import Control.Monad.Trans.Cont@@ -20,8 +22,15 @@ import Data.Char import Data.Int import Data.Word+import Data.ByteString             qualified as BS+import Data.ByteString.Unsafe      qualified as BS+import Data.ByteString.Short       qualified as SBS+import Data.ByteString.Lazy        qualified as BL import Data.Set                    qualified as Set import Data.Map.Strict             qualified as Map+import Data.Text                   qualified as T+import Data.Text.Encoding          qualified as T+import Data.Text.Lazy              qualified as TL import Data.Vector.Generic         qualified as VG import Data.Vector.Generic.Mutable qualified as MVG import Data.Vector                 qualified as V@@ -34,7 +43,10 @@ import Foreign.Ptr import Foreign.C.Types import Foreign.Storable+import Foreign.Marshal.Alloc     (alloca,mallocBytes)+import Foreign.Marshal.Utils     (copyBytes) import GHC.Float                 (float2Double, double2Float)+import Data.Complex              (Complex((:+)))  import Language.C.Inline         qualified as C import Language.C.Inline.Unsafe  qualified as CU@@ -127,6 +139,11 @@ instance FromPy PyObject where   basicFromPy p = incref p >> newPyObject p +deriving newtype instance ToPy   Module+deriving newtype instance FromPy Module+deriving newtype instance ToPy   Dict+deriving newtype instance FromPy Dict+ instance ToPy () where   basicToPy () = Py [CU.exp| PyObject* { Py_None } |] @@ -191,7 +208,29 @@ instance ToPy   Float where basicToPy   = basicToPy . float2Double instance FromPy Float where basicFromPy = fmap double2Float . basicFromPy +-- | @since 0.2+instance ToPy (Complex Float) where+  basicToPy (x:+y) = basicToPy $ float2Double x :+ float2Double y+-- | @since 0.2+instance FromPy (Complex Float) where+  basicFromPy xy_py = do+     x :+ y <- basicFromPy xy_py+     return $ double2Float x :+ double2Float y +-- | @since 0.2+instance ToPy (Complex Double) where+  basicToPy (x:+y) = Py [CU.exp| PyObject* { PyComplex_FromDoubles($(double x'), $(double y')) } |]+   where x' = CDouble x+         y' = CDouble y+-- | @since 0.2+instance FromPy (Complex Double) where+  basicFromPy xy_py = do+    CDouble x <- Py [CU.exp| double { PyComplex_RealAsDouble($(PyObject *xy_py)) } |]+    checkThrowBadPyType+    CDouble y <- Py [CU.exp| double { PyComplex_ImagAsDouble($(PyObject *xy_py)) } |]+    checkThrowBadPyType+    return $ x :+ y+ instance ToPy Int where   basicToPy     | wordSizeInBits == 64 = basicToPy @Int64 . fromIntegral@@ -377,6 +416,24 @@                 d <- basicFromPy p_d                 pure (a,b,c,d) ++-- | @Nothing@ is encoded as @None@. @Just a@ same as @a@.+--+-- @since 0.2+instance (ToPy a) => ToPy (Maybe a) where+  basicToPy Nothing  = Py [CU.exp| PyObject* { Py_None } |]+  basicToPy (Just a) = basicToPy a++-- | @None@ is decoded as @Nothing@ rest is attempted to be decoded as @a@+--+-- @since 0.2+instance (FromPy a) => FromPy (Maybe a) where+  basicFromPy p =+    Py [CU.exp| bool { Py_None == $(PyObject *p) } |] >>= \case+      0 -> Just <$> basicFromPy p+      _ -> pure Nothing++ instance (ToPy a) => ToPy [a] where   basicToPy = basicListToPy @@ -483,7 +540,7 @@ #endif  --- | Fold over iterable. Function takes ownership over iterator.+-- | Fold over python's iterator. Function takes ownership over iterator. foldPyIterable   :: Ptr PyObject                -- ^ Python iterator (not checked)   -> (a -> Ptr PyObject -> Py a) -- ^ Step function. It takes borrowed pointer.@@ -529,6 +586,119 @@   where     n   = VG.length vec     n_c = fromIntegral n :: CLLong+++-- | Converted to @bytes@+--+--   @since 0.2+instance ToPy BS.ByteString where+  basicToPy bs = pyIO $ BS.unsafeUseAsCStringLen bs $ \(ptr,len) -> do+    let c_len = fromIntegral len :: CLLong+    py <- [CU.exp| PyObject* { PyBytes_FromStringAndSize($(char* ptr), $(long long c_len)) }|]+    case py of+      NULL -> unsafeRunPy mustThrowPyError+      _    -> return py++-- | Accepts @bytes@ and @bytearray@+--+--   @since 0.2+instance FromPy BS.ByteString where+  basicFromPy py = pyIO $ do+    [CU.exp| int { PyBytes_Check($(PyObject* py)) } |] >>= \case+      TRUE -> do+        sz  <- [CU.exp| int64_t { PyBytes_GET_SIZE( $(PyObject* py)) } |]+        buf <- [CU.exp| char*   { PyBytes_AS_STRING($(PyObject* py)) } |]+        fini buf (fromIntegral sz)+      _ -> [CU.exp| int { PyByteArray_Check($(PyObject* py)) } |] >>= \case+        TRUE -> do+          sz  <- [CU.exp| int64_t { PyByteArray_GET_SIZE( $(PyObject* py)) } |]+          buf <- [CU.exp| char*   { PyByteArray_AS_STRING($(PyObject* py)) } |]+          fini buf (fromIntegral sz)+        _ -> throwM BadPyType+    where+      fini py_buf sz = do+        hs_buf <- mallocBytes sz+        copyBytes hs_buf py_buf sz+        BS.unsafePackMallocCStringLen (hs_buf, sz)++-- | Converted to @bytes@+--+--   @since 0.2+instance ToPy BL.ByteString where+  basicToPy = basicToPy . BL.toStrict++-- | Accepts @bytes@ and @bytearray@+--+--   @since 0.2+instance FromPy BL.ByteString where+  basicFromPy = fmap BL.fromStrict . basicFromPy+++-- | Accepts @bytes@ and @bytearray@+--+--   @since 0.2+instance FromPy SBS.ShortByteString where+  basicFromPy py = pyIO $ do+    [CU.exp| int { PyBytes_Check($(PyObject* py)) } |] >>= \case+      TRUE -> do+        sz  <- [CU.exp| int64_t { PyBytes_GET_SIZE( $(PyObject* py)) } |]+        buf <- [CU.exp| char*   { PyBytes_AS_STRING($(PyObject* py)) } |]+        fini buf (fromIntegral sz)+      _ -> [CU.exp| int { PyByteArray_Check($(PyObject* py)) } |] >>= \case+        TRUE -> do+          sz  <- [CU.exp| int64_t { PyByteArray_GET_SIZE( $(PyObject* py)) } |]+          buf <- [CU.exp| char*   { PyByteArray_AS_STRING($(PyObject* py)) } |]+          fini buf (fromIntegral sz)+        _ -> throwM BadPyType+    where+      fini buf sz = do+        bs <- BS.unsafePackCStringLen (buf, sz)+        evaluate $ SBS.toShort bs++-- | Converted to @bytes@+--+--   @since 0.2+instance ToPy SBS.ShortByteString where+  basicToPy bs = pyIO $ SBS.useAsCStringLen bs $ \(ptr,len) -> do+    let c_len = fromIntegral len :: CLLong+    py <- [CU.exp| PyObject* { PyBytes_FromStringAndSize($(char* ptr), $(long long c_len)) }|]+    case py of+      NULL -> unsafeRunPy mustThrowPyError+      _    -> return py+++-- | @since 0.2@.+instance ToPy T.Text where+  -- NOTE: Is there ore efficient way to access+  basicToPy str = pyIO $ BS.unsafeUseAsCStringLen bs $ \(ptr,len) -> do+    let c_len = fromIntegral len :: CLLong+    py <- [CU.exp| PyObject* { PyUnicode_FromStringAndSize($(char* ptr), $(long long c_len)) } |]+    case py of+      NULL -> unsafeRunPy mustThrowPyError+      _    -> pure py+    where+      bs = T.encodeUtf8 str++-- | @since 0.2@.+instance ToPy TL.Text where+  basicToPy = basicToPy . TL.toStrict++-- | @since 0.2@.+instance FromPy T.Text where+  basicFromPy py = pyIO $ do+    [CU.exp| int { PyUnicode_Check($(PyObject* py)) } |] >>= \case+      TRUE -> alloca $ \p_size -> do+        buf <- [CU.exp| const char* { PyUnicode_AsUTF8AndSize($(PyObject* py), $(long* p_size)) } |]+        sz  <- peek p_size+        bs  <- BS.unsafePackCStringLen (buf, fromIntegral sz)+        return $! T.decodeUtf8Lenient bs+      _ -> throwM BadPyType++-- | @since 0.2@.+instance FromPy TL.Text where+  basicFromPy = fmap TL.fromStrict . basicFromPy++  ---------------------------------------------------------------- -- Functions marshalling
src/Python/Inline/QQ.hs view
@@ -29,16 +29,21 @@ -- >         do_this() -- >         do_that() -- >         |]+--+-- If control over python's global and local variables is+-- required. APIs from "Python.Inline.Eval" should be used instead. module Python.Inline.QQ   ( pymain   , py_   , pye   , pyf+  , pycode   ) where  import Language.Haskell.TH.Quote  import Python.Internal.EvalQQ+import Python.Internal.Eval   -- | Evaluate sequence of python statements. It works in the same way@@ -48,7 +53,7 @@ --   It creates value of type @Py ()@ pymain :: QuasiQuoter pymain = QuasiQuoter-  { quoteExp  = \txt -> [| evaluatorPymain $(expQQ Exec txt) |]+  { quoteExp  = \txt -> [| exec Main Main $(expQQ Exec txt) |]   , quotePat  = error "quotePat"   , quoteType = error "quoteType"   , quoteDec  = error "quoteDec"@@ -61,7 +66,7 @@ --   It creates value of type @Py ()@ py_ :: QuasiQuoter py_ = QuasiQuoter-  { quoteExp  = \txt -> [| evaluatorPy_ $(expQQ Exec txt) |]+  { quoteExp  = \txt -> [| exec Main Temp $(expQQ Exec txt) |]   , quotePat  = error "quotePat"   , quoteType = error "quoteType"   , quoteDec  = error "quoteDec"@@ -73,7 +78,7 @@ --   This quote creates object of type @Py PyObject@ pye :: QuasiQuoter pye = QuasiQuoter-  { quoteExp  = \txt -> [| evaluatorPye $(expQQ Eval txt) |]+  { quoteExp  = \txt -> [| eval Main Temp $(expQQ Eval txt) |]   , quotePat  = error "quotePat"   , quoteType = error "quoteType"   , quoteDec  = error "quoteDec"@@ -86,6 +91,20 @@ pyf :: QuasiQuoter pyf = QuasiQuoter   { quoteExp  = \txt -> [| evaluatorPyf $(expQQ Fun txt) |]+  , quotePat  = error "quotePat"+  , quoteType = error "quoteType"+  , quoteDec  = error "quoteDec"+  }++-- | Create quote of python code suitable for use with+--   'Python.Inline.Eval.exec'+--+--   It creates value of type @PyQuote@+--+--   @since 0.2@+pycode :: QuasiQuoter+pycode = QuasiQuoter+  { quoteExp  = \txt -> expQQ Exec txt   , quotePat  = error "quotePat"   , quoteType = error "quoteType"   , quoteDec  = error "quoteDec"
src/Python/Internal/Eval.hs view
@@ -29,6 +29,17 @@   , mustThrowPyError   , checkThrowBadPyType   , throwOnNULL+    -- * Exec & eval+  , Namespace(..)+  , Main(..)+  , Temp(..)+  , Dict(..)+  , DictPtr(..)+  , Module(..)+  , ModulePtr(..)+  , unsafeWithCode+  , eval+  , exec     -- * Debugging   , debugPrintPy   ) where@@ -42,6 +53,7 @@ import Control.Monad.Trans.Cont import Data.Maybe import Data.Function+import Data.ByteString.Unsafe    qualified as BS import Foreign.Concurrent        qualified as GHC import Foreign.Ptr import Foreign.ForeignPtr@@ -292,10 +304,10 @@     Py_Finalize();     } |]   -- We need to call Py_Finalize on main thread-  RunningN _ eval _ tid_gc -> checkLock $ do+  RunningN _ lock_eval _ tid_gc -> checkLock $ do     killThread tid_gc     resp <- newEmptyMVar-    putMVar eval $ StopReq resp+    putMVar lock_eval $ StopReq resp     takeMVar resp   where     checkLock action = readTVar globalPyLock >>= \case@@ -472,7 +484,7 @@       InInitialization -> retry       InFinalization   -> retry       Running1         -> throwSTM $ PyInternalError "runPyInMain: Running1"-      RunningN _ eval tid_main _ -> readTVar globalPyLock >>= \case+      RunningN _ eval_lock tid_main _ -> readTVar globalPyLock >>= \case         LockUninialized -> throwSTM PythonNotInitialized         LockFinalized   -> throwSTM PythonIsFinalized         LockedByGC      -> retry@@ -480,9 +492,9 @@         LockUnlocked    -> do           writeTVar globalPyLock $ Locked tid_main []           pure ( atomically (releaseLock tid_main)-               , evalInOtherThread tid_main eval+               , evalInOtherThread tid_main eval_lock                )-        -- If we can grab lock and main thread taken lock we're+        -- If we513 can grab lock and main thread taken lock we're         -- already executing on main thread. We can simply execute code         Locked t ts           | t /= tid@@ -495,12 +507,12 @@           | otherwise -> do               writeTVar globalPyLock $ Locked tid_main (t : ts)               pure ( atomically (releaseLock tid_main)-                   , evalInOtherThread tid_main eval+                   , evalInOtherThread tid_main eval_lock                    )     ---    evalInOtherThread tid_main eval = do+    evalInOtherThread tid_main eval_lock = do       r <- mask_ $ do resp <- newEmptyMVar-                      putMVar eval $ EvalReq py resp+                      putMVar eval_lock $ EvalReq py resp                       takeMVar resp `onException` throwTo tid_main InterruptMain       either throwM pure r @@ -660,6 +672,158 @@   case r of     0 -> pure ()     _ -> throwM BadPyType+++----------------------------------------------------------------+-- Eval/exec+----------------------------------------------------------------++-- | Type class for values representing python dictionaries containing+--   global or local variables.+--+--   @since 0.2@+class Namespace a where+  -- | Returns dictionary object. Caller should take ownership of+  --   returned object.+  basicNamespaceDict :: a -> Py (Ptr PyObject)+++-- | Namespace for the top level code execution. It corresponds to+--   @\__dict\__@ field of a @\__main\__@ module.+--+--   @since 0.2@+data Main = Main++instance Namespace Main where+  basicNamespaceDict _ =+    throwOnNULL =<< Py [CU.block| PyObject* {+      PyObject* main_module = PyImport_AddModule("__main__");+      if( PyErr_Occurred() )+          return NULL;+      PyObject* dict = PyModule_GetDict(main_module);+      Py_XINCREF(dict);+      return dict;+      }|]+++-- | Temporary namespace which get destroyed after execution+--+--   @since 0.2@+data Temp = Temp++instance Namespace Temp where+  basicNamespaceDict _ = basicNewDict+++-- | Newtype wrapper for bare python object. It's assumed to be a+--   dictionary. This is not checked.+--+--   @since 0.2@+newtype DictPtr = DictPtr (Ptr PyObject)++instance Namespace DictPtr where+  basicNamespaceDict (DictPtr p) = p <$ incref p+++-- | Newtype wrapper for python dictionary. It's not checked whether+--   object is actually dictionary.+--+--   @since 0.2@+newtype Dict = Dict PyObject++instance Namespace Dict where+  basicNamespaceDict (Dict d)+    -- NOTE: We're incrementing counter inside bracket so we're safe.+    = unsafeWithPyObject d (basicNamespaceDict . DictPtr)++-- | Newtype wrapper over module object.+--+--   @since 0.2@+newtype ModulePtr = ModulePtr (Ptr PyObject)++instance Namespace ModulePtr where+  basicNamespaceDict (ModulePtr p) = do+    throwOnNULL =<< Py [CU.block| PyObject* {+      PyObject* dict = PyModule_GetDict($(PyObject* p));+      Py_XINCREF(dict);+      return dict;+      }|]++-- | Newtype wrapper over module object.+newtype Module = Module PyObject++instance Namespace Module where+  basicNamespaceDict (Module d)+    -- NOTE: We're incrementing counter inside bracket so we're safe.+    = unsafeWithPyObject d (basicNamespaceDict . ModulePtr)+++-- | Evaluate python expression. This is wrapper over python's @eval@.+--+--   @since 0.2@+eval :: (Namespace global, Namespace local)+     => global  -- ^ Data type providing global variables dictionary+     -> local   -- ^ Data type providing local variables dictionary+     -> PyQuote -- ^ Source code+     -> Py PyObject+eval globals locals q = runProgram $ do+  p_py      <- unsafeWithCode q.code+  p_globals <- takeOwnership =<< progPy (basicNamespaceDict globals)+  p_locals  <- takeOwnership =<< progPy (basicNamespaceDict locals)+  progPy $ do+    q.binder.bind p_locals+    p_res <- Py [C.block| PyObject* {+      PyObject* globals = $(PyObject* p_globals);+      PyObject* locals  = $(PyObject* p_locals);+      // Compile code+      PyObject *code = Py_CompileString($(char* p_py), "<interactive>", Py_eval_input);+      if( PyErr_Occurred() ) {+          return NULL;+      }+      // Evaluate expression+      PyObject* r = PyEval_EvalCode(code, globals, locals);+      Py_DECREF(code);+      return r;+      }|]+    checkThrowPyError+    newPyObject p_res+{-# SPECIALIZE eval :: Main -> Temp -> PyQuote -> Py PyObject #-}++-- | Evaluate sequence of python statements This is wrapper over python's @exec@.+--+--   @since 0.2@+exec :: (Namespace global, Namespace local)+     => global  -- ^ Data type providing global variables dictionary+     -> local   -- ^ Data type providing local variables dictionary+     -> PyQuote -- ^ Source code+     -> Py ()+exec globals locals q = runProgram $ do+  p_py      <- unsafeWithCode q.code+  p_globals <- takeOwnership =<< progPy (basicNamespaceDict globals)+  p_locals  <- takeOwnership =<< progPy (basicNamespaceDict locals)+  progPy $ do+    q.binder.bind p_locals+    Py[C.block| void {+      PyObject* globals = $(PyObject* p_globals);+      PyObject* locals  = $(PyObject* p_locals);+      // Compile code+      PyObject *code = Py_CompileString($(char* p_py), "<interactive>", Py_file_input);+      if( PyErr_Occurred() ){+          return;+      }+      // Execute statements+      PyObject* res = PyEval_EvalCode(code, globals, locals);+      Py_XDECREF(res);+      Py_DECREF(code);+      } |]+    checkThrowPyError+{-# SPECIALIZE exec :: Main -> Main -> PyQuote -> Py () #-}+{-# SPECIALIZE exec :: Main -> Temp -> PyQuote -> Py () #-}++-- | Obtain pointer to code+unsafeWithCode :: Code -> Program r (Ptr CChar)+unsafeWithCode (Code bs) = Program $ ContT $ \fun ->+  Py (BS.unsafeUseAsCString bs $ unsafeRunPy . fun)   ----------------------------------------------------------------
src/Python/Internal/EvalQQ.hs view
@@ -3,10 +3,7 @@ -- | module Python.Internal.EvalQQ   ( -- * Evaluators and QQ-    evaluatorPymain-  , evaluatorPy_-  , evaluatorPye-  , evaluatorPyf+    evaluatorPyf     -- * Code generation   , expQQ   , Mode(..)@@ -14,10 +11,12 @@  import Control.Monad.IO.Class import Control.Monad.Catch+import Control.Monad.Trans.Cont (ContT(..)) import Data.Bits import Data.Char import Data.List                 (intercalate) import Data.ByteString           qualified as BS+import Data.ByteString.Unsafe    qualified as BS import Data.Text                 qualified as T import Data.Text.Encoding        qualified as T import Foreign.C.Types@@ -42,117 +41,53 @@ C.include "<inline-python.h>" ---------------------------------------------------------------- -------------------------------------------------------------------- Evaluators-----------------------------------------------------------------+-- | Python's variable name encoded using UTF-8. It exists in order to+--   avoid working with @String@ at runtime.+newtype PyVarName = PyVarName BS.ByteString+  deriving stock (Show, TH.Lift) --- | Evaluate expression within context of @__main__@ module. All---   variables defined in this evaluator persist.-pyExecExpr-  :: Ptr PyObject -- ^ Globals-  -> Ptr PyObject -- ^ Locals-  -> String       -- ^ Python source code-  -> Py ()-pyExecExpr p_globals p_locals src = runProgram $ do-  p_py <- withPyCString src-  progPy $ do-    Py [C.block| void {-      PyObject* globals = $(PyObject* p_globals);-      PyObject* locals  = $(PyObject* p_locals);-      // Compile code-      PyObject *code = Py_CompileString($(char* p_py), "<interactive>", Py_file_input);-      if( PyErr_Occurred() ){-          return;-      }-      // Execute statements-      PyObject* res = PyEval_EvalCode(code, globals, locals);-      Py_XDECREF(res);-      Py_DECREF(code);-      } |]-    checkThrowPyError+varName :: String -> PyVarName+varName = PyVarName . T.encodeUtf8 . T.pack --- | Evaluate expression with fresh local environment-pyEvalExpr-  :: Ptr PyObject -- ^ Globals-  -> Ptr PyObject -- ^ Locals-  -> String       -- ^ Python source code-  -> Py PyObject-pyEvalExpr p_globals p_locals src = runProgram $ do-  p_py  <- withPyCString src-  progPy $ do-    p_res <- Py [C.block| PyObject* {-      PyObject* globals = $(PyObject* p_globals);-      PyObject* locals  = $(PyObject* p_locals);-      // Compile code-      PyObject *code = Py_CompileString($(char* p_py), "<interactive>", Py_eval_input);-      if( PyErr_Occurred() ) {-          return NULL;-      }-      // Evaluate expression-      PyObject* r = PyEval_EvalCode(code, globals, locals);-      Py_DECREF(code);-      return r;-      }|]-    checkThrowPyError-    newPyObject p_res+unsafeWithPyVarName :: PyVarName -> Program r (Ptr CChar)+unsafeWithPyVarName (PyVarName bs)+  = progIOBracket (BS.unsafeUseAsCString bs)  -evaluatorPymain :: (Ptr PyObject -> Py String) -> Py ()-evaluatorPymain getSource = do-  p_main <- basicMainDict-  src    <- getSource p_main-  pyExecExpr p_main p_main src+bindVar :: ToPy a => PyVarName -> a -> DictBinder+bindVar var a = DictBinder $ \p_dict -> runProgram $ do+  p_key <- unsafeWithPyVarName var+  p_obj <- takeOwnership =<< progPy (throwOnNULL =<< basicToPy a)+  progPy $ do+    r <- Py [CU.block| int {+      PyObject* p_obj = $(PyObject* p_obj);+      return PyDict_SetItemString($(PyObject* p_dict), $(char* p_key), p_obj);+      } |]+    case r of+      0 -> pure ()+      _ -> mustThrowPyError -evaluatorPy_ :: (Ptr PyObject -> Py String) -> Py ()-evaluatorPy_ getSource = runProgram $ do-  p_globals <- progPy basicMainDict-  p_locals  <- takeOwnership =<< progPy basicNewDict-  progPy $ pyExecExpr p_globals p_locals =<< getSource p_locals -evaluatorPye :: (Ptr PyObject -> Py String) -> Py PyObject-evaluatorPye getSource = runProgram $ do-  p_globals <- progPy basicMainDict-  p_locals  <- takeOwnership =<< progPy basicNewDict-  progPy $ pyEvalExpr p_globals p_locals =<< getSource p_locals -evaluatorPyf :: (Ptr PyObject -> Py String) -> Py PyObject-evaluatorPyf getSource = runProgram $ do-  p_globals <- progPy basicMainDict-  p_locals  <- takeOwnership =<< progPy basicNewDict-  p_kwargs  <- takeOwnership =<< progPy basicNewDict+----------------------------------------------------------------+-- Evaluators+----------------------------------------------------------------++evaluatorPyf :: PyQuote -> Py PyObject+evaluatorPyf (PyQuote code binder) = runProgram $ do+  p_locals <- takeOwnership =<< progPy basicNewDict+  p_kwargs <- takeOwnership =<< progPy basicNewDict   progPy $ do     -- Create function in p_locals-    pyExecExpr p_globals p_locals =<< getSource p_kwargs+    exec Main (DictPtr p_locals) (PyQuote code mempty)     -- Look up function     p_fun <- getFunctionObject p_locals >>= \case       NULL -> throwM $ PyInternalError "_inline_python_ must be present"       p    -> pure p     -- Call python function we just constructed+    binder.bind p_kwargs     newPyObject =<< throwOnNULL =<< basicCallKwdOnly p_fun p_kwargs --basicBindInDict :: ToPy a => String -> a -> Ptr PyObject -> Py ()-basicBindInDict name a p_dict = runProgram $ do-  p_key <- withPyCString name-  p_obj <- takeOwnership =<< progPy (throwOnNULL =<< basicToPy a)-  progPy $ do-    r <- Py [C.block| int {-      PyObject* p_obj = $(PyObject* p_obj);-      return PyDict_SetItemString($(PyObject* p_dict), $(char* p_key), p_obj);-      } |]-    case r of-      0 -> pure ()-      _ -> mustThrowPyError---- | Return dict of @__main__@ module-basicMainDict :: Py (Ptr PyObject)-basicMainDict = Py [CU.block| PyObject* {-  PyObject* main_module = PyImport_AddModule("__main__");-  if( PyErr_Occurred() )-      return NULL;-  return PyModule_GetDict(main_module);-  }|]- getFunctionObject :: Ptr PyObject -> Py (Ptr PyObject) getFunctionObject p_dict = do   Py [CU.exp| PyObject* { PyDict_GetItemString($(PyObject *p_dict), "_inline_python_") } |]@@ -205,14 +140,13 @@     case code of       ExitSuccess   -> pure $ words stdout       ExitFailure{} -> fail stderr-  let args = [ [| basicBindInDict $(TH.lift nm) $(TH.dyn (chop nm)) |]+  let args = [ [| bindVar $(TH.lift (varName nm)) $(TH.dyn (chop nm)) |]              | nm <- antis              ]       src_eval = prepareForEval mode antis src   ---  [| \p_dict -> do-        mapM_ ($ p_dict) $(TH.listE args)-        pure $(TH.lift src_eval)+  [| PyQuote ($(TH.lift $ codeFromString src_eval))+             (mconcat $(TH.listE args))    |]
src/Python/Internal/Program.hs view
@@ -6,6 +6,7 @@   , runProgram   , progPy   , progIO+  , progIOBracket     -- * Control flow   , abort   , abortM@@ -63,6 +64,9 @@  progPy :: Py a -> Program r a progPy = Program . lift++progIOBracket :: ((a -> IO r) -> IO r) -> Program r a+progIOBracket = coerce  -- | Early exit from continuation monad. abort :: r -> Program r a
src/Python/Internal/Types.hs view
@@ -9,6 +9,7 @@ module Python.Internal.Types   ( -- * Data type     PyObject(..)+  , withPyObject   , unsafeWithPyObject   , PyThreadState   , PyError(..)@@ -16,6 +17,12 @@   , PyInternalError(..)   , Py(..)   , pyIO+    -- ** Python code wrappers+  , PyQuote(..)+  , Code(..)+  , codeFromText+  , codeFromString+  , DictBinder(..)     -- * inline-C   , pyCtx     -- * Patterns@@ -23,6 +30,8 @@   , pattern IPY_ERR_COMPILE   , pattern IPY_ERR_PYTHON   , pattern NULL+  , pattern FALSE+  , pattern TRUE   ) where  import Control.Monad.IO.Class@@ -31,9 +40,13 @@ import Control.Exception import Data.Coerce import Data.Int+import Data.ByteString             qualified as BS import Data.Map.Strict             qualified as Map+import Data.Text                   qualified as T+import Data.Text.Encoding          qualified as T import Foreign.Ptr import Foreign.C.Types+import Language.Haskell.TH.Syntax  qualified as TH import GHC.ForeignPtr  import Language.C.Types@@ -52,6 +65,9 @@ newtype PyObject = PyObject (ForeignPtr PyObject)   deriving stock Show +withPyObject :: forall a. PyObject -> (Ptr PyObject -> Py a) -> Py a+withPyObject = coerce (withForeignPtr @PyObject @a)+ unsafeWithPyObject :: forall a. PyObject -> (Ptr PyObject -> Py a) -> Py a unsafeWithPyObject = coerce (unsafeWithForeignPtr @PyObject @a) @@ -71,7 +87,7 @@   | PythonNotInitialized     -- ^ Python interpreter is not initialized   | PythonIsFinalized-    -- ^ Python interpreter is not initialized    +    -- ^ Python interpreter is not initialized   deriving stock    (Show)   deriving anyclass (Exception) @@ -115,6 +131,53 @@   ----------------------------------------------------------------+-- Code wrappers+----------------------------------------------------------------++-- | Quasiquoted python code. It contains source code and closure+--   which populates dictionary with local variables. @PyQuote@ value+--   which captures local variables could be created using+--   'Python.Inline.QQ.pycode' quasiquoter.+--+--   @since 0.2@+data PyQuote = PyQuote+  { code   :: !Code+  , binder :: !DictBinder+  }+++-- | UTF-8 encoded python source code.+--+--   @since 0.2@+newtype Code = Code BS.ByteString+  deriving stock (Show, TH.Lift)++-- | Create properly encoded @Code@. This function doesn't check+--   syntactic validity.+--+--   @since 0.2@+codeFromText :: T.Text -> Code+codeFromText = Code . T.encodeUtf8++-- | Create properly encoded @Code@. This function doesn't check+--   syntactic validity.+--+--   @since 0.2@+codeFromString :: String -> Code+codeFromString = codeFromText . T.pack++-- | Closure which stores values in provided python dictionary.+--+--   @since 0.2@+newtype DictBinder = DictBinder { bind :: Ptr PyObject -> Py () }++instance Semigroup DictBinder where+  f <> g = DictBinder $ \p -> f.bind p >> g.bind p+instance Monoid DictBinder where+  mempty = DictBinder $ \_ -> pure ()+++---------------------------------------------------------------- -- inline-C ---------------------------------------------------------------- @@ -148,3 +211,9 @@ pattern NULL :: Ptr a pattern NULL <- ((== nullPtr) -> True) where   NULL = nullPtr++pattern FALSE :: CInt+pattern FALSE = 0++pattern TRUE :: CInt+pattern TRUE <- ((/= 0) -> True)
test/TST/FromPy.hs view
@@ -1,13 +1,19 @@ {-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE OverloadedStrings   #-} -- | module TST.FromPy (tests) where +import Data.ByteString qualified as BS import Control.Monad.IO.Class import Test.Tasty import Test.Tasty.HUnit import Python.Inline import Python.Inline.QQ+import Data.Complex (Complex((:+))) +import TST.Util++ tests :: TestTree tests = testGroup "FromPy"   [ testGroup "Int"@@ -20,6 +26,13 @@     , testCase "Double->Double" $ eq @Double (Just 1234.25) [pye| 1234.25 |]     , testCase "None->Double"   $ eq @Double Nothing        [pye| None    |]     ]+  , testGroup "Complex"+    [ testCase "Int->Complex"     $ eq @(Complex Double) (Just 1234)    [pye| 1234    |]+    , testCase "Double->Complex"  $ eq @(Complex Double) (Just 1234.25) [pye| 1234.25 |]+    , testCase "Complex->Complex" $ eq @(Complex Double) (Just $ 1234.5 :+ 6789)+                                     [pye| 1234.5+6789.0j |]+    , testCase "None->Complex"    $ eq @(Complex Double) Nothing        [pye| None    |]+    ]   , testGroup "Char"     [ testCase "0"    $ eq @Char Nothing    [pye| ""   |]     , testCase "1 1B" $ eq @Char (Just 'a') [pye| "a"  |]@@ -31,6 +44,12 @@     [ testCase "asdf" $ eq @String (Just "asdf") [pye| "asdf" |]     , testCase "фыва" $ eq @String (Just "фыва") [pye| "фыва" |]     ]+  , testGroup "ByteString"+    [ testCase "empty" $ eq @BS.ByteString (Just "") [pye| b'' |]+    , testCase "x00"   $ eq @BS.ByteString (Just $ BS.pack [0]) [pye| b'\x00' |]+    , testCase "empty arr" $ eq @BS.ByteString (Just "") [pye| bytearray(b'') |]+    , testCase "x00 arr"   $ eq @BS.ByteString (Just $ BS.pack [0]) [pye| bytearray(b'\x00') |]+    ]   , testGroup "Bool"     [ testCase "True->Bool"  $ eq @Bool (Just True)  [pye| True  |]     , testCase "False->Bool" $ eq @Bool (Just False) [pye| False |]@@ -74,9 +93,6 @@     , testCase "Int" $ eq @[Int] Nothing        [pye| None    |]     ]   ]--eq :: (Eq a, Show a, FromPy a) => Maybe a -> (Py PyObject) -> IO ()-eq a action = assertEqual "fromPy: " a =<< runPy (fromPy =<< action)  failE :: forall a. (Eq a, Show a, FromPy a) => PyObject -> Py () failE p = fromPyEither @a p >>= \case
test/TST/Roundtrip.hs view
@@ -8,14 +8,22 @@ import Data.Typeable import Data.Set        (Set) import Data.Map.Strict (Map)+import Data.Text       qualified as T+import Data.Text.Lazy  qualified as TL+import Data.Complex (Complex) import Foreign.C.Types  import Test.Tasty import Test.Tasty.QuickCheck import Test.QuickCheck.Instances.Vector ()+import Test.QuickCheck.Instances.ByteString ()+import Test.QuickCheck.Instances.Text () import Python.Inline import Python.Inline.QQ +import Data.ByteString             qualified as BS+import Data.ByteString.Lazy        qualified as BL+import Data.ByteString.Short       qualified as SBS import Data.Vector                 qualified as V #if MIN_VERSION_vector(0,13,2) import Data.Vector.Strict          qualified as VV@@ -54,6 +62,9 @@       -- Floating point     , testRoundtrip @Double     , testRoundtrip @Float+      -- Complex+    , testRoundtrip @(Complex Double)+    , testRoundtrip @(Complex Float)       -- Other scalars     , testRoundtrip @Char     , testRoundtrip @Bool@@ -62,8 +73,11 @@     , testRoundtrip @(Int,(Int,Int))     , testRoundtrip @(Int,Int,Int)     , testRoundtrip @(Int,Int,Int,Char)+    , testRoundtrip @(Maybe Int)+    , testRoundtrip @(Maybe T.Text)     , testRoundtrip @[Int]     , testRoundtrip @[[Int]]+    , testRoundtrip @[Complex Double]     , testRoundtrip @(Set Int)     , testRoundtrip @(Map Int Int)     -- , testRoundtrip @String -- Trips on zero byte as it should@@ -74,6 +88,11 @@ #if MIN_VERSION_vector(0,13,2) --    , testRoundtrip @(VV.Vector Int) #endif+    , testRoundtrip @BS.ByteString+    , testRoundtrip @BL.ByteString+    , testRoundtrip @SBS.ShortByteString+    , testRoundtrip @T.Text+    , testRoundtrip @TL.Text     ]   , testGroup "OutOfRange"     [ testOutOfRange @Int8   @Int16
test/TST/Run.hs view
@@ -6,10 +6,12 @@ import Control.Exception import Control.Monad import Control.Monad.IO.Class+import Data.Map.Strict        qualified as Map import Test.Tasty import Test.Tasty.HUnit import Python.Inline import Python.Inline.QQ+import Python.Inline.Eval import TST.Util  tests :: TestTree@@ -130,6 +132,37 @@             assert False, "x shouln't be visible (2)"         except NameError:             pass+        |]+  , testCase "pyf works" $ do+      let x = 12 :: Int+      eq (Just (482412::Int)) [pyf|+         xs = [i*x_hs for i in [1, 200, 40000]]+         return sum(xs)+         |]+  , testCase "exec with Dict" $ runPy $ do+      dct <- [pye| {} |]+      exec Main (Dict dct) [pycode|+        a = 12+        b = 13+      |]+      throwsPy $ exec Main (Module dct) [pycode| |]+      d <- fromPy dct+      liftIO $ assertEqual "dict" (Just (Map.fromList [("a",12::Int),("b",13)])) d+  , testCase "exec with Module" $ runPy $ do+      m <- [pyf|+        import importlib.util+        spec = importlib.util.spec_from_loader("dyn", loader=None)+        return importlib.util.module_from_spec(spec)+        |]+      exec Main (Module m) [pycode|+        a = 12+        b = 'asd'+        |]+      [py_|+        import types+        isinstance(m_hs, types.ModuleType)+        assert m_hs.a == 12+        assert m_hs.b == 'asd'         |]   ]
test/TST/ToPy.hs view
@@ -1,8 +1,11 @@+{-# LANGUAGE OverloadedStrings #-} -- | module TST.ToPy (tests) where -import Data.Set qualified as Set-import Data.Map.Strict qualified as Map+import Data.ByteString      qualified as BS+import Data.Set             qualified as Set+import Data.Map.Strict      qualified as Map+import Data.Complex         (Complex((:+))) import Test.Tasty import Test.Tasty.HUnit import Python.Inline@@ -14,10 +17,18 @@ tests = testGroup "ToPy"   [ testCase "Int"            $ runPy $ let i = 1234    :: Int    in [py_| assert i_hs == 1234    |]   , testCase "Double"         $ runPy $ let i = 1234.25 :: Double in [py_| assert i_hs == 1234.25 |]+  , testCase "Complex" $ runPy $+      let z = 5.5 :+ 7.5 :: Complex Double+      in [py_| assert (z_hs.real == 5.5); assert (z_hs.imag == 7.5)|]   , testCase "Char ASCII"     $ runPy $ let c = 'a'    in [py_| assert c_hs == 'a' |]   , testCase "Char unicode"   $ runPy $ let c = 'ы'    in [py_| assert c_hs == 'ы' |]-  , testCase "String ASCII"   $ runPy $ let c = "asdf" in [py_| assert c_hs == 'asdf' |]-  , testCase "String unicode" $ runPy $ let c = "фыва" in [py_| assert c_hs == 'фыва' |]+  , testCase "String ASCII"   $ runPy $ let c = "asdf"::String in [py_| assert c_hs == 'asdf' |]+  , testCase "String unicode" $ runPy $ let c = "фыва"::String in [py_| assert c_hs == 'фыва' |]+    -- Byte objects+  , testCase "empty ByteString" $ runPy $+      let bs = BS.empty in [py_| assert bs_hs == b'' |]+  , testCase "0 ByteString" $ runPy $+      let bs = BS.pack [0] in [py_| assert bs_hs == b'\x00' |]     -- Container types   , testCase "Tuple2" $ runPy $       let x = (1::Int, 333::Int)
test/TST/Util.hs view
@@ -6,7 +6,6 @@ import Test.Tasty.HUnit  import Python.Inline-import Python.Inline.Types  throwsPy :: Py () -> Py () throwsPy io = (io >> liftIO (assertFailure "Evaluation should raise python exception"))@@ -16,3 +15,5 @@ throwsPyIO io = (io >> assertFailure "Evaluation should raise python exception")   `catch` (\(_::PyError) -> pure ()) +eq :: (Eq a, Show a, FromPy a) => Maybe a -> (Py PyObject) -> IO ()+eq a action = assertEqual "fromPy: " a =<< runPy (fromPy =<< action)