All work with python is done in Py monad

bench/Main.hs

@@ -1,7 +1,6 @@
 {-# LANGUAGE QuasiQuotes #-}
 module Main where
 
-import Test.Tasty       hiding (defaultMain)
 import Test.Tasty.Bench
 
 import Python.Inline
@@ -10,7 +9,7 @@ import Python.Inline.QQ
 
 main :: IO ()
 main = withPython $ do
-  py_int <- [pye| 123456 |]
+  py_int <- runPy [pye| 123456 |]
   defaultMain
-    [ bench "FromPy Int" $ whnfIO $ fromPy' @Int py_int
+    [ bench "FromPy Int" $ whnfIO $ runPy $ fromPy' @Int py_int
     ]

inline-python.cabal

@@ -56,6 +56,7 @@ Library
                    , template-haskell -any
                    , text             >=2
                    , bytestring
+                   , exceptions       >=0.10
   hs-source-dirs:    src
   include-dirs:      include
   c-sources:         cbits/python.c
@@ -84,6 +85,7 @@ library test
                   , tasty            >=1.2
                   , tasty-hunit      >=0.10
                   , tasty-quickcheck >=0.10
+                  , exceptions
   hs-source-dirs:   test
   Exposed-modules:
     TST.Run

src/Python/Inline.hs

@@ -5,6 +5,8 @@ module Python.Inline
   , finalizePython
   , withPython
     -- * Core data types
+  , Py
+  , runPy
   , PyObject
   , PyError(..)
     -- * Conversion between haskell and python

src/Python/Inline/Literal.hs

@@ -13,6 +13,7 @@ module Python.Inline.Literal
   ) where
 
 import Control.Monad
+import Control.Monad.Catch
 import Control.Monad.IO.Class
 import Control.Monad.Trans.Class
 import Control.Monad.Trans.Cont
@@ -81,30 +82,30 @@ class FromPy a where
 
 -- | Convert python object to haskell value. All python exceptions
 --   which happen during execution will be converted to @PyError@.
-fromPyEither :: FromPy a => PyObject -> IO (Either PyError a)
-fromPyEither py = runPy $ unsafeWithPyObject py $ \p ->
-  (Right <$> basicFromPy p) `catchPy` (pure . Left)
+fromPyEither :: FromPy a => PyObject -> Py (Either PyError a)
+fromPyEither py = unsafeWithPyObject py $ \p ->
+  (Right <$> basicFromPy p) `catch` (pure . Left)
 
 
 -- | Convert python object to haskell value. Will return @Nothing@ if
 --   'BadPyType' or 'OutOfRange' is thrown. Other python exceptions
 --   are rethrown.
-fromPy :: FromPy a => PyObject -> IO (Maybe a)
-fromPy py = runPy $ unsafeWithPyObject py $ \p ->
-  (Just <$> basicFromPy p) `catchPy` \case
+fromPy :: FromPy a => PyObject -> Py (Maybe a)
+fromPy py = unsafeWithPyObject py $ \p ->
+  (Just <$> basicFromPy p) `catch` \case
     BadPyType  -> pure Nothing
     OutOfRange -> pure Nothing
-    e          -> throwPy e
+    e          -> throwM e
 
 -- | Convert python object to haskell value. Throws exception on
 --   failure.
-fromPy' :: FromPy a => PyObject -> IO a
-fromPy' py = runPy $ unsafeWithPyObject py basicFromPy
+fromPy' :: FromPy a => PyObject -> Py a
+fromPy' py = unsafeWithPyObject py basicFromPy
 
 -- | Convert haskell value to a python object.
-toPy :: ToPy a => a -> IO PyObject
-toPy a = runPy $ basicToPy a >>= \case
-  NULL -> throwPy =<< convertPy2Haskell
+toPy :: ToPy a => a -> Py PyObject
+toPy a = basicToPy a >>= \case
+  NULL -> throwM =<< convertPy2Haskell
   p    -> newPyObject p
 
 
@@ -211,34 +212,34 @@ instance FromPy Int8 where
   basicFromPy p = basicFromPy @Int64 p >>= \case
     i | i <= fromIntegral (maxBound :: Int8)
       , i >= fromIntegral (minBound :: Int8) -> pure $! fromIntegral i
-      | otherwise -> throwPy OutOfRange
+      | otherwise -> throwM OutOfRange
 
 instance FromPy Int16 where
   basicFromPy p = basicFromPy @Int64 p >>= \case
     i | i <= fromIntegral (maxBound :: Int16)
       , i >= fromIntegral (minBound :: Int16) -> pure $! fromIntegral i
-      | otherwise -> throwPy OutOfRange
+      | otherwise -> throwM OutOfRange
 
 instance FromPy Int32 where
   basicFromPy p = basicFromPy @Int64 p >>= \case
     i | i <= fromIntegral (maxBound :: Int32)
       , i >= fromIntegral (minBound :: Int32) -> pure $! fromIntegral i
-      | otherwise -> throwPy OutOfRange
+      | otherwise -> throwM OutOfRange
 
 instance FromPy Word8 where
   basicFromPy p = basicFromPy @Word64 p >>= \case
     i | i <= fromIntegral (maxBound :: Word8) -> pure $! fromIntegral i
-      | otherwise -> throwPy OutOfRange
+      | otherwise -> throwM OutOfRange
 
 instance FromPy Word16 where
   basicFromPy p = basicFromPy @Word64 p >>= \case
     i | i <= fromIntegral (maxBound :: Word16) -> pure $! fromIntegral i
-      | otherwise -> throwPy OutOfRange
+      | otherwise -> throwM OutOfRange
 
 instance FromPy Word32 where
   basicFromPy p = basicFromPy @Word64 p >>= \case
     i | i <= fromIntegral (maxBound :: Word32) -> pure $! fromIntegral i
-      | otherwise -> throwPy OutOfRange
+      | otherwise -> throwM OutOfRange
 
 
 -- | Encoded as 1-character string
@@ -272,7 +273,7 @@ instance FromPy Char where
       }
       return -1;
       } |]
-    if | r < 0     -> throwPy BadPyType
+    if | r < 0     -> throwM BadPyType
        | otherwise -> pure $ chr $ fromIntegral r
 
 instance ToPy Bool where
@@ -301,7 +302,7 @@ instance (FromPy a, FromPy b) => FromPy (a,b) where
       inline_py_unpack_iterable($(PyObject *p_tup), 2, $(PyObject **p_args))
       }|]
     lift $ do checkThrowPyError
-              when (unpack_ok /= 0) $ throwPy BadPyType
+              when (unpack_ok /= 0) $ throwM BadPyType
     -- Parse each element of tuple
     p_a <- takeOwnership =<< liftIO (peekElemOff p_args 0)
     p_b <- takeOwnership =<< liftIO (peekElemOff p_args 1)
@@ -325,7 +326,7 @@ instance (FromPy a, FromPy b, FromPy c) => FromPy (a,b,c) where
       inline_py_unpack_iterable($(PyObject *p_tup), 3, $(PyObject **p_args))
       }|]
     lift $ do checkThrowPyError
-              when (unpack_ok /= 0) $ throwPy BadPyType
+              when (unpack_ok /= 0) $ throwM BadPyType
     -- Parse each element of tuple
     p_a <- takeOwnership =<< liftIO (peekElemOff p_args 0)
     p_b <- takeOwnership =<< liftIO (peekElemOff p_args 1)
@@ -352,7 +353,7 @@ instance (FromPy a, FromPy b, FromPy c, FromPy d) => FromPy (a,b,c,d) where
       inline_py_unpack_iterable($(PyObject *p_tup), 4, $(PyObject **p_args))
       }|]
     lift $ do checkThrowPyError
-              when (unpack_ok /= 0) $ throwPy BadPyType
+              when (unpack_ok /= 0) $ throwM BadPyType
     -- Parse each element of tuple
     p_a <- takeOwnership =<< liftIO (peekElemOff p_args 0)
     p_b <- takeOwnership =<< liftIO (peekElemOff p_args 1)
@@ -376,14 +377,14 @@ instance (FromPy a) => FromPy [a] where
       }
       return iter;
       } |]
-    when (nullPtr == p_iter) $ throwPy BadPyType
+    when (nullPtr == p_iter) $ throwM BadPyType
     --
     let loop f = do
           p <- Py [C.exp| PyObject* { PyIter_Next($(PyObject* p_iter)) } |]
           checkThrowPyError
           case p of
             NULL -> pure f
-            _    -> do a <- basicFromPy p `finallyPy` decref p
+            _    -> do a <- basicFromPy p `finally` decref p
                        loop (f . (a:))
     ($ []) <$> loop id
 
@@ -463,7 +464,7 @@ instance (FromPy a1, FromPy a2, ToPy b) => ToPy (a1 -> a2 -> IO b) where
 
 -- | Execute haskell callback function
 pyCallback :: Program (Ptr PyObject) (Ptr PyObject) -> IO (Ptr PyObject)
-pyCallback io = unPy $ ensureGIL $ evalContT io `catchPy` convertHaskell2Py
+pyCallback io = unPy $ ensureGIL $ evalContT io `catch` convertHaskell2Py
 
 -- | Load argument from python object for haskell evaluation
 loadArg
@@ -473,11 +474,11 @@ loadArg
   -> Int64          -- ^ Total number of arguments
   -> Program (Ptr PyObject) a
 loadArg p (fromIntegral -> i) (fromIntegral -> tot) = ContT $ \success -> do
-  tryPy (basicFromPy p) >>= \case
+  try (basicFromPy p) >>= \case
     Right a          -> success a
     Left  BadPyType  -> oops
     Left  OutOfRange -> oops
-    Left  e          -> throwPy e
+    Left  e          -> throwM e
     where
       oops = Py [CU.block| PyObject* {
         char err[256];

src/Python/Inline/QQ.hs

@@ -13,17 +13,17 @@
 import Language.Haskell.TH.Quote
 
 import Python.Internal.EvalQQ
 import Python.Internal.Eval
 
 
 -- | Evaluate python code in context of main module. All variables
 --   defined in this block will remain visible. This quasiquote
 --   doesn't return any python value.
 --
---   This quote creates object of type @IO ()@
+--   This quote creates object of type @Py ()@
 pymain :: QuasiQuoter
 pymain = QuasiQuoter
-  { quoteExp  = \txt -> [| runPy $ evaluatorPymain $(expQQ Exec txt) |]
+  { quoteExp  = \txt -> [| evaluatorPymain $(expQQ Exec txt) |]
   , quotePat  = error "quotePat"
   , quoteType = error "quoteType"
   , quoteDec  = error "quoteDec"
@@ -33,10 +33,10 @@
 --   defined in this block will be discarded. This quasiquote doesn't
 --   return any python value.
 --
---   This quote creates object of type @IO ()@
+--   This quote creates object of type @Py ()@
 py_ :: QuasiQuoter
 py_ = QuasiQuoter
-  { quoteExp  = \txt -> [| runPy $ evaluatorPy_ $(expQQ Exec txt) |]
+  { quoteExp  = \txt -> [| evaluatorPy_ $(expQQ Exec txt) |]
   , quotePat  = error "quotePat"
   , quoteType = error "quoteType"
   , quoteDec  = error "quoteDec"
@@ -45,10 +45,10 @@
 -- | Evaluate single python expression. It only accepts single
 --   expressions same as python's @eval@.
 --
---   This quote creates object of type @IO PyObject@
+--   This quote creates object of type @Py PyObject@
 pye :: QuasiQuoter
 pye = QuasiQuoter
-  { quoteExp  = \txt -> [| runPy $ evaluatorPye $(expQQ Eval txt) |]
+  { quoteExp  = \txt -> [| evaluatorPye $(expQQ Eval txt) |]
   , quotePat  = error "quotePat"
   , quoteType = error "quoteType"
   , quoteDec  = error "quoteDec"
@@ -60,7 +60,7 @@
 --   call return
 pyf :: QuasiQuoter
 pyf = QuasiQuoter
-  { quoteExp  = \txt -> [| runPy $ evaluatorPyf $(expQQ Fun txt) |]
+  { quoteExp  = \txt -> [| evaluatorPyf $(expQQ Fun txt) |]
   , quotePat  = error "quotePat"
   , quoteType = error "quoteType"
   , quoteDec  = error "quoteDec"

src/Python/Internal/Eval.hs

@@ -30,7 +30,7 @@ module Python.Internal.Eval
   ) where
 
 import Control.Concurrent
-import Control.Exception
+import Control.Monad.Catch
 import Control.Monad.IO.Class
 import Control.Monad.Trans.Cont
 import Foreign.Ptr
@@ -132,18 +132,20 @@ runPy py
   where
     -- We check whether interpreter is initialized. Throw exception if
     -- it wasn't. Better than segfault isn't it?
-    go = mask_ $ checkInitialized >> unPy (ensureGIL py)
+    go = mask_ $ isInitialized >>= \case
+      True  -> unPy (ensureGIL py)
+      False -> error "Python is not initialized"
 
 -- | Execute python action. This function is unsafe and should be only
 --   called in thread of interpreter.
 unPy :: Py a -> IO a
 unPy (Py io) = io
 
-checkInitialized :: IO ()
-checkInitialized =
-  [CU.exp| int { !Py_IsFinalizing() && Py_IsInitialized() } |] >>= \case
-    0 -> error "Python is not initialized"
-    _ -> pure ()
+
+isInitialized :: IO Bool
+isInitialized = do
+  i <- [CU.exp| int { !Py_IsFinalizing() && Py_IsInitialized() } |]
+  pure $! i /= 0
 
 
 
@@ -258,7 +260,7 @@ ensureGIL action = do
   --       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)) } |]
+  action `finally` Py [CU.exp| void { PyGILState_Release($(int gil_state)) } |]
 
 -- | Drop GIL temporarily
 dropGIL :: IO a -> Py a
@@ -271,7 +273,7 @@ dropGIL action = do
 
 -- | Decrement reference counter at end of ContT block
 takeOwnership :: Ptr PyObject -> Program r (Ptr PyObject)
-takeOwnership p = ContT $ \c -> c p `finallyPy` decref p
+takeOwnership p = ContT $ \c -> c p `finally` decref p
 
 
 -- | Wrap raw python object into
@@ -353,15 +355,15 @@ checkThrowPyError :: Py ()
 checkThrowPyError =
   Py [CU.exp| PyObject* { PyErr_Occurred() } |] >>= \case
     NULL -> pure ()
-    _    -> throwPy =<< convertPy2Haskell
+    _    -> throwM =<< convertPy2Haskell
 
 -- | Throw python error as haskell exception if it's raised. If it's
 --   not that internal error. Another exception will be raised
 mustThrowPyError :: String -> Py a
 mustThrowPyError msg =
   Py [CU.exp| PyObject* { PyErr_Occurred() } |] >>= \case
     NULL -> error $ "mustThrowPyError: no python exception raised. " ++ msg
-    _    -> throwPy =<< convertPy2Haskell
+    _    -> throwM =<< convertPy2Haskell
 
 checkThrowBadPyType :: Py ()
 checkThrowBadPyType = do
@@ -374,7 +376,7 @@ checkThrowBadPyType = do
     } |]
   case r of
     0 -> pure ()
-    _ -> throwPy BadPyType
+    _ -> throwM BadPyType
 
 
 ----------------------------------------------------------------

src/Python/Internal/Program.hs

@@ -16,6 +16,7 @@ module Python.Internal.Program
   ) where
 
 import Control.Monad.Trans.Cont
+import Control.Monad.Catch
 import Data.Coerce
 import Foreign.Ptr
 import Foreign.Marshal.Array
@@ -51,13 +52,13 @@ checkNull action = ContT $ \cnt -> action >>= \case
 finallyProg
   :: Py b -- ^ Finalizer
   -> Program r ()
-finallyProg fini = ContT $ \c -> c () `finallyPy` fini
+finallyProg fini = ContT $ \c -> c () `finally` fini
 
 -- | Evaluate finalizer if exception is thrown.
 onExceptionProg
   :: Py b -- ^ Finalizer
   -> Program r ()
-onExceptionProg fini = ContT $ \c -> c () `onExceptionPy` fini
+onExceptionProg fini = ContT $ \c -> c () `onException` fini
 
 
 ----------------------------------------------------------------