From a83246ea2e87a00e94730351fd2fa365d11e8e8c Mon Sep 17 00:00:00 2001 From: Alexey Khudyakov Date: Fri, 11 Sep 2026 00:10:37 +0300 Subject: [PATCH 1/4] Export evalPyFunction alognside with eval&exec --- src/Python/Inline/Eval.hs | 1 + src/Python/Inline/QQ.hs | 2 +- src/Python/Internal/Eval.hs | 30 ++++++++++++++++++++++++++++++ src/Python/Internal/EvalQQ.hs | 31 ++----------------------------- 4 files changed, 34 insertions(+), 30 deletions(-) diff --git a/src/Python/Inline/Eval.hs b/src/Python/Inline/Eval.hs index c05ad02..8141ffb 100644 --- a/src/Python/Inline/Eval.hs +++ b/src/Python/Inline/Eval.hs @@ -7,6 +7,7 @@ module Python.Inline.Eval ( -- * Python execution eval , exec + , evalPyFunction -- * Source code , PyQuote(..) , Code diff --git a/src/Python/Inline/QQ.hs b/src/Python/Inline/QQ.hs index c93a0d7..d762b52 100644 --- a/src/Python/Inline/QQ.hs +++ b/src/Python/Inline/QQ.hs @@ -102,7 +102,7 @@ pye = QuasiQuoter -- This quote creates object of type @Py PyObject@ pyf :: QuasiQuoter pyf = QuasiQuoter - { quoteExp = \txt -> [| evaluatorPyf $(expQQ Fun txt) |] + { quoteExp = \txt -> [| evalPyFunction Main $(expQQ Fun txt) |] , quotePat = error "quotePat" , quoteType = error "quoteType" , quoteDec = error "quoteDec" diff --git a/src/Python/Internal/Eval.hs b/src/Python/Internal/Eval.hs index 35b6030..2254498 100644 --- a/src/Python/Internal/Eval.hs +++ b/src/Python/Internal/Eval.hs @@ -49,6 +49,7 @@ module Python.Internal.Eval , unsafeWithCode , eval , exec + , evalPyFunction -- * Debugging , debugPrintPy ) where @@ -1096,6 +1097,35 @@ exec globals locals q = runProgram $ do {-# SPECIALIZE exec :: Main -> Main -> PyQuote -> Py () #-} {-# SPECIALIZE exec :: Main -> Temp -> PyQuote -> Py () #-} +-- | Evaluate code as if it's a function body and bound arguments are +-- parameters to that function. Just like function it could return +-- value and always creates new scope. +-- +-- @since 0.3 +evalPyFunction + :: Namespace global + => global -- ^ Global variables + -> PyQuote -- ^ Source code + -> Py PyObject +evalPyFunction globals (PyQuote code binder) = runProgram $ do + p_locals <- takeOwnership =<< progPy basicNewDict + p_kwargs <- takeOwnership =<< progPy basicNewDict + progPy $ do + -- Create function in p_locals + exec globals (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 + +getFunctionObject :: Ptr PyObject -> Py (Ptr PyObject) +getFunctionObject p_dict = do + Py [CU.exp| PyObject* { PyDict_GetItemString($(PyObject *p_dict), "_inline_python_") } |] + + -- | Obtain pointer to code unsafeWithCode :: Code -> Program r (Ptr CChar) unsafeWithCode (Code bs) = Program $ ContT $ \fun -> diff --git a/src/Python/Internal/EvalQQ.hs b/src/Python/Internal/EvalQQ.hs index ce3609f..2de568d 100644 --- a/src/Python/Internal/EvalQQ.hs +++ b/src/Python/Internal/EvalQQ.hs @@ -2,10 +2,8 @@ {-# LANGUAGE TemplateHaskell #-} -- | module Python.Internal.EvalQQ - ( -- * Evaluators and QQ - evaluatorPyf - -- * Code generation - , expQQ + ( -- * Code generation + expQQ , Mode(..) ) where @@ -68,31 +66,6 @@ bindVar var a = DictBinder $ \p_dict -> runProgram $ do ----------------------------------------------------------------- --- 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 - 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 - -getFunctionObject :: Ptr PyObject -> Py (Ptr PyObject) -getFunctionObject p_dict = do - Py [CU.exp| PyObject* { PyDict_GetItemString($(PyObject *p_dict), "_inline_python_") } |] - - - ---------------------------------------------------------------- -- TH generator ---------------------------------------------------------------- From 27d2d47831a496d2d984353825e672b5a585ef73 Mon Sep 17 00:00:00 2001 From: Alexey Khudyakov Date: Fri, 11 Sep 2026 00:22:48 +0300 Subject: [PATCH 2/4] Add MonadPy --- inline-python.cabal | 5 +++-- src/Python/Inline/Monad.hs | 33 +++++++++++++++++++++++++++++++++ 2 files changed, 36 insertions(+), 2 deletions(-) create mode 100644 src/Python/Inline/Monad.hs diff --git a/inline-python.cabal b/inline-python.cabal index 7c9385d..26b2961 100644 --- a/inline-python.cabal +++ b/inline-python.cabal @@ -91,11 +91,12 @@ Library -- Exposed-modules: Python.Inline + Python.Inline.Async + Python.Inline.Eval Python.Inline.Literal + Python.Inline.Monad Python.Inline.QQ - Python.Inline.Eval Python.Inline.Types - Python.Inline.Async Other-modules: Python.Internal.CAPI Python.Internal.Eval diff --git a/src/Python/Inline/Monad.hs b/src/Python/Inline/Monad.hs new file mode 100644 index 0000000..190b0a5 --- /dev/null +++ b/src/Python/Inline/Monad.hs @@ -0,0 +1,33 @@ +-- | +module Python.Inline.Monad + ( -- * Type classes + Namespace(..) + , MonadPy(..) + ) where + +import Python.Internal.Eval +import Python.Internal.Types + +-- | Monad which can carry dictionaries or object of global and local +-- python variables around. It's expected that it's some variant of +-- wrapper around 'Py'. +-- +-- For @Py@ global variables are 'Main' and local are 'Temp' +class Monad m => MonadPy m where + -- | Lift @Py@ computation into given monad. + liftPy :: Py a -> m a + -- | Provide set of global variables. CPS style is used to avoid + -- specifying type of global used by monad (and allow picking it + -- at runtime). + withGlobals + :: (forall globals. Namespace globals => globals -> m a) + -> m a + -- | Same for local variables + withLocals + :: (forall locals. Namespace locals => locals -> m a) + -> m a + +instance MonadPy Py where + liftPy = id + withGlobals f = f Main + withLocals f = f Temp From 7cac00db9c51579602c8cf659ffe4d09b0e07886 Mon Sep 17 00:00:00 2001 From: Alexey Khudyakov Date: Fri, 11 Sep 2026 00:46:52 +0300 Subject: [PATCH 3/4] Add polymorphic quasiquoters --- inline-python.cabal | 1 + src/Python/Inline/Monad/QQ.hs | 90 +++++++++++++++++++++++++++++++++++ src/Python/Inline/QQ.hs | 2 +- test/TST/Run.hs | 13 ++++- 4 files changed, 104 insertions(+), 2 deletions(-) create mode 100644 src/Python/Inline/Monad/QQ.hs diff --git a/inline-python.cabal b/inline-python.cabal index 26b2961..5256541 100644 --- a/inline-python.cabal +++ b/inline-python.cabal @@ -95,6 +95,7 @@ Library Python.Inline.Eval Python.Inline.Literal Python.Inline.Monad + Python.Inline.Monad.QQ Python.Inline.QQ Python.Inline.Types Other-modules: diff --git a/src/Python/Inline/Monad/QQ.hs b/src/Python/Inline/Monad/QQ.hs new file mode 100644 index 0000000..710e411 --- /dev/null +++ b/src/Python/Inline/Monad/QQ.hs @@ -0,0 +1,90 @@ +{-# LANGUAGE TemplateHaskell #-} +-- | +-- These quasiquotes are analogous to ones defined in +-- "Python.Inline.QQ" but they produce splices which are polymorphic +-- in 'MonadPy'. For 'Py' in particular they behave identically. +module Python.Inline.Monad.QQ + ( pymain + , py_ + , pye + , pyf + , pycode + ) where + + +import Language.Haskell.TH.Quote + +import Python.Internal.EvalQQ +import Python.Internal.Eval +import Python.Inline.Monad +import Python.Inline.QQ (pycode) + + + +-- | Evaluate sequence of python statements. It uses python's @exec@. +-- Both global and local scope for this quasiquoter are global +-- variables for 'MonadPy' +-- +-- It creates value of type @MonadPy m => m ()@ +pymain :: QuasiQuoter +pymain = QuasiQuoter + { quoteExp = \txt -> [| + withGlobals $ \globals -> + liftPy $ exec globals globals $(expQQ Exec txt) + |] + , quotePat = error "quotePat" + , quoteType = error "quoteType" + , quoteDec = error "quoteDec" + } + +-- | Evaluate sequence of python statements. Global and local +-- variables for this quasiquoter are determined by 'MonadPy' +-- instance. +-- +-- It creates value of type @MonadPy m => m ()@ +py_ :: QuasiQuoter +py_ = QuasiQuoter + { quoteExp = \txt -> [| + withGlobals $ \globals -> + withLocals $ \locals -> + liftPy $ exec globals locals $(expQQ Exec txt) + |] + , quotePat = error "quotePat" + , quoteType = error "quoteType" + , quoteDec = error "quoteDec" + } + +-- | Evaluate single python expression. It only accepts single +-- expressions same as python's @eval@. Its globals are variables +-- are determined by 'MonadPy' instance. +-- +-- This quote creates object of type @MonadPy m => m PyObject@ +pye :: QuasiQuoter +pye = QuasiQuoter + { quoteExp = \txt -> [| + withGlobals $ \globals -> + withLocals $ \locals -> + liftPy $ eval globals locals $(expQQ Eval txt) + |] + , quotePat = error "quotePat" + , quoteType = error "quoteType" + , quoteDec = error "quoteDec" + } + +-- | Another quasiquoter which works around that sequence of python +-- statements doesn't have any value associated with it. Content of +-- quasiquote is function body. So to get value out of it one must +-- call return. Its globals are determined by 'MonadPy' instance. +-- Just like python function it always creates new scope. +-- +-- This quote creates object of type @Py PyObject@ +pyf :: QuasiQuoter +pyf = QuasiQuoter + { quoteExp = \txt -> [| + withGlobals $ \globals -> + liftPy $ evalPyFunction globals $(expQQ Fun txt) + |] + , quotePat = error "quotePat" + , quoteType = error "quoteType" + , quoteDec = error "quoteDec" + } diff --git a/src/Python/Inline/QQ.hs b/src/Python/Inline/QQ.hs index d762b52..fffd960 100644 --- a/src/Python/Inline/QQ.hs +++ b/src/Python/Inline/QQ.hs @@ -52,7 +52,7 @@ import Python.Internal.Eval -- | Evaluate sequence of python statements. It uses python's @exec@. --- Both global and local state for this quasiquoter are variables of +-- Both global and local scope for this quasiquoter are variables of -- @\__main__@ module. Any variables including imported modules will -- remain visible to later quasiquotes. -- diff --git a/test/TST/Run.hs b/test/TST/Run.hs index 3240d62..1665f4a 100644 --- a/test/TST/Run.hs +++ b/test/TST/Run.hs @@ -207,7 +207,7 @@ tests = testGroup "Run python" forever [py_| loop_hs() |] d <- registerDelay 100_000 threadDelay 100 - forkIO $ cancelPy a + _ <- forkIO $ cancelPy a _ <- atomically $ waitPyCatch a `orElse` do readTVar d >>= \case True -> error "Timeout" False -> retry @@ -226,6 +226,17 @@ tests = testGroup "Run python" |] error "Should be interrupted" ] + -- Here we only test that quasiquotes produce correct code + , testGroup "Monadic" + [ testCase "pymain" $ runPy [pymain| assert True |] + , testCase "py_" $ runPy [py_| assert True |] + , testCase "pye" $ runPy $ do + n <- fromPy =<< [pye| 42 |] + liftIO $ Just (42::Int) @=? n + , testCase "pyf" $ runPy $ do + n <- fromPy =<< [pyf| return 42 |] + liftIO $ Just (42::Int) @=? n + ] ] data Stop = Stop From 77df3f51bae68d4d49978b2dbabba8722ff13043 Mon Sep 17 00:00:00 2001 From: Alexey Khudyakov Date: Fri, 11 Sep 2026 15:57:20 +0300 Subject: [PATCH 4/4] Update changelog --- ChangeLog.md | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/ChangeLog.md b/ChangeLog.md index 246f156..73bf8d2 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,14 +1,20 @@ 0.3.0.0 [XXXX.XX.XX] -------------------- -* Support for asynchronous execution added in module `Python.Inline.Async`. - It adds API copied from `async` and interruptible python computations. -* `runPyInMain` could be reliably interrupted by asynchronous exceptions. -* Package now uses `Custom` build type. It now supports configuring python using - `python3-config` instead of `pkg-config` when `-fpython3-config` manual cabal - flag is set. Default behavior is unchanged. +* Support for asynchronous execution added in module `Python.Inline.Async`. It + uses API modelled after `async` package. Such computations could be + interrupted using `cancelPy` even when they're running python code or haskell + callback/ +* When threaded runtime is used `runPyInMain` could be reliably interrupted by + asynchronous exceptions. * Python module `inline_python` is now available. It contains exception types used by library: `AsyncCancelled` and `HaskellError` which wraps haskell exception from callback. +* `Python.Inline.Monad` and `Python.Inline.Monad.QQ` modules providing monadic + API. It uses `MonadPy` type class which allows user code to carry around + python dictionaries with global and local scopes. +* Package now uses `Custom` build type. It now supports configuring python using + `python3-config` instead of `pkg-config` when `-fpython3-config` manual cabal + flag is set. Default behavior is unchanged. * Haskell exception raised in haskell callback will be rethrown if not caught by python instead of being converted to `PyError`. * Memory leak in exception handling is fixed. Python exception object were never