From 6307c1af68103d4ddd70b698e2f49f943ab6e0c1 Mon Sep 17 00:00:00 2001 From: Alexey Khudyakov Date: Fri, 3 Jan 2025 12:22:45 +0300 Subject: [PATCH 1/6] Make QuasiQuotes default-extension in tests --- inline-python.cabal | 2 ++ test/TST/FromPy.hs | 1 - test/TST/Run.hs | 1 - test/TST/ToPy.hs | 2 -- 4 files changed, 2 insertions(+), 4 deletions(-) diff --git a/inline-python.cabal b/inline-python.cabal index e25407e..66f908a 100644 --- a/inline-python.cabal +++ b/inline-python.cabal @@ -79,6 +79,8 @@ Library ---------------------------------------------------------------- library test import: language + Default-Extensions: + QuasiQuotes build-depends: base , inline-python , tasty >=1.2 diff --git a/test/TST/FromPy.hs b/test/TST/FromPy.hs index 2da3940..dbc2bdb 100644 --- a/test/TST/FromPy.hs +++ b/test/TST/FromPy.hs @@ -1,5 +1,4 @@ {-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE QuasiQuotes #-} -- | module TST.FromPy (tests) where diff --git a/test/TST/Run.hs b/test/TST/Run.hs index 016f3c7..f9ca6de 100644 --- a/test/TST/Run.hs +++ b/test/TST/Run.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE QuasiQuotes #-} -- | module TST.Run(tests) where diff --git a/test/TST/ToPy.hs b/test/TST/ToPy.hs index 380b1dc..6dadb7c 100644 --- a/test/TST/ToPy.hs +++ b/test/TST/ToPy.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE QuasiQuotes #-} -- | module TST.ToPy (tests) where From 0ea08fa16037a9bda82fa4fe785b650b6eedbb82 Mon Sep 17 00:00:00 2001 From: Alexey Khudyakov Date: Fri, 3 Jan 2025 12:33:06 +0300 Subject: [PATCH 2/6] Reorganize tests --- inline-python.cabal | 2 + test/TST/Callbacks.hs | 50 ++++++++++++++++ test/TST/Run.hs | 129 +++++++++++++----------------------------- test/TST/Util.hs | 12 ++++ test/exe/main.hs | 2 + 5 files changed, 105 insertions(+), 90 deletions(-) create mode 100644 test/TST/Callbacks.hs create mode 100644 test/TST/Util.hs diff --git a/inline-python.cabal b/inline-python.cabal index 66f908a..394da04 100644 --- a/inline-python.cabal +++ b/inline-python.cabal @@ -90,6 +90,8 @@ library test TST.Run TST.ToPy TST.FromPy + TST.Callbacks + TST.Util test-suite inline-python-tests import: language diff --git a/test/TST/Callbacks.hs b/test/TST/Callbacks.hs new file mode 100644 index 0000000..a5e5864 --- /dev/null +++ b/test/TST/Callbacks.hs @@ -0,0 +1,50 @@ +-- | +module TST.Callbacks (tests) where + +import Test.Tasty +import Test.Tasty.HUnit +import Python.Inline +import Python.Inline.QQ + +import TST.Util + +tests :: TestTree +tests = testGroup "Callbacks" + [ testCase "Function(arity=1)" $ do + let double = pure . (*2) :: Int -> IO Int + [py_| + # OK + assert double_hs(3) == 6 + # Invalid arg + try: + double_hs(None) + except TypeError as e: + pass + # Wrong arg number + try: + double_hs(1,2,3) + except TypeError as e: + pass + |] + , testCase "Function(arity=2)" $ do + let foo :: Int -> Double -> IO Int + foo x y = pure $ x + round y + [py_| + assert foo_hs(3, 100.2) == 103 + assert foo_hs(3, 100) == 103 + # Invalid arg + try: + foo_hs(None, 100) + except TypeError as e: + pass + # Wrong arg number + try: + foo_hs(1,2,3) + except TypeError as e: + pass + |] + , testCase "Haskell exception in callback" $ do + let foo :: Int -> Int -> IO Int + foo x y = pure $ x `div` y + throwsPy [py_| foo_hs(1, 0) |] + ] diff --git a/test/TST/Run.hs b/test/TST/Run.hs index f9ca6de..3a733fe 100644 --- a/test/TST/Run.hs +++ b/test/TST/Run.hs @@ -1,114 +1,63 @@ -- | +-- Tests for variable scope and names module TST.Run(tests) where -import Control.Exception +import Control.Monad import Test.Tasty import Test.Tasty.HUnit -import Python.Inline import Python.Inline.QQ +import TST.Util tests :: TestTree tests = testGroup "Run python" [ testCase "Empty QQ" [py_| |] , testCase "Python exceptions are converted" $ throwsPy [py_| 1 / 0 |] - , testsScope - , testCapture - ] - - -testsScope :: TestTree -testsScope = testGroup "Variable scope" - [ testCase "pymain->any" $ do + , testCase "Scope pymain->any" $ do [pymain| x = 12 x |] -- Visible - [py_| - x - |] + _ <- [py_| x |] + [pye| x |] [pymain| - x - del x - |] + x + del x + |] -- Disappears [pymain| - try: - x - assert False, "x shouln't be visible" - except NameError: - pass - |] - , testCase "py_->any" $ do + try: + x + assert False, "x shouln't be visible" + except NameError: + pass + |] [py_| - x = 12 - x - |] + try: + x + assert False, "x shouln't be visible" + except NameError: + pass + |] + , testCase "Scope py_->any" $ do + [py_| + x = 12 + x + |] -- Not visible + throwsPy $ void [pye| x |] [py_| - try: - x - assert False, "x shouln't be visible (1)" - except NameError: - pass - |] + try: + x + assert False, "x shouln't be visible (1)" + except NameError: + pass + |] [pymain| - try: - x - assert False, "x shouln't be visible (2)" - except NameError: - pass - |] - ] - - - -testCapture :: TestTree -testCapture = testGroup "Capture of vars" - [ testCase "Capture int" $ let i = 1::Int in [py_| assert i_hs == 1 |] - , testCase "Capture double" $ let x = 1.5::Double in [py_| assert x_hs == 1.5 |] - -- - , testCase "Closure(arity=1)" $ do - let double = pure . (*2) :: Int -> IO Int - [py_| - assert double_hs(3) == 6 - # Invalid arg - try: - double_hs(None) - except TypeError as e: - pass - # Wrong arg number - try: - double_hs(1,2,3) - except TypeError as e: - pass - |] - , testCase "Closure(arity=2)" $ do - let foo :: Int -> Double -> IO Int - foo x y = pure $ x + round y - [py_| - assert foo_hs(3, 100.2) == 103 - assert foo_hs(3, 100) == 103 - # Invalid arg - try: - foo_hs(None, 100) - except TypeError as e: - pass - # Wrong arg number - try: - foo_hs(1,2,3) - except TypeError as e: - pass - - |] - -- - , testCase "Haskell exception in callbacks" $ do - let foo :: Int -> Int -> IO Int - foo x y = pure $ x `div` y - throwsPy [py_| foo_hs(1, 0) |] + try: + x + assert False, "x shouln't be visible (2)" + except NameError: + pass + |] ] - - -throwsPy :: IO () -> IO () -throwsPy io = (io >> assertFailure "Evaluation should raise python exception") - `catch` (\(_::PyError) -> pure ()) diff --git a/test/TST/Util.hs b/test/TST/Util.hs new file mode 100644 index 0000000..c6f6cb5 --- /dev/null +++ b/test/TST/Util.hs @@ -0,0 +1,12 @@ +-- | +module TST.Util where + +import Control.Exception +import Test.Tasty.HUnit + +import Python.Inline + +throwsPy :: IO () -> IO () +throwsPy io = (io >> assertFailure "Evaluation should raise python exception") + `catch` (\(_::PyError) -> pure ()) + diff --git a/test/exe/main.hs b/test/exe/main.hs index 73427c9..96b2cf8 100644 --- a/test/exe/main.hs +++ b/test/exe/main.hs @@ -5,6 +5,7 @@ import Test.Tasty import TST.Run import TST.FromPy import TST.ToPy +import TST.Callbacks import Python.Inline main :: IO () @@ -12,4 +13,5 @@ main = withPython $ defaultMain $ testGroup "PY" [ TST.Run.tests , TST.FromPy.tests , TST.ToPy.tests + , TST.Callbacks.tests ] From b3df7aa45f2305c8313357dc448d414a3e4672a3 Mon Sep 17 00:00:00 2001 From: Alexey Khudyakov Date: Fri, 3 Jan 2025 13:20:44 +0300 Subject: [PATCH 3/6] Add test case for calling python from haskell callback --- test/TST/Callbacks.hs | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/test/TST/Callbacks.hs b/test/TST/Callbacks.hs index a5e5864..c316cef 100644 --- a/test/TST/Callbacks.hs +++ b/test/TST/Callbacks.hs @@ -47,4 +47,11 @@ tests = testGroup "Callbacks" let foo :: Int -> Int -> IO Int foo x y = pure $ x `div` y throwsPy [py_| foo_hs(1, 0) |] - ] + , testCase "Call python in callback" $ do + let foo :: Int -> IO Int + foo x = do Just x' <- fromPy =<< [pye| 100 // x_hs |] + pure x' + [py_| + assert foo_hs(5) == 20 + |] + ] From 2d86cab15b076789245c996404eac06c7d8916a9 Mon Sep 17 00:00:00 2001 From: Alexey Khudyakov Date: Fri, 3 Jan 2025 13:55:48 +0300 Subject: [PATCH 4/6] Acquire GIL before starting evaluation of python code --- src/Python/Internal/Eval.hs | 15 +++++++++++++-- 1 file changed, 13 insertions(+), 2 deletions(-) diff --git a/src/Python/Internal/Eval.hs b/src/Python/Internal/Eval.hs index 9c29ff2..7603366 100644 --- a/src/Python/Internal/Eval.hs +++ b/src/Python/Internal/Eval.hs @@ -15,6 +15,7 @@ module Python.Internal.Eval -- * PyObject wrapper , newPyObject , decref + , ensureGIL -- * Exceptions , convertHaskell2Py , convertPy2Haskell @@ -205,7 +206,7 @@ runPy py -- Single-threaded RTS -- -- See NOTE: [Async exceptions] - | otherwise = mask_ $ unPy py + | otherwise = mask_ $ unPy $ ensureGIL py -- | Execute python action. This function is unsafe and should be only @@ -324,7 +325,7 @@ evalReq = do Cancelled -> return (Cancelled,False) Pending -> return (Running, True) when do_eval $ do - a <- (Right <$> mask_ io) `catches` + a <- (Right <$> mask_ (unPy $ ensureGIL prog)) `catches` [ Handler $ \(e :: AsyncException) -> throwIO e , Handler $ \(e :: SomeAsyncException) -> throwIO e , Handler $ \(e :: SomeException) -> pure (Left e) @@ -347,6 +348,16 @@ evalReq = do decref :: Ptr PyObject -> Py () decref p = Py [CU.exp| void { Py_DECREF($(PyObject* p)) } |] +-- | Ensure that we hold GIL for duration of action +ensureGIL :: Py a -> Py a +ensureGIL action = do + -- NOTE: We're cheating here and looking behind the veil. + -- PyGILState_STATE is defined as enum. Let hope it will stay + -- this way. + gil_state <- Py [CU.exp| int { PyGILState_Ensure() } |] + action `finallyPy` Py [CU.exp| void { PyGILState_Release($(int gil_state)) } |] + + -- | Wrap raw python object into newPyObject :: Ptr PyObject -> Py PyObject -- We need to use different implementation for different RTS From 6aac5348faa21813a029032cdcebd0506253472d Mon Sep 17 00:00:00 2001 From: Alexey Khudyakov Date: Fri, 3 Jan 2025 15:40:28 +0300 Subject: [PATCH 5/6] Calling python in haskell callbacks now works in threaded RTS --- cbits/python.c | 101 ++++++++++++++++++++++++++++------- include/inline-python.h | 37 +++++++++---- src/Python/Inline/Literal.hs | 18 +++---- src/Python/Internal/Eval.hs | 38 +++++++------ test/TST/Callbacks.hs | 41 +++++++------- 5 files changed, 160 insertions(+), 75 deletions(-) diff --git a/cbits/python.c b/cbits/python.c index 30a6802..cdfb76b 100644 --- a/cbits/python.c +++ b/cbits/python.c @@ -1,22 +1,93 @@ #include #include -PyObject *inline_py_function_wrapper(PyCFunction fun, int flags) { - PyMethodDef *meth = malloc(sizeof(PyMethodDef)); - meth->ml_name = "[inline_python]"; - meth->ml_meth = fun; - meth->ml_flags = flags; - meth->ml_doc = "Wrapper constructed by inline-python"; - // Python wrapper which carries PyMethodDef - PyObject* meth_obj = PyCapsule_New(meth, NULL, &inline_py_free_capsule); +// ================================================================ +// Callbacks +// +// General idea: we store function pointer (haskell's FunPtr) in +// PyCapsule and use to call function. Most importantly we must +// release GIL before calling into haskell. Haskell callback will +// happen on different thread (on threaded RTS). So it'll have to +// reacquire GIL there. +// ================================================================ + +int inline_py_callback_depth = 0; + +static PyObject* callback_METH_O(PyObject* self, PyObject* arg) { + PyObject *res; + PyCFunction *fun = PyCapsule_GetPointer(self, NULL); + //-- + inline_py_callback_depth++; +Py_BEGIN_ALLOW_THREADS + res = (*fun)(self, arg); +Py_END_ALLOW_THREADS + inline_py_callback_depth--; + return res; +} + +static PyObject* callback_METH_FASTCALL(PyObject* self, PyObject** args, Py_ssize_t nargs) { + PyObject *res; + PyCFunctionFast *fun = PyCapsule_GetPointer(self, NULL); + //-- + inline_py_callback_depth++; +Py_BEGIN_ALLOW_THREADS + res = (*fun)(self, args, nargs); +Py_END_ALLOW_THREADS + inline_py_callback_depth--; + return res; +} + +static void capsule_free_FunPtr(PyObject* capsule) { + PyCFunction *fun = PyCapsule_GetPointer(capsule, NULL); + // We call directly to haskell RTS to free FunPtr. Only question + // is how stable is this API. + freeHaskellFunctionPtr(*fun); + free(fun); +} + +static PyMethodDef method_METH_O = { + .ml_name = "[inline_python]", + .ml_meth = callback_METH_O, + .ml_flags = METH_O, + .ml_doc = "Wrapper for haskell callback" +}; + +static PyMethodDef method_METH_FASTCALL = { + .ml_name = "[inline_python]", + .ml_meth = (PyCFunction)callback_METH_FASTCALL, + .ml_flags = METH_FASTCALL, + .ml_doc = "Wrapper for haskell callback" +}; + +PyObject *inline_py_callback_METH_O(PyCFunction fun) { + PyCFunction *buf = malloc(sizeof(PyCFunction)); + *buf = fun; + PyObject* self = PyCapsule_New(buf, NULL, &capsule_free_FunPtr); if( PyErr_Occurred() ) return NULL; // Python function - PyObject* f = PyCFunction_New(meth, meth_obj); - Py_DECREF(meth_obj); - return f; + PyObject* f = PyCFunction_New(&method_METH_O, self); + Py_DECREF(self); + return f; } +PyObject *inline_py_callback_METH_FASTCALL(PyCFunctionFast fun) { + PyCFunctionFast *buf = malloc(sizeof(PyCFunctionFast)); + *buf = fun; + PyObject* self = PyCapsule_New(buf, NULL, &capsule_free_FunPtr); + if( PyErr_Occurred() ) + return NULL; + // Python function + PyObject* f = PyCFunction_New(&method_METH_FASTCALL, self); + Py_DECREF(self); + return f; +} + + +// ================================================================ +// Marshalling +// ================================================================ + int inline_py_unpack_iterable(PyObject *iterable, int n, PyObject **out) { // Initialize iterator. If object is not an iterable we treat this // as not an exception but as a conversion failure @@ -57,11 +128,3 @@ int inline_py_unpack_iterable(PyObject *iterable, int n, PyObject **out) { 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 - // doesn't seems to be nice and stable C API - freeHaskellFunctionPtr(meth->ml_meth); - free(meth); -} - diff --git a/include/inline-python.h b/include/inline-python.h index 2a002c6..b6f0e1c 100644 --- a/include/inline-python.h +++ b/include/inline-python.h @@ -5,6 +5,11 @@ #include +// Use new stable API from +#ifndef PyCFunctionFast +typedef _PyCFunctionFast PyCFunctionFast; +#endif + // ---------------------------------------------------------------- // Standard status codes @@ -12,7 +17,27 @@ #define IPY_ERR_PYTHON 1 #define IPY_ERR_COMPILE 2 -// ---------------------------------------------------------------- + + +// ================================================================ +// Callbacks +// ================================================================ + +// Callback depth. It's used to decide whether we want to just +// continue in bound thread. Should only be modified while GIL is held +extern int inline_py_callback_depth; + +// Wrap haskell callback using METH_O calling convention +PyObject *inline_py_callback_METH_O(PyCFunction fun); + +// Wrap haskell callback using METH_FASTCALL calling convention +PyObject *inline_py_callback_METH_FASTCALL(PyCFunctionFast fun); + + + +// ================================================================ +// Callbacks +// ================================================================ // Unpack iterable into array of PyObjects. Iterable must contain // exactly N elements. @@ -27,13 +52,3 @@ int inline_py_unpack_iterable( int n, PyObject **out ); - -// Allocate python function object which carrries its own PyMethodDef. -// Returns function object or NULL with error raised. -// -// See NOTE: [Creation of python functions] -PyObject *inline_py_function_wrapper(PyCFunction fun, int flags); - -// Free malloc'd buffer inside PyCapsule -void inline_py_free_capsule(PyObject*); - diff --git a/src/Python/Inline/Literal.hs b/src/Python/Inline/Literal.hs index e1e45e9..a9d10ee 100644 --- a/src/Python/Inline/Literal.hs +++ b/src/Python/Inline/Literal.hs @@ -12,6 +12,7 @@ module Python.Inline.Literal , fromPy' ) where +import Control.Concurrent import Control.Exception import Control.Monad import Control.Monad.IO.Class @@ -285,7 +286,7 @@ instance (FromPy a) => FromPy [a] where -- with async exception out of the blue -instance (FromPy a, ToPy b) => ToPy (a -> IO b) where +instance (FromPy a, Show a, ToPy b) => ToPy (a -> IO b) where basicToPy f = Py $ do -- C function pointer for callback f_ptr <- wrapO $ \_ p_a -> pyCallback $ do @@ -295,10 +296,9 @@ instance (FromPy a, ToPy b) => ToPy (a -> IO b) where Right a -> pure a liftIO $ unPy . basicToPy =<< f a -- - [C.exp| PyObject* { - inline_py_function_wrapper( - $(PyObject* (*f_ptr)(PyObject*, PyObject*)), - METH_O) + [CU.block| PyObject* { + inline_py_callback_METH_O( + $(PyObject* (*f_ptr)(PyObject*, PyObject*))); }|] instance (FromPy a1, FromPy a2, ToPy b) => ToPy (a1 -> a2 -> IO b) where @@ -311,10 +311,8 @@ instance (FromPy a1, FromPy a2, ToPy b) => ToPy (a1 -> a2 -> IO b) where liftIO $ unPy . basicToPy =<< f a b -- Create python function [C.block| PyObject* { - _PyCFunctionFast impl = $(PyObject* (*f_ptr)(PyObject*, PyObject*const*, int64_t)); - return inline_py_function_wrapper( - (PyCFunction)impl, - METH_FASTCALL); + PyCFunctionFast impl = $(PyObject* (*f_ptr)(PyObject*, PyObject*const*, int64_t)); + return inline_py_callback_METH_FASTCALL(impl); }|] loadArgFastcall :: FromPy a => Ptr (Ptr PyObject) -> Int -> Int64 -> Program (Ptr PyObject) a @@ -331,7 +329,7 @@ loadArgFastcall p_arr i tot = do ---------------------------------------------------------------- pyCallback :: Program (Ptr PyObject) (Ptr PyObject) -> IO (Ptr PyObject) -pyCallback io = unPy $ evalContT io `catchPy` convertHaskell2Py +pyCallback io = unPy $ ensureGIL $ evalContT io `catchPy` convertHaskell2Py raiseUndecodedArg :: CInt -> CInt -> Py (Ptr PyObject) raiseUndecodedArg n tot = Py [CU.block| PyObject* { diff --git a/src/Python/Internal/Eval.hs b/src/Python/Internal/Eval.hs index 7603366..4e1222d 100644 --- a/src/Python/Internal/Eval.hs +++ b/src/Python/Internal/Eval.hs @@ -187,22 +187,26 @@ runPy :: Py a -> IO a -- See NOTE: [Threading and exceptions] runPy py -- Multithreaded RTS - | rtsSupportsBoundThreads = do - result <- newEmptyMVar - status <- newMVar Pending - let onExc :: SomeException -> IO b - onExc e = do - modifyMVar_ status $ \case - Pending -> pure Cancelled - Cancelled -> pure Cancelled - Done -> pure Done - Running -> Cancelled <$ [CU.exp| void { PyErr_SetInterrupt() } |] - throwIO e - (do putMVar toPythonThread $ PyEvalReq{ prog=py, ..} - takeMVar result >>= \case - Left e -> throwIO e - Right a -> pure a - ) `catch` onExc + -- + -- Here we check whether we're in callback or creating a new call + | rtsSupportsBoundThreads = [CU.exp| int { inline_py_callback_depth } |] >>= \case + 0 -> do + result <- newEmptyMVar + status <- newMVar Pending + let onExc :: SomeException -> IO b + onExc e = do + modifyMVar_ status $ \case + Pending -> pure Cancelled + Cancelled -> pure Cancelled + Done -> pure Done + Running -> Cancelled <$ [CU.exp| void { PyErr_SetInterrupt() } |] + throwIO e + (do putMVar toPythonThread $ PyEvalReq{ prog=py, ..} + takeMVar result >>= \case + Left e -> throwIO e + Right a -> pure a + ) `catch` onExc + _ -> unPy $ ensureGIL py -- Single-threaded RTS -- -- See NOTE: [Async exceptions] @@ -312,7 +316,7 @@ evalReq :: IO () -- See NOTE: [Python and threading] -- See NOTE: [Threading and exceptions] evalReq = do - PyEvalReq{prog=Py io, result, status} <- takeMVar toPythonThread + PyEvalReq{prog, result, status} <- takeMVar toPythonThread -- GC let decrefList Nil = pure () decrefList (p `Cons` ps) = do [CU.exp| void { Py_XDECREF($(PyObject* p)) } |] diff --git a/test/TST/Callbacks.hs b/test/TST/Callbacks.hs index c316cef..beb17d6 100644 --- a/test/TST/Callbacks.hs +++ b/test/TST/Callbacks.hs @@ -1,6 +1,7 @@ -- | module TST.Callbacks (tests) where +import Control.Concurrent import Test.Tasty import Test.Tasty.HUnit import Python.Inline @@ -26,24 +27,28 @@ tests = testGroup "Callbacks" except TypeError as e: pass |] - , testCase "Function(arity=2)" $ do - let foo :: Int -> Double -> IO Int - foo x y = pure $ x + round y - [py_| - assert foo_hs(3, 100.2) == 103 - assert foo_hs(3, 100) == 103 - # Invalid arg - try: - foo_hs(None, 100) - except TypeError as e: - pass - # Wrong arg number - try: - foo_hs(1,2,3) - except TypeError as e: - pass - |] - , testCase "Haskell exception in callback" $ do + , testCase "Function(arity=2)" $ do + let foo :: Int -> Double -> IO Int + foo x y = pure $ x + round y + [py_| + assert foo_hs(3, 100.2) == 103 + assert foo_hs(3, 100) == 103 + # Invalid arg + try: + foo_hs(None, 100) + except TypeError as e: + pass + # Wrong arg number + try: + foo_hs(1,2,3) + except TypeError as e: + pass + |] + , testCase "Haskell exception in callback(arity=1)" $ do + let foo :: Int -> IO Int + foo y = pure $ 10 `div` y + throwsPy [py_| foo_hs(0) |] + , testCase "Haskell exception in callback(arity=2)" $ do let foo :: Int -> Int -> IO Int foo x y = pure $ x `div` y throwsPy [py_| foo_hs(1, 0) |] From 1504a4074c1104aee10bc91fd8869fb27a0077ac Mon Sep 17 00:00:00 2001 From: Alexey Khudyakov Date: Fri, 3 Jan 2025 15:46:14 +0300 Subject: [PATCH 6/6] Fix warnings --- src/Python/Inline/Literal.hs | 3 --- src/Python/Internal/EvalQQ.hs | 3 --- src/Python/Internal/Program.hs | 1 - src/Python/Types.hs | 5 ----- test/TST/Callbacks.hs | 1 - test/TST/Run.hs | 4 ++-- test/TST/ToPy.hs | 1 - 7 files changed, 2 insertions(+), 16 deletions(-) diff --git a/src/Python/Inline/Literal.hs b/src/Python/Inline/Literal.hs index a9d10ee..cf9c1bc 100644 --- a/src/Python/Inline/Literal.hs +++ b/src/Python/Inline/Literal.hs @@ -12,8 +12,6 @@ module Python.Inline.Literal , fromPy' ) where -import Control.Concurrent -import Control.Exception import Control.Monad import Control.Monad.IO.Class import Control.Monad.Trans.Class @@ -24,7 +22,6 @@ import Data.Word import Data.Foldable import Foreign.Ptr import Foreign.C.Types -import Foreign.Marshal.Alloc import Foreign.Storable import Language.C.Inline qualified as C diff --git a/src/Python/Internal/EvalQQ.hs b/src/Python/Internal/EvalQQ.hs index f69bbdc..0087119 100644 --- a/src/Python/Internal/EvalQQ.hs +++ b/src/Python/Internal/EvalQQ.hs @@ -14,14 +14,11 @@ module Python.Internal.EvalQQ , unindent ) where -import Control.Exception import Control.Monad.IO.Class import Control.Monad.Trans.Class import Control.Monad.Trans.Cont import Data.Char import Foreign.C.Types -import Foreign.C.String -import Foreign.Marshal.Alloc import Foreign.Ptr import Foreign.Storable import System.Exit diff --git a/src/Python/Internal/Program.hs b/src/Python/Internal/Program.hs index 81c6fd3..223db06 100644 --- a/src/Python/Internal/Program.hs +++ b/src/Python/Internal/Program.hs @@ -14,7 +14,6 @@ module Python.Internal.Program , withPyWCString ) where -import Control.Exception import Control.Monad.Trans.Cont import Data.Coerce import Foreign.Ptr diff --git a/src/Python/Types.hs b/src/Python/Types.hs index 610455b..da1631d 100644 --- a/src/Python/Types.hs +++ b/src/Python/Types.hs @@ -10,13 +10,8 @@ module Python.Types ) where import Data.Coerce - import Foreign.Ptr -import Foreign.ForeignPtr -import Language.C.Inline qualified as C - import GHC.ForeignPtr - import Python.Internal.Types unsafeWithPyObject :: forall a. PyObject -> (Ptr PyObject -> Py a) -> Py a diff --git a/test/TST/Callbacks.hs b/test/TST/Callbacks.hs index beb17d6..bb0ae50 100644 --- a/test/TST/Callbacks.hs +++ b/test/TST/Callbacks.hs @@ -1,7 +1,6 @@ -- | module TST.Callbacks (tests) where -import Control.Concurrent import Test.Tasty import Test.Tasty.HUnit import Python.Inline diff --git a/test/TST/Run.hs b/test/TST/Run.hs index 3a733fe..0ff4d13 100644 --- a/test/TST/Run.hs +++ b/test/TST/Run.hs @@ -18,8 +18,8 @@ tests = testGroup "Run python" x |] -- Visible - _ <- [py_| x |] - [pye| x |] + [py_| x |] + _ <- [pye| x |] [pymain| x del x diff --git a/test/TST/ToPy.hs b/test/TST/ToPy.hs index 6dadb7c..c19574d 100644 --- a/test/TST/ToPy.hs +++ b/test/TST/ToPy.hs @@ -3,7 +3,6 @@ module TST.ToPy (tests) where import Test.Tasty import Test.Tasty.HUnit -import Python.Inline import Python.Inline.QQ tests :: TestTree