From cd273b65badc59a32e665e3ee0dbffe8bd157011 Mon Sep 17 00:00:00 2001 From: Alexey Khudyakov Date: Mon, 21 Sep 2026 12:00:27 +0300 Subject: [PATCH 1/3] Improve haddocks --- src/Python/Inline/QQ.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/Python/Inline/QQ.hs b/src/Python/Inline/QQ.hs index fffd960..11e3dcd 100644 --- a/src/Python/Inline/QQ.hs +++ b/src/Python/Inline/QQ.hs @@ -109,9 +109,10 @@ pyf = QuasiQuoter } -- | Create quote of python code suitable for use with --- 'Python.Inline.Eval.exec' +-- 'Python.Inline.Eval.exec', 'Python.Inline.Eval.eval', +-- 'Python.Inline.Eval.evalPyFunction'. -- --- It creates value of type @PyQuote@ +-- It creates value of type 'Python.Inline.Eval.PyQuote'. -- -- @since 0.2@ pycode :: QuasiQuoter From 163b45ac4669f7907a5520031f5a60e683b7f1b5 Mon Sep 17 00:00:00 2001 From: Alexey Khudyakov Date: Tue, 29 Sep 2026 14:31:46 +0300 Subject: [PATCH 2/3] Python ast parser doesn't choke on return outside of function def No need for special treatment --- src/Python/Internal/EvalQQ.hs | 11 ++--------- 1 file changed, 2 insertions(+), 9 deletions(-) diff --git a/src/Python/Internal/EvalQQ.hs b/src/Python/Internal/EvalQQ.hs index 2de568d..59dc22f 100644 --- a/src/Python/Internal/EvalQQ.hs +++ b/src/Python/Internal/EvalQQ.hs @@ -88,8 +88,7 @@ expQQ :: Mode -- ^ Python evaluation mode: @exec@/@eval@ -> TH.Q TH.Exp expQQ mode qq_src = do -- We need to preprocess before passing it to python. - let src = prepareSource mode qq_src - src_var = prepareForVarLookup mode src + let src = prepareSource mode qq_src antis <- liftIO $ do -- We've embedded script into library and we need to pass source -- code of QQ to a script. It can contain whatever symbols so to @@ -105,7 +104,7 @@ expQQ mode qq_src = do , "decode_and_print('" <> concat [ [ intToDigit $ fromIntegral (w `shiftR` 4) , intToDigit $ fromIntegral (w .&. 15) ] - | w <- BS.unpack $ T.encodeUtf8 $ T.pack src_var + | w <- BS.unpack $ T.encodeUtf8 $ T.pack src ] <> "')" ] @@ -140,12 +139,6 @@ prepareSource = \case Exec -> unindent Fun -> unindent -prepareForVarLookup :: Mode -> String -> String -prepareForVarLookup = \case - Eval -> id - Exec -> id - Fun -> ("def __dummy__():\n"++) . indent - prepareForEval :: Mode -> [String] -> String -> String prepareForEval mode vars src = case mode of Eval -> src From 41d2e1802c5e344008814907f58c9efe05db7e88 Mon Sep 17 00:00:00 2001 From: Alexey Khudyakov Date: Tue, 29 Sep 2026 14:42:07 +0300 Subject: [PATCH 3/3] Restructure test suite --- test/TST/Run.hs | 174 ++++++++++++++++++++++++++++-------------------- 1 file changed, 100 insertions(+), 74 deletions(-) diff --git a/test/TST/Run.hs b/test/TST/Run.hs index 1665f4a..34beb5f 100644 --- a/test/TST/Run.hs +++ b/test/TST/Run.hs @@ -20,7 +20,18 @@ tests :: TestTree tests = testGroup "Run python" [ testCase "Empty QQ" $ runPy [py_| |] , testCase "Second init is noop" $ initializePython - , testCase "Nested runPy" $ runPy $ liftIO $ runPy $ pure () + , testRunPy + , testScope + , testEvalExec + , testMonadic + , testAsync + ] + +-- Test that python evaluation works in general and its interaction +-- with exceptions +testRunPy :: TestTree +testRunPy = testGroup "Running python" + [ testCase "Nested runPy" $ runPy $ liftIO $ runPy $ pure () , testCase "Nested runPyInMain" $ runPyInMain $ liftIO $ runPyInMain $ pure () , testCase "runPyInMain" $ runPyInMain $ [py_| import threading @@ -44,7 +55,12 @@ tests = testGroup "Run python" $ do liftIO $ putMVar lock () liftIO $ threadDelay 10_000_000 error "Should be interrupted" - , testCase "Scope pymain->any" $ runPy $ do + ] + +-- Test that different quasiquotes correctly handle scoping +testScope :: TestTree +testScope = testGroup "Python scope" + [ testCase "Scope pymain->any" $ runPy $ do [pymain| x = 12 x @@ -135,7 +151,11 @@ tests = testGroup "Run python" except NameError: pass |] - , testCase "pyf works" $ do + ] + +testEvalExec :: TestTree +testEvalExec = testGroup "eval/exec" + [ testCase "pyf works" $ do let x = 12 :: Int eq (Just (482412::Int)) [pyf| xs = [i*x_hs for i in [1, 200, 40000]] @@ -166,79 +186,85 @@ tests = testGroup "Run python" assert m_hs.a == 12 assert m_hs.b == 'asd' |] - , testGroup "async" $ guardThreaded - [ -- We can run async computation at all - testCase "runPyAsync" $ do - runPy [pymain| dct = {} |] - a <- runPyAsync $ [py_| dct[1] = 100 |] - _ <- atomically $ waitPy a - n <- runPy $ fromPy =<< [pye| dct[1] |] - assertEqual "x" (Just (100::Int)) n - runPy [pymain| del dct |] - , -- Cancellation of python code - testCase "cancelPy [python]" $ do - a <- runPyAsync $ forever $ [py_| - import time - while True: - time.sleep(1e-3) - |] - d <- registerDelay 100_000 - threadDelay 100 -- Wait to make sure execution actually started - cancelPy a - _ <- atomically $ waitPyCatch a `orElse` do readTVar d >>= \case - True -> error "Timeout" - False -> retry - return () - , -- Cancellation of haskell code - testCase "cancelPy [haskell]" $ do - a <- runPyAsync $ do - liftIO $ forever $ threadDelay 1_000_000 - d <- registerDelay 100_000 - threadDelay 100 - cancelPy a - _ <- atomically $ waitPyCatch a `orElse` do readTVar d >>= \case - True -> error "Timeout" - False -> retry - return () - , -- Cancellation of haskell code - testCase "cancelPy [callback]" $ do - a <- runPyAsync $ do - let loop = forever $ threadDelay 1_000_000 :: IO () - forever [py_| loop_hs() |] - d <- registerDelay 100_000 - threadDelay 100 - _ <- forkIO $ cancelPy a - _ <- atomically $ waitPyCatch a `orElse` do readTVar d >>= \case - True -> error "Timeout" - False -> retry - return () - , testCase "Exception in runPyInMain works py" $ do - lock <- newEmptyMVar - tid <- myThreadId - _ <- forkIO $ takeMVar lock >> threadDelay 1000 >> throwTo tid Stop - handle (\Stop -> pure ()) - $ runPyInMain - $ do liftIO $ putMVar lock () - [py_| - import time - while True: - time.sleep(1e-3) - |] - 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 - ] ] +testAsync :: TestTree +testAsync = testGroup "async" $ guardThreaded + [ -- We can run async computation at all + testCase "runPyAsync" $ do + runPy [pymain| dct = {} |] + a <- runPyAsync $ [py_| dct[1] = 100 |] + _ <- atomically $ waitPy a + n <- runPy $ fromPy =<< [pye| dct[1] |] + assertEqual "x" (Just (100::Int)) n + runPy [pymain| del dct |] + , -- Cancellation of python code + testCase "cancelPy [python]" $ do + a <- runPyAsync $ forever $ [py_| + import time + while True: + time.sleep(1e-3) + |] + d <- registerDelay 100_000 + threadDelay 100 -- Wait to make sure execution actually started + cancelPy a + _ <- atomically $ waitPyCatch a `orElse` do readTVar d >>= \case + True -> error "Timeout" + False -> retry + return () + , -- Cancellation of haskell code + testCase "cancelPy [haskell]" $ do + a <- runPyAsync $ do + liftIO $ forever $ threadDelay 1_000_000 + d <- registerDelay 100_000 + threadDelay 100 + cancelPy a + _ <- atomically $ waitPyCatch a `orElse` do readTVar d >>= \case + True -> error "Timeout" + False -> retry + return () + , -- Cancellation of haskell code + testCase "cancelPy [callback]" $ do + a <- runPyAsync $ do + let loop = forever $ threadDelay 1_000_000 :: IO () + forever [py_| loop_hs() |] + d <- registerDelay 100_000 + threadDelay 100 + _ <- forkIO $ cancelPy a + _ <- atomically $ waitPyCatch a `orElse` do readTVar d >>= \case + True -> error "Timeout" + False -> retry + return () + , testCase "Exception in runPyInMain works py" $ do + lock <- newEmptyMVar + tid <- myThreadId + _ <- forkIO $ takeMVar lock >> threadDelay 1000 >> throwTo tid Stop + handle (\Stop -> pure ()) + $ runPyInMain + $ do liftIO $ putMVar lock () + [py_| + import time + while True: + time.sleep(1e-3) + |] + error "Should be interrupted" + ] + + +-- Here we only test that quasiquotes produce correct code +testMonadic :: TestTree +testMonadic = 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 deriving stock Show deriving anyclass Exception