{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE MagicHash                #-}
{-# LANGUAGE QuasiQuotes              #-}
{-# LANGUAGE TemplateHaskell          #-}
{-# LANGUAGE UnliftedFFITypes         #-}
-- |
-- Conversion between haskell data types and python values
module Python.Inline.Literal
  ( FromPy(..)
  , ToPy(..)
  , toPy
  , fromPyEither
  , fromPy
  , fromPy'
  ) where

import Control.Exception           (evaluate)
import Control.Monad
import Control.Monad.Catch
import Control.Monad.Trans.Cont
import Data.Bits
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
import Data.Vector.Strict          qualified as VV
import Data.Vector.Storable        qualified as VS
import Data.Vector.Primitive       qualified as VP
import Data.Vector.Unboxed         qualified as VU
import Data.Primitive.ByteArray    qualified as BA
import Data.Primitive.Types        (Prim(..))
import Numeric.Natural             (Natural)
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 GHC.Exts                  (Int(..),Word(..),sizeofByteArray#,ByteArray#)
import GHC.Num.Natural           qualified
import GHC.Num.Integer           qualified
import Data.Complex              (Complex((:+)))

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.CAPI
import Python.Internal.Program

----------------------------------------------------------------
C.context (C.baseCtx <> pyCtx)
C.include "<inline-python.h>"
----------------------------------------------------------------

-- | Convert haskell value to python value.
class ToPy a where
  -- | Convert haskell value to python object. This function returns
  --   strong reference to newly create objects (except singletons
  --   like @None@, @True@, etc).
  --
  --   Implementations should try to avoid failing conversions.
  --   There're two ways of signalling failure: errors on python side
  --   should return NULL and raise python exception. Haskell code
  --   should just throw exception.
  --
  --   This is low level function. It should be only used when working
  --   with python's C API. Otherwise 'toPy' is preferred.
  basicToPy :: a -> Py (Ptr PyObject)
  -- | Old hack for handling of strings
  basicListToPy :: [a] -> Py (Ptr PyObject)
  basicListToPy [a]
xs = Program (Ptr PyObject) (Ptr PyObject) -> Py (Ptr PyObject)
forall a. Program a a -> Py a
runProgram (Program (Ptr PyObject) (Ptr PyObject) -> Py (Ptr PyObject))
-> Program (Ptr PyObject) (Ptr PyObject) -> Py (Ptr PyObject)
forall a b. (a -> b) -> a -> b
$ do
    let n :: CLLong
n = Int -> CLLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CLLong) -> Int -> CLLong
forall a b. (a -> b) -> a -> b
$ [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs :: CLLong
    p_list <- Ptr PyObject -> Program (Ptr PyObject) (Ptr PyObject)
forall r. Ptr PyObject -> Program r (Ptr PyObject)
takeOwnership (Ptr PyObject -> Program (Ptr PyObject) (Ptr PyObject))
-> Program (Ptr PyObject) (Ptr PyObject)
-> Program (Ptr PyObject) (Ptr PyObject)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Py (Ptr PyObject) -> Program (Ptr PyObject) (Ptr PyObject)
forall a. Py (Ptr a) -> Program (Ptr a) (Ptr a)
checkNull (IO (Ptr PyObject) -> Py (Ptr PyObject)
forall a. IO a -> Py a
Py [CU.exp| PyObject* { PyList_New($(long long n)) } |])
    let loop !CLLong
_ []     = Ptr PyObject
p_list Ptr PyObject -> Py () -> Py (Ptr PyObject)
forall a b. a -> Py b -> Py a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Ptr PyObject -> Py ()
incref Ptr PyObject
p_list
        loop  CLLong
i (a
a:[a]
as) = a -> Py (Ptr PyObject)
forall a. ToPy a => a -> Py (Ptr PyObject)
basicToPy a
a Py (Ptr PyObject)
-> (Ptr PyObject -> Py (Ptr PyObject)) -> Py (Ptr PyObject)
forall a b. Py a -> (a -> Py b) -> Py b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Ptr PyObject
NULL -> Ptr PyObject -> Py (Ptr PyObject)
forall a. a -> Py a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr PyObject
forall a. Ptr a
nullPtr
          Ptr PyObject
p_a  -> do
            -- NOTE: PyList_SET_ITEM steals reference
            IO () -> Py ()
forall a. IO a -> Py a
Py [CU.exp| void { PyList_SET_ITEM($(PyObject* p_list), $(long long i), $(PyObject* p_a)) } |]
            CLLong -> [a] -> Py (Ptr PyObject)
loop (CLLong
iCLLong -> CLLong -> CLLong
forall a. Num a => a -> a -> a
+CLLong
1) [a]
as
    progPy $ loop 0 xs

-- | Convert python object to haskell value.
class FromPy a where
  -- | Convert python value into haskell value. This function should
  --   try to not modify python's data. This function should avoid
  --   throwing haskell exception. Any python exceptions should be
  --   thrown as 'PyError'. When data type couldn't be converted
  --   'BadPyType' or 'OutOfRange' should be thrown to indicate failure.
  --
  --   This is low level function. It should be only used when working
  --   with python's C API. Otherwise 'fromPy' is preferred.
  basicFromPy :: Ptr PyObject -> Py a

-- | Convert python object to haskell value. All python exceptions
--   which happen during execution will be converted to @PyError@.
fromPyEither :: FromPy a => PyObject -> Py (Either PyError a)
fromPyEither :: forall a. FromPy a => PyObject -> Py (Either PyError a)
fromPyEither PyObject
py = PyObject
-> (Ptr PyObject -> Py (Either PyError a)) -> Py (Either PyError a)
forall a. PyObject -> (Ptr PyObject -> Py a) -> Py a
unsafeWithPyObject PyObject
py ((Ptr PyObject -> Py (Either PyError a)) -> Py (Either PyError a))
-> (Ptr PyObject -> Py (Either PyError a)) -> Py (Either PyError a)
forall a b. (a -> b) -> a -> b
$ \Ptr PyObject
p ->
  (a -> Either PyError a
forall a b. b -> Either a b
Right (a -> Either PyError a) -> Py a -> Py (Either PyError a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr PyObject -> Py a
forall a. FromPy a => Ptr PyObject -> Py a
basicFromPy Ptr PyObject
p) Py (Either PyError a)
-> (PyError -> Py (Either PyError a)) -> Py (Either PyError a)
forall e a.
(HasCallStack, Exception e) =>
Py a -> (e -> Py a) -> Py a
forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
`catch` (Either PyError a -> Py (Either PyError a)
forall a. a -> Py a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either PyError a -> Py (Either PyError a))
-> (PyError -> Either PyError a)
-> PyError
-> Py (Either PyError a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PyError -> Either PyError a
forall a b. a -> Either a b
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 -> Py (Maybe a)
fromPy :: forall a. FromPy a => PyObject -> Py (Maybe a)
fromPy PyObject
py = PyObject -> (Ptr PyObject -> Py (Maybe a)) -> Py (Maybe a)
forall a. PyObject -> (Ptr PyObject -> Py a) -> Py a
unsafeWithPyObject PyObject
py ((Ptr PyObject -> Py (Maybe a)) -> Py (Maybe a))
-> (Ptr PyObject -> Py (Maybe a)) -> Py (Maybe a)
forall a b. (a -> b) -> a -> b
$ \Ptr PyObject
p ->
  (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Py a -> Py (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr PyObject -> Py a
forall a. FromPy a => Ptr PyObject -> Py a
basicFromPy Ptr PyObject
p) Py (Maybe a) -> (PyError -> Py (Maybe a)) -> Py (Maybe a)
forall e a.
(HasCallStack, Exception e) =>
Py a -> (e -> Py a) -> Py a
forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \case
    PyError
BadPyType  -> Maybe a -> Py (Maybe a)
forall a. a -> Py a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
    PyError
OutOfRange -> Maybe a -> Py (Maybe a)
forall a. a -> Py a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
    PyError
e          -> PyError -> Py (Maybe a)
forall e a. (HasCallStack, Exception e) => e -> Py a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM PyError
e

-- | Convert python object to haskell value. Throws exception on
--   failure.
fromPy' :: FromPy a => PyObject -> Py a
fromPy' :: forall a. FromPy a => PyObject -> Py a
fromPy' PyObject
py = PyObject -> (Ptr PyObject -> Py a) -> Py a
forall a. PyObject -> (Ptr PyObject -> Py a) -> Py a
unsafeWithPyObject PyObject
py Ptr PyObject -> Py a
forall a. FromPy a => Ptr PyObject -> Py a
basicFromPy

-- | Convert haskell value to a python object.
toPy :: ToPy a => a -> Py PyObject
toPy :: forall a. ToPy a => a -> Py PyObject
toPy a
a = a -> Py (Ptr PyObject)
forall a. ToPy a => a -> Py (Ptr PyObject)
basicToPy a
a Py (Ptr PyObject) -> (Ptr PyObject -> Py PyObject) -> Py PyObject
forall a b. Py a -> (a -> Py b) -> Py b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Ptr PyObject
NULL -> Py PyObject
forall a. Py a
mustThrowPyError
  Ptr PyObject
p    -> Ptr PyObject -> Py PyObject
newPyObject Ptr PyObject
p


----------------------------------------------------------------
-- Instances
----------------------------------------------------------------

instance ToPy PyObject where
  basicToPy :: PyObject -> Py (Ptr PyObject)
basicToPy PyObject
o = PyObject
-> (Ptr PyObject -> Py (Ptr PyObject)) -> Py (Ptr PyObject)
forall a. PyObject -> (Ptr PyObject -> Py a) -> Py a
unsafeWithPyObject PyObject
o ((Ptr PyObject -> Py (Ptr PyObject)) -> Py (Ptr PyObject))
-> (Ptr PyObject -> Py (Ptr PyObject)) -> Py (Ptr PyObject)
forall a b. (a -> b) -> a -> b
$ \Ptr PyObject
p -> Ptr PyObject
p Ptr PyObject -> Py () -> Py (Ptr PyObject)
forall a b. a -> Py b -> Py a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Ptr PyObject -> Py ()
incref Ptr PyObject
p
instance FromPy PyObject where
  basicFromPy :: Ptr PyObject -> Py PyObject
basicFromPy Ptr PyObject
p = Ptr PyObject -> Py ()
incref Ptr PyObject
p Py () -> Py PyObject -> Py PyObject
forall a b. Py a -> Py b -> Py b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr PyObject -> Py PyObject
newPyObject Ptr PyObject
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 (Ptr PyObject)
basicToPy () = IO (Ptr PyObject) -> Py (Ptr PyObject)
forall a. IO a -> Py a
Py IO (Ptr PyObject)
[CU.exp| PyObject* { Py_None } |]

instance ToPy CLong where
  basicToPy :: CLong -> Py (Ptr PyObject)
basicToPy CLong
i = IO (Ptr PyObject) -> Py (Ptr PyObject)
forall a. IO a -> Py a
Py [CU.exp| PyObject* { PyLong_FromLong($(long i)) } |]
instance FromPy CLong where
  basicFromPy :: Ptr PyObject -> Py CLong
basicFromPy Ptr PyObject
p_py = do
    r <- IO CLong -> Py CLong
forall a. IO a -> Py a
Py [CU.exp| long { PyLong_AsLong($(PyObject *p_py)) } |]
    r <$ checkThrowBadPyType

instance ToPy CLLong where
  basicToPy :: CLLong -> Py (Ptr PyObject)
basicToPy CLLong
i = IO (Ptr PyObject) -> Py (Ptr PyObject)
forall a. IO a -> Py a
Py [CU.exp| PyObject* { PyLong_FromLongLong($(long long i)) } |]
instance FromPy CLLong where
  basicFromPy :: Ptr PyObject -> Py CLLong
basicFromPy Ptr PyObject
p_py = do
    r <- IO CLLong -> Py CLLong
forall a. IO a -> Py a
Py [CU.exp| long long { PyLong_AsLongLong($(PyObject *p_py)) } |]
    r <$ checkThrowBadPyType

instance ToPy CULong where
  basicToPy :: CULong -> Py (Ptr PyObject)
basicToPy CULong
i = IO (Ptr PyObject) -> Py (Ptr PyObject)
forall a. IO a -> Py a
Py [CU.exp| PyObject* { PyLong_FromUnsignedLong($(unsigned long i)) } |]
instance FromPy CULong where
  basicFromPy :: Ptr PyObject -> Py CULong
basicFromPy Ptr PyObject
p_py = do
    r <- IO CULong -> Py CULong
forall a. IO a -> Py a
Py [CU.exp| unsigned long { PyLong_AsUnsignedLong($(PyObject *p_py)) } |]
    r <$ checkThrowBadPyType

instance ToPy CULLong where
  basicToPy :: CULLong -> Py (Ptr PyObject)
basicToPy CULLong
i = IO (Ptr PyObject) -> Py (Ptr PyObject)
forall a. IO a -> Py a
Py [CU.exp| PyObject* { PyLong_FromUnsignedLongLong($(unsigned long long i)) } |]
instance FromPy CULLong where
  basicFromPy :: Ptr PyObject -> Py CULLong
basicFromPy Ptr PyObject
p_py = do
    r <- IO CULLong -> Py CULLong
forall a. IO a -> Py a
Py [CU.exp| unsigned long long { PyLong_AsUnsignedLongLong($(PyObject *p_py)) } |]
    r <$ checkThrowBadPyType

instance ToPy CDouble where
  basicToPy :: CDouble -> Py (Ptr PyObject)
basicToPy CDouble
i = IO (Ptr PyObject) -> Py (Ptr PyObject)
forall a. IO a -> Py a
Py [CU.exp| PyObject* { PyFloat_FromDouble($(double i)) } |]
instance FromPy CDouble where
  basicFromPy :: Ptr PyObject -> Py CDouble
basicFromPy Ptr PyObject
p_py = do
    r <- IO CDouble -> Py CDouble
forall a. IO a -> Py a
Py [CU.exp| double { PyFloat_AsDouble($(PyObject *p_py)) } |]
    r <$ checkThrowBadPyType

deriving via CLLong  instance ToPy   Int64
deriving via CLLong  instance FromPy Int64
deriving via CULLong instance ToPy   Word64
deriving via CULLong instance FromPy Word64

deriving newtype instance ToPy   CInt
deriving newtype instance FromPy CInt
deriving newtype instance ToPy   CUInt
deriving newtype instance FromPy CUInt
deriving newtype instance ToPy   CShort
deriving newtype instance FromPy CShort
deriving newtype instance ToPy   CUShort
deriving newtype instance FromPy CUShort
deriving newtype instance ToPy   CChar
deriving newtype instance FromPy CChar
deriving newtype instance ToPy   CUChar
deriving newtype instance FromPy CUChar
deriving newtype instance ToPy   CSChar
deriving newtype instance FromPy CSChar

deriving via CDouble instance ToPy   Double
deriving via CDouble instance FromPy Double

instance ToPy   Float where basicToPy :: Float -> Py (Ptr PyObject)
basicToPy   = Double -> Py (Ptr PyObject)
forall a. ToPy a => a -> Py (Ptr PyObject)
basicToPy (Double -> Py (Ptr PyObject))
-> (Float -> Double) -> Float -> Py (Ptr PyObject)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Double
float2Double
instance FromPy Float where basicFromPy :: Ptr PyObject -> Py Float
basicFromPy = (Double -> Float) -> Py Double -> Py Float
forall a b. (a -> b) -> Py a -> Py b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> Float
double2Float (Py Double -> Py Float)
-> (Ptr PyObject -> Py Double) -> Ptr PyObject -> Py Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr PyObject -> Py Double
forall a. FromPy a => Ptr PyObject -> Py a
basicFromPy

-- | @since 0.2
instance ToPy (Complex Float) where
  basicToPy :: Complex Float -> Py (Ptr PyObject)
basicToPy (Float
x:+Float
y) = Complex Double -> Py (Ptr PyObject)
forall a. ToPy a => a -> Py (Ptr PyObject)
basicToPy (Complex Double -> Py (Ptr PyObject))
-> Complex Double -> Py (Ptr PyObject)
forall a b. (a -> b) -> a -> b
$ Float -> Double
float2Double Float
x Double -> Double -> Complex Double
forall a. a -> a -> Complex a
:+ Float -> Double
float2Double Float
y
-- | @since 0.2
instance FromPy (Complex Float) where
  basicFromPy :: Ptr PyObject -> Py (Complex Float)
basicFromPy Ptr PyObject
xy_py = do
     x :+ y <- Ptr PyObject -> Py (Complex Double)
forall a. FromPy a => Ptr PyObject -> Py a
basicFromPy Ptr PyObject
xy_py
     return $ double2Float x :+ double2Float y

-- | @since 0.2
instance ToPy (Complex Double) where
  basicToPy :: Complex Double -> Py (Ptr PyObject)
basicToPy (Double
x:+Double
y) = IO (Ptr PyObject) -> Py (Ptr PyObject)
forall a. IO a -> Py a
Py [CU.exp| PyObject* { PyComplex_FromDoubles($(double x'), $(double y')) } |]
   where x' :: CDouble
x' = Double -> CDouble
CDouble Double
x
         y' :: CDouble
y' = Double -> CDouble
CDouble Double
y
-- | @since 0.2
instance FromPy (Complex Double) where
  basicFromPy :: Ptr PyObject -> Py (Complex Double)
basicFromPy Ptr PyObject
xy_py = do
    CDouble x <- IO CDouble -> Py CDouble
forall a. IO a -> Py a
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 :: Int -> Py (Ptr PyObject)
basicToPy
    | Int
wordSizeInBits Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
64 = forall a. ToPy a => a -> Py (Ptr PyObject)
basicToPy @Int64 (Int64 -> Py (Ptr PyObject))
-> (Int -> Int64) -> Int -> Py (Ptr PyObject)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    | Bool
otherwise            = forall a. ToPy a => a -> Py (Ptr PyObject)
basicToPy @Int32 (Int32 -> Py (Ptr PyObject))
-> (Int -> Int32) -> Int -> Py (Ptr PyObject)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance FromPy Int where
  basicFromPy :: Ptr PyObject -> Py Int
basicFromPy
    | Int
wordSizeInBits Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
64 = (Int64 -> Int) -> Py Int64 -> Py Int
forall a b. (a -> b) -> Py a -> Py b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Py Int64 -> Py Int)
-> (Ptr PyObject -> Py Int64) -> Ptr PyObject -> Py Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromPy a => Ptr PyObject -> Py a
basicFromPy @Int64
    | Bool
otherwise            = (Int32 -> Int) -> Py Int32 -> Py Int
forall a b. (a -> b) -> Py a -> Py b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Py Int32 -> Py Int)
-> (Ptr PyObject -> Py Int32) -> Ptr PyObject -> Py Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromPy a => Ptr PyObject -> Py a
basicFromPy @Int32

instance ToPy Word where
  basicToPy :: Word -> Py (Ptr PyObject)
basicToPy
    | Int
wordSizeInBits Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
64 = forall a. ToPy a => a -> Py (Ptr PyObject)
basicToPy @Word64 (Word64 -> Py (Ptr PyObject))
-> (Word -> Word64) -> Word -> Py (Ptr PyObject)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    | Bool
otherwise            = forall a. ToPy a => a -> Py (Ptr PyObject)
basicToPy @Word32 (Word32 -> Py (Ptr PyObject))
-> (Word -> Word32) -> Word -> Py (Ptr PyObject)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance FromPy Word where
  basicFromPy :: Ptr PyObject -> Py Word
basicFromPy
    | Int
wordSizeInBits Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
64 = (Word64 -> Word) -> Py Word64 -> Py Word
forall a b. (a -> b) -> Py a -> Py b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Py Word64 -> Py Word)
-> (Ptr PyObject -> Py Word64) -> Ptr PyObject -> Py Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromPy a => Ptr PyObject -> Py a
basicFromPy @Word64
    | Bool
otherwise            = (Word32 -> Word) -> Py Word32 -> Py Word
forall a b. (a -> b) -> Py a -> Py b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Py Word32 -> Py Word)
-> (Ptr PyObject -> Py Word32) -> Ptr PyObject -> Py Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromPy a => Ptr PyObject -> Py a
basicFromPy @Word32

instance ToPy Int8   where basicToPy :: Int8 -> Py (Ptr PyObject)
basicToPy = forall a. ToPy a => a -> Py (Ptr PyObject)
basicToPy @Int64  (Int64 -> Py (Ptr PyObject))
-> (Int8 -> Int64) -> Int8 -> Py (Ptr PyObject)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance ToPy Int16  where basicToPy :: Int16 -> Py (Ptr PyObject)
basicToPy = forall a. ToPy a => a -> Py (Ptr PyObject)
basicToPy @Int64  (Int64 -> Py (Ptr PyObject))
-> (Int16 -> Int64) -> Int16 -> Py (Ptr PyObject)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance ToPy Int32  where basicToPy :: Int32 -> Py (Ptr PyObject)
basicToPy = forall a. ToPy a => a -> Py (Ptr PyObject)
basicToPy @Int64  (Int64 -> Py (Ptr PyObject))
-> (Int32 -> Int64) -> Int32 -> Py (Ptr PyObject)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance ToPy Word8  where basicToPy :: Word8 -> Py (Ptr PyObject)
basicToPy = forall a. ToPy a => a -> Py (Ptr PyObject)
basicToPy @Word64 (Word64 -> Py (Ptr PyObject))
-> (Word8 -> Word64) -> Word8 -> Py (Ptr PyObject)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance ToPy Word16 where basicToPy :: Word16 -> Py (Ptr PyObject)
basicToPy = forall a. ToPy a => a -> Py (Ptr PyObject)
basicToPy @Word64 (Word64 -> Py (Ptr PyObject))
-> (Word16 -> Word64) -> Word16 -> Py (Ptr PyObject)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance ToPy Word32 where basicToPy :: Word32 -> Py (Ptr PyObject)
basicToPy = forall a. ToPy a => a -> Py (Ptr PyObject)
basicToPy @Word64 (Word64 -> Py (Ptr PyObject))
-> (Word32 -> Word64) -> Word32 -> Py (Ptr PyObject)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance FromPy Int8 where
  basicFromPy :: Ptr PyObject -> Py Int8
basicFromPy Ptr PyObject
p = forall a. FromPy a => Ptr PyObject -> Py a
basicFromPy @Int64 Ptr PyObject
p Py Int64 -> (Int64 -> Py Int8) -> Py Int8
forall a b. Py a -> (a -> Py b) -> Py b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Int64
i | Int64
i Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int8
forall a. Bounded a => a
maxBound :: Int8)
      , Int64
i Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int8
forall a. Bounded a => a
minBound :: Int8) -> Int8 -> Py Int8
forall a. a -> Py a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int8 -> Py Int8) -> Int8 -> Py Int8
forall a b. (a -> b) -> a -> b
$! Int64 -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i
      | Bool
otherwise -> PyError -> Py Int8
forall e a. (HasCallStack, Exception e) => e -> Py a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM PyError
OutOfRange

instance FromPy Int16 where
  basicFromPy :: Ptr PyObject -> Py Int16
basicFromPy Ptr PyObject
p = forall a. FromPy a => Ptr PyObject -> Py a
basicFromPy @Int64 Ptr PyObject
p Py Int64 -> (Int64 -> Py Int16) -> Py Int16
forall a b. Py a -> (a -> Py b) -> Py b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Int64
i | Int64
i Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int16 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int16
forall a. Bounded a => a
maxBound :: Int16)
      , Int64
i Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int16 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int16
forall a. Bounded a => a
minBound :: Int16) -> Int16 -> Py Int16
forall a. a -> Py a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int16 -> Py Int16) -> Int16 -> Py Int16
forall a b. (a -> b) -> a -> b
$! Int64 -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i
      | Bool
otherwise -> PyError -> Py Int16
forall e a. (HasCallStack, Exception e) => e -> Py a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM PyError
OutOfRange

instance FromPy Int32 where
  basicFromPy :: Ptr PyObject -> Py Int32
basicFromPy Ptr PyObject
p = forall a. FromPy a => Ptr PyObject -> Py a
basicFromPy @Int64 Ptr PyObject
p Py Int64 -> (Int64 -> Py Int32) -> Py Int32
forall a b. Py a -> (a -> Py b) -> Py b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Int64
i | Int64
i Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32
forall a. Bounded a => a
maxBound :: Int32)
      , Int64
i Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32
forall a. Bounded a => a
minBound :: Int32) -> Int32 -> Py Int32
forall a. a -> Py a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int32 -> Py Int32) -> Int32 -> Py Int32
forall a b. (a -> b) -> a -> b
$! Int64 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i
      | Bool
otherwise -> PyError -> Py Int32
forall e a. (HasCallStack, Exception e) => e -> Py a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM PyError
OutOfRange

instance FromPy Word8 where
  basicFromPy :: Ptr PyObject -> Py Word8
basicFromPy Ptr PyObject
p = forall a. FromPy a => Ptr PyObject -> Py a
basicFromPy @Word64 Ptr PyObject
p Py Word64 -> (Word64 -> Py Word8) -> Py Word8
forall a b. Py a -> (a -> Py b) -> Py b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Word64
i | Word64
i Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
forall a. Bounded a => a
maxBound :: Word8) -> Word8 -> Py Word8
forall a. a -> Py a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word8 -> Py Word8) -> Word8 -> Py Word8
forall a b. (a -> b) -> a -> b
$! Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i
      | Bool
otherwise -> PyError -> Py Word8
forall e a. (HasCallStack, Exception e) => e -> Py a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM PyError
OutOfRange

instance FromPy Word16 where
  basicFromPy :: Ptr PyObject -> Py Word16
basicFromPy Ptr PyObject
p = forall a. FromPy a => Ptr PyObject -> Py a
basicFromPy @Word64 Ptr PyObject
p Py Word64 -> (Word64 -> Py Word16) -> Py Word16
forall a b. Py a -> (a -> Py b) -> Py b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Word64
i | Word64
i Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word16 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16
forall a. Bounded a => a
maxBound :: Word16) -> Word16 -> Py Word16
forall a. a -> Py a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word16 -> Py Word16) -> Word16 -> Py Word16
forall a b. (a -> b) -> a -> b
$! Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i
      | Bool
otherwise -> PyError -> Py Word16
forall e a. (HasCallStack, Exception e) => e -> Py a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM PyError
OutOfRange

instance FromPy Word32 where
  basicFromPy :: Ptr PyObject -> Py Word32
basicFromPy Ptr PyObject
p = forall a. FromPy a => Ptr PyObject -> Py a
basicFromPy @Word64 Ptr PyObject
p Py Word64 -> (Word64 -> Py Word32) -> Py Word32
forall a b. Py a -> (a -> Py b) -> Py b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Word64
i | Word64
i Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
forall a. Bounded a => a
maxBound :: Word32) -> Word32 -> Py Word32
forall a. a -> Py a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word32 -> Py Word32) -> Word32 -> Py Word32
forall a b. (a -> b) -> a -> b
$! Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i
      | Bool
otherwise -> PyError -> Py Word32
forall e a. (HasCallStack, Exception e) => e -> Py a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM PyError
OutOfRange



-- NOTE: [Integer encoding/decoding]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--
-- Interfacing between arbitrary precision integers in haskell and
-- python is pain: they have different representations. And python got
-- API for working with large numbers only in 3.13. We have to use
-- internal API for earlier versions.
--
-- Only large number are discussed below. Small are straightforward
-- enough.
--
--  + GHC's Integer use sign + little endian sequence of Word#. Since
--    all supported platforms are LE it's same as little endian
--    sequence of bytes.
--
--  + Important invariant: highest word must be nonzero!
--
--  + Python uses two-complement.
--
-- One problem is computation of required buffer size. (8byte word is
-- assumed). For example 2^63 requires 9 bytes in two-complement
-- encoding since we need one bit for sign. But 8 bytes enough for
-- Integer's encoding. Sign is stored separately.


-- | @since 0.2.1.0
instance ToPy Integer where
  basicToPy :: Integer -> Py (Ptr PyObject)
basicToPy (GHC.Num.Integer.IS Int#
i) = Int -> Py (Ptr PyObject)
forall a. ToPy a => a -> Py (Ptr PyObject)
basicToPy (Int# -> Int
I# Int#
i)
  basicToPy (GHC.Num.Integer.IP ByteArray#
p) = IO (Ptr PyObject) -> Py (Ptr PyObject)
forall a. IO a -> Py a
Py (IO (Ptr PyObject) -> Py (Ptr PyObject))
-> IO (Ptr PyObject) -> Py (Ptr PyObject)
forall a b. (a -> b) -> a -> b
$ do
    let n :: CSize
n = Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int# -> Int
I# (ByteArray# -> Int#
sizeofByteArray# ByteArray#
p)) :: CSize
    ByteArray# -> CSize -> CInt -> IO (Ptr PyObject)
inline_py_Integer_ToPy ByteArray#
p CSize
n CInt
0
  basicToPy (GHC.Num.Integer.IN ByteArray#
p) = IO (Ptr PyObject) -> Py (Ptr PyObject)
forall a. IO a -> Py a
Py (IO (Ptr PyObject) -> Py (Ptr PyObject))
-> IO (Ptr PyObject) -> Py (Ptr PyObject)
forall a b. (a -> b) -> a -> b
$ do
    let n :: CSize
n = Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int# -> Int
I# (ByteArray# -> Int#
sizeofByteArray# ByteArray#
p)) :: CSize
    ByteArray# -> CSize -> CInt -> IO (Ptr PyObject)
inline_py_Integer_ToPy ByteArray#
p CSize
n CInt
1

-- | @since 0.2.1.0
instance ToPy Natural where
  basicToPy :: Natural -> Py (Ptr PyObject)
basicToPy (GHC.Num.Natural.NS Word#
i) = Word -> Py (Ptr PyObject)
forall a. ToPy a => a -> Py (Ptr PyObject)
basicToPy (Word# -> Word
W# Word#
i)
  basicToPy (GHC.Num.Natural.NB ByteArray#
p) = IO (Ptr PyObject) -> Py (Ptr PyObject)
forall a. IO a -> Py a
Py (IO (Ptr PyObject) -> Py (Ptr PyObject))
-> IO (Ptr PyObject) -> Py (Ptr PyObject)
forall a b. (a -> b) -> a -> b
$ do
    let n :: CSize
n = Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int# -> Int
I# (ByteArray# -> Int#
sizeofByteArray# ByteArray#
p)) :: CSize
    ByteArray# -> CSize -> CInt -> IO (Ptr PyObject)
inline_py_Integer_ToPy ByteArray#
p CSize
n CInt
0

-- | @since 0.2.1.0
instance FromPy Integer where
  basicFromPy :: Ptr PyObject -> Py Integer
basicFromPy Ptr PyObject
p = Program Integer Integer -> Py Integer
forall a. Program a a -> Py a
runProgram (Program Integer Integer -> Py Integer)
-> Program Integer Integer -> Py Integer
forall a b. (a -> b) -> a -> b
$ do
    IO CInt -> Program Integer CInt
forall a r. IO a -> Program r a
progIO [CU.exp| int { PyLong_Check($(PyObject *p)) } |] Program Integer CInt
-> (CInt -> Program Integer ()) -> Program Integer ()
forall a b.
Program Integer a -> (a -> Program Integer b) -> Program Integer b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      CInt
0 -> IO () -> Program Integer ()
forall a r. IO a -> Program r a
progIO (IO () -> Program Integer ()) -> IO () -> Program Integer ()
forall a b. (a -> b) -> a -> b
$ PyError -> IO ()
forall e a. (HasCallStack, Exception e) => e -> IO a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM PyError
BadPyType
      CInt
_ -> () -> Program Integer ()
forall a. a -> Program Integer a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    -- At this point we know that p is number
    p_overflow <- Program Integer (Ptr CInt)
forall a r. Storable a => Program r (Ptr a)
withPyAlloca
    n <- progIO [CU.exp| long long { PyLong_AsLongLongAndOverflow($(PyObject* p), $(int* p_overflow)) } |]
    progIO (peek p_overflow) >>= \case
      -- Number fits into long long
      CInt
0  -> Integer -> Program Integer Integer
forall a. a -> Program Integer a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Program Integer Integer)
-> Integer -> Program Integer Integer
forall a b. (a -> b) -> a -> b
$! CLLong -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral CLLong
n
      -- Number is positive
      CInt
1  -> do
        BA.ByteArray ba <- IO ByteArray -> Program Integer ByteArray
forall a r. IO a -> Program r a
progIO (IO ByteArray -> Program Integer ByteArray)
-> IO ByteArray -> Program Integer ByteArray
forall a b. (a -> b) -> a -> b
$ Ptr PyObject -> IO ByteArray
decodePositiveInteger Ptr PyObject
p
        pure $ GHC.Num.Integer.IP ba
      -- Number is negative
      -1 -> do
        neg <- Ptr PyObject -> Program Integer (Ptr PyObject)
forall r. Ptr PyObject -> Program r (Ptr PyObject)
takeOwnership
           (Ptr PyObject -> Program Integer (Ptr PyObject))
-> (Py (Ptr PyObject) -> Program Integer (Ptr PyObject))
-> Py (Ptr PyObject)
-> Program Integer (Ptr PyObject)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Py (Ptr PyObject) -> Program Integer (Ptr PyObject)
forall a r. Py a -> Program r a
progPy
             (Py (Ptr PyObject) -> Program Integer (Ptr PyObject))
-> Py (Ptr PyObject) -> Program Integer (Ptr PyObject)
forall a b. (a -> b) -> a -> b
$ Ptr PyObject -> Py (Ptr PyObject)
throwOnNULL (Ptr PyObject -> Py (Ptr PyObject))
-> Py (Ptr PyObject) -> Py (Ptr PyObject)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Ptr PyObject) -> Py (Ptr PyObject)
forall a. IO a -> Py a
Py [CU.exp| PyObject* { PyNumber_Negative( $(PyObject *p) ) } |]
        BA.ByteArray ba <- progIO $ decodePositiveInteger neg
        pure $ GHC.Num.Integer.IN ba
      -- Unreachable
      CInt
_ -> [Char] -> Program Integer Integer
forall a. HasCallStack => [Char] -> a
error [Char]
"inline-py: FromPy Integer: INTERNAL ERROR"
    where

-- | @since 0.2.1.0
instance FromPy Natural where
  basicFromPy :: Ptr PyObject -> Py Natural
basicFromPy Ptr PyObject
p = Program Natural Natural -> Py Natural
forall a. Program a a -> Py a
runProgram (Program Natural Natural -> Py Natural)
-> Program Natural Natural -> Py Natural
forall a b. (a -> b) -> a -> b
$ do
    IO CInt -> Program Natural CInt
forall a r. IO a -> Program r a
progIO [CU.exp| int { PyLong_Check($(PyObject *p)) } |] Program Natural CInt
-> (CInt -> Program Natural ()) -> Program Natural ()
forall a b.
Program Natural a -> (a -> Program Natural b) -> Program Natural b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      CInt
0 -> IO () -> Program Natural ()
forall a r. IO a -> Program r a
progIO (IO () -> Program Natural ()) -> IO () -> Program Natural ()
forall a b. (a -> b) -> a -> b
$ PyError -> IO ()
forall e a. (HasCallStack, Exception e) => e -> IO a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM PyError
BadPyType
      CInt
_ -> () -> Program Natural ()
forall a. a -> Program Natural a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    p_overflow <- Program Natural (Ptr CInt)
forall a r. Storable a => Program r (Ptr a)
withPyAlloca
    n <- progIO [CU.exp| long long { PyLong_AsLongLongAndOverflow($(PyObject* p), $(int* p_overflow)) } |]
    progIO (peek p_overflow) >>= \case
      -- Number fits into long long
      CInt
0 | CLLong
n CLLong -> CLLong -> Bool
forall a. Ord a => a -> a -> Bool
< CLLong
0     -> IO Natural -> Program Natural Natural
forall a r. IO a -> Program r a
progIO (IO Natural -> Program Natural Natural)
-> IO Natural -> Program Natural Natural
forall a b. (a -> b) -> a -> b
$ PyError -> IO Natural
forall e a. (HasCallStack, Exception e) => e -> IO a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM PyError
OutOfRange
        | Bool
otherwise -> Natural -> Program Natural Natural
forall a. a -> Program Natural a
forall (m :: * -> *) a. Monad m => a -> m a
return (Natural -> Program Natural Natural)
-> Natural -> Program Natural Natural
forall a b. (a -> b) -> a -> b
$! CLLong -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral CLLong
n
      -- Number is negative
      -1 -> IO Natural -> Program Natural Natural
forall a r. IO a -> Program r a
progIO (IO Natural -> Program Natural Natural)
-> IO Natural -> Program Natural Natural
forall a b. (a -> b) -> a -> b
$ PyError -> IO Natural
forall e a. (HasCallStack, Exception e) => e -> IO a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM PyError
OutOfRange
      -- Number is positive.
      --
      -- NOTE that if size of bytearray is equal to size of word we
      --      need to return small constructor
      CInt
1  -> IO Natural -> Program Natural Natural
forall a r. IO a -> Program r a
progIO (IO Natural -> Program Natural Natural)
-> IO Natural -> Program Natural Natural
forall a b. (a -> b) -> a -> b
$ Ptr PyObject -> IO ByteArray
decodePositiveInteger Ptr PyObject
p IO ByteArray -> (ByteArray -> IO Natural) -> IO Natural
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        BA.ByteArray ByteArray#
ba
          | Int# -> Int
I# (ByteArray# -> Int#
sizeofByteArray# ByteArray#
ba) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Word -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize (Word
0::Word) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8)
            -> Natural -> IO Natural
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Natural -> IO Natural) -> Natural -> IO Natural
forall a b. (a -> b) -> a -> b
$! case ByteArray# -> Int# -> Word
forall a. Prim a => ByteArray# -> Int# -> a
indexByteArray# ByteArray#
ba Int#
0# of
                 W# Word#
w -> Word# -> Natural
GHC.Num.Natural.NS Word#
w
          | Bool
otherwise
            -> Natural -> IO Natural
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Natural -> IO Natural) -> Natural -> IO Natural
forall a b. (a -> b) -> a -> b
$! ByteArray# -> Natural
GHC.Num.Natural.NB ByteArray#
ba
      -- Unreachable
      CInt
_ -> [Char] -> Program Natural Natural
forall a. HasCallStack => [Char] -> a
error [Char]
"inline-py: FromPy Natural: INTERNAL ERROR"

-- Decode large positive number:
--  + Must be instance of PyLong
--  + Must be positive
decodePositiveInteger :: Ptr PyObject -> IO BA.ByteArray
decodePositiveInteger :: Ptr PyObject -> IO ByteArray
decodePositiveInteger Ptr PyObject
p_num = do
  sz <- [CU.exp| int { inline_py_Long_ByteSize( $(PyObject *p_num) ) } |]
  buf@(BA.MutableByteArray ptr_buf) <- BA.newByteArray (fromIntegral sz)
  _ <- inline_py_Integer_FromPy p_num ptr_buf (fromIntegral sz)
  BA.unsafeFreezeByteArray buf



foreign import ccall unsafe "inline_py_Integer_ToPy"
  inline_py_Integer_ToPy :: ByteArray# -> CSize -> CInt -> IO (Ptr PyObject)
foreign import ccall unsafe "inline_py_Integer_FromPy"
  inline_py_Integer_FromPy :: Ptr PyObject -> BA.MutableByteArray# MVG.RealWorld -> CSize -> IO CInt

-- | Encoded as 1-character string
instance ToPy Char where
  basicToPy :: Char -> Py (Ptr PyObject)
basicToPy Char
c = do
    let i :: CUInt
i = Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
c) :: CUInt
    IO (Ptr PyObject) -> Py (Ptr PyObject)
forall a. IO a -> Py a
Py [CU.block| PyObject* {
       uint32_t cs[1] = { $(unsigned i) };
       return PyUnicode_DecodeUTF32((char*)cs, 4, NULL, NULL);
       } |]
  basicListToPy :: [Char] -> Py (Ptr PyObject)
basicListToPy [Char]
str = Program (Ptr PyObject) (Ptr PyObject) -> Py (Ptr PyObject)
forall a. Program a a -> Py a
runProgram (Program (Ptr PyObject) (Ptr PyObject) -> Py (Ptr PyObject))
-> Program (Ptr PyObject) (Ptr PyObject) -> Py (Ptr PyObject)
forall a b. (a -> b) -> a -> b
$ do
    p_str <- [Char] -> Program (Ptr PyObject) (Ptr CWchar)
forall r. [Char] -> Program r (Ptr CWchar)
withPyWCString [Char]
str
    progIO [CU.exp| PyObject* { PyUnicode_FromWideChar($(wchar_t *p_str), -1) } |]


instance FromPy Char where
  basicFromPy :: Ptr PyObject -> Py Char
basicFromPy Ptr PyObject
p = do
    r <- IO CInt -> Py CInt
forall a. IO a -> Py a
Py [CU.block| int {
      PyObject* p = $(PyObject *p);
      if( !PyUnicode_Check(p) )
          return -1;      if( 1 != PyUnicode_GET_LENGTH(p) )
          return -1;
      switch( PyUnicode_KIND(p) ) {
      case PyUnicode_1BYTE_KIND:
          return PyUnicode_1BYTE_DATA(p)[0];
      case PyUnicode_2BYTE_KIND:
          return PyUnicode_2BYTE_DATA(p)[0];
      case PyUnicode_4BYTE_KIND:
          return PyUnicode_4BYTE_DATA(p)[0];
      }
      return -1;
      } |]
    if | r < 0     -> throwM BadPyType
       | otherwise -> pure $ chr $ fromIntegral r

instance ToPy Bool where
  basicToPy :: Bool -> Py (Ptr PyObject)
basicToPy Bool
True  = IO (Ptr PyObject) -> Py (Ptr PyObject)
forall a. IO a -> Py a
Py IO (Ptr PyObject)
[CU.block| PyObject* { Py_RETURN_TRUE;  } |]
  basicToPy Bool
False = IO (Ptr PyObject) -> Py (Ptr PyObject)
forall a. IO a -> Py a
Py IO (Ptr PyObject)
[CU.block| PyObject* { Py_RETURN_FALSE; } |]

-- | Uses python's truthiness conventions
instance FromPy Bool where
  basicFromPy :: Ptr PyObject -> Py Bool
basicFromPy Ptr PyObject
p = do
    r <- IO CInt -> Py CInt
forall a. IO a -> Py a
Py [CU.exp| int { PyObject_IsTrue($(PyObject* p)) } |]
    checkThrowPyError
    pure $! r /= 0


instance (ToPy a, ToPy b) => ToPy (a,b) where
  basicToPy :: (a, b) -> Py (Ptr PyObject)
basicToPy (a
a,b
b) = Program (Ptr PyObject) (Ptr PyObject) -> Py (Ptr PyObject)
forall a. Program a a -> Py a
runProgram (Program (Ptr PyObject) (Ptr PyObject) -> Py (Ptr PyObject))
-> Program (Ptr PyObject) (Ptr PyObject) -> Py (Ptr PyObject)
forall a b. (a -> b) -> a -> b
$ do
    p_a <- Ptr PyObject -> Program (Ptr PyObject) (Ptr PyObject)
forall r. Ptr PyObject -> Program r (Ptr PyObject)
takeOwnership (Ptr PyObject -> Program (Ptr PyObject) (Ptr PyObject))
-> Program (Ptr PyObject) (Ptr PyObject)
-> Program (Ptr PyObject) (Ptr PyObject)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Py (Ptr PyObject) -> Program (Ptr PyObject) (Ptr PyObject)
forall a. Py (Ptr a) -> Program (Ptr a) (Ptr a)
checkNull (a -> Py (Ptr PyObject)
forall a. ToPy a => a -> Py (Ptr PyObject)
basicToPy a
a)
    p_b <- takeOwnership =<< checkNull (basicToPy b)
    progIO [CU.exp| PyObject* { PyTuple_Pack(2, $(PyObject* p_a), $(PyObject* p_b)) } |]

-- | Will accept any iterable
instance (FromPy a, FromPy b) => FromPy (a,b) where
  basicFromPy :: Ptr PyObject -> Py (a, b)
basicFromPy Ptr PyObject
p_tup = Program (a, b) (a, b) -> Py (a, b)
forall a. Program a a -> Py a
runProgram (Program (a, b) (a, b) -> Py (a, b))
-> Program (a, b) (a, b) -> Py (a, b)
forall a b. (a -> b) -> a -> b
$ do
    -- Unpack 2-tuple.
    p_args    <- Int -> Program (a, b) (Ptr (Ptr PyObject))
forall a r. Storable a => Int -> Program r (Ptr a)
withPyAllocaArray Int
2
    unpack_ok <- progIO [CU.exp| int {
      inline_py_unpack_iterable($(PyObject *p_tup), 2, $(PyObject **p_args))
      }|]
    progPy $ do checkThrowPyError
                when (unpack_ok /= 0) $ throwM BadPyType
    -- Parse each element of tuple
    p_a <- takeOwnership =<< progIO (peekElemOff p_args 0)
    p_b <- takeOwnership =<< progIO (peekElemOff p_args 1)
    progPy $ do a <- basicFromPy p_a
                b <- basicFromPy p_b
                pure (a,b)

instance (ToPy a, ToPy b, ToPy c) => ToPy (a,b,c) where
  basicToPy :: (a, b, c) -> Py (Ptr PyObject)
basicToPy (a
a,b
b,c
c) = Program (Ptr PyObject) (Ptr PyObject) -> Py (Ptr PyObject)
forall a. Program a a -> Py a
runProgram (Program (Ptr PyObject) (Ptr PyObject) -> Py (Ptr PyObject))
-> Program (Ptr PyObject) (Ptr PyObject) -> Py (Ptr PyObject)
forall a b. (a -> b) -> a -> b
$ do
    p_a <- Ptr PyObject -> Program (Ptr PyObject) (Ptr PyObject)
forall r. Ptr PyObject -> Program r (Ptr PyObject)
takeOwnership (Ptr PyObject -> Program (Ptr PyObject) (Ptr PyObject))
-> Program (Ptr PyObject) (Ptr PyObject)
-> Program (Ptr PyObject) (Ptr PyObject)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Py (Ptr PyObject) -> Program (Ptr PyObject) (Ptr PyObject)
forall a. Py (Ptr a) -> Program (Ptr a) (Ptr a)
checkNull (a -> Py (Ptr PyObject)
forall a. ToPy a => a -> Py (Ptr PyObject)
basicToPy a
a)
    p_b <- takeOwnership =<< checkNull (basicToPy b)
    p_c <- takeOwnership =<< checkNull (basicToPy c)
    progIO [CU.exp| PyObject* {
      PyTuple_Pack(3, $(PyObject *p_a), $(PyObject *p_b), $(PyObject *p_c)) } |]

-- | Will accept any iterable
instance (FromPy a, FromPy b, FromPy c) => FromPy (a,b,c) where
  basicFromPy :: Ptr PyObject -> Py (a, b, c)
basicFromPy Ptr PyObject
p_tup = Program (a, b, c) (a, b, c) -> Py (a, b, c)
forall a. Program a a -> Py a
runProgram (Program (a, b, c) (a, b, c) -> Py (a, b, c))
-> Program (a, b, c) (a, b, c) -> Py (a, b, c)
forall a b. (a -> b) -> a -> b
$ do
    -- Unpack 3-tuple.
    p_args    <- Int -> Program (a, b, c) (Ptr (Ptr PyObject))
forall a r. Storable a => Int -> Program r (Ptr a)
withPyAllocaArray Int
3
    unpack_ok <- progIO [CU.exp| int {
      inline_py_unpack_iterable($(PyObject *p_tup), 3, $(PyObject **p_args))
      }|]
    progPy $ do checkThrowPyError
                when (unpack_ok /= 0) $ throwM BadPyType
    -- Parse each element of tuple
    p_a <- takeOwnership =<< progIO (peekElemOff p_args 0)
    p_b <- takeOwnership =<< progIO (peekElemOff p_args 1)
    p_c <- takeOwnership =<< progIO (peekElemOff p_args 2)
    progPy $ do a <- basicFromPy p_a
                b <- basicFromPy p_b
                c <- basicFromPy p_c
                pure (a,b,c)

instance (ToPy a, ToPy b, ToPy c, ToPy d) => ToPy (a,b,c,d) where
  basicToPy :: (a, b, c, d) -> Py (Ptr PyObject)
basicToPy (a
a,b
b,c
c,d
d) = Program (Ptr PyObject) (Ptr PyObject) -> Py (Ptr PyObject)
forall a. Program a a -> Py a
runProgram (Program (Ptr PyObject) (Ptr PyObject) -> Py (Ptr PyObject))
-> Program (Ptr PyObject) (Ptr PyObject) -> Py (Ptr PyObject)
forall a b. (a -> b) -> a -> b
$ do
    p_a <- Ptr PyObject -> Program (Ptr PyObject) (Ptr PyObject)
forall r. Ptr PyObject -> Program r (Ptr PyObject)
takeOwnership (Ptr PyObject -> Program (Ptr PyObject) (Ptr PyObject))
-> Program (Ptr PyObject) (Ptr PyObject)
-> Program (Ptr PyObject) (Ptr PyObject)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Py (Ptr PyObject) -> Program (Ptr PyObject) (Ptr PyObject)
forall a. Py (Ptr a) -> Program (Ptr a) (Ptr a)
checkNull (a -> Py (Ptr PyObject)
forall a. ToPy a => a -> Py (Ptr PyObject)
basicToPy a
a)
    p_b <- takeOwnership =<< checkNull (basicToPy b)
    p_c <- takeOwnership =<< checkNull (basicToPy c)
    p_d <- takeOwnership =<< checkNull (basicToPy d)
    progIO [CU.exp| PyObject* {
      PyTuple_Pack(4, $(PyObject *p_a), $(PyObject *p_b), $(PyObject *p_c), $(PyObject *p_d)) } |]

-- | Will accept any iterable
instance (FromPy a, FromPy b, FromPy c, FromPy d) => FromPy (a,b,c,d) where
  basicFromPy :: Ptr PyObject -> Py (a, b, c, d)
basicFromPy Ptr PyObject
p_tup = Program (a, b, c, d) (a, b, c, d) -> Py (a, b, c, d)
forall a. Program a a -> Py a
runProgram (Program (a, b, c, d) (a, b, c, d) -> Py (a, b, c, d))
-> Program (a, b, c, d) (a, b, c, d) -> Py (a, b, c, d)
forall a b. (a -> b) -> a -> b
$ do
    -- Unpack 3-tuple.
    p_args    <- Int -> Program (a, b, c, d) (Ptr (Ptr PyObject))
forall a r. Storable a => Int -> Program r (Ptr a)
withPyAllocaArray Int
4
    unpack_ok <- progIO [CU.exp| int {
      inline_py_unpack_iterable($(PyObject *p_tup), 4, $(PyObject **p_args))
      }|]
    progPy $ do checkThrowPyError
                when (unpack_ok /= 0) $ throwM BadPyType
    -- Parse each element of tuple
    p_a <- takeOwnership =<< progIO (peekElemOff p_args 0)
    p_b <- takeOwnership =<< progIO (peekElemOff p_args 1)
    p_c <- takeOwnership =<< progIO (peekElemOff p_args 2)
    p_d <- takeOwnership =<< progIO (peekElemOff p_args 3)
    progPy $ do a <- basicFromPy p_a
                b <- basicFromPy p_b
                c <- basicFromPy p_c
                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 :: Maybe a -> Py (Ptr PyObject)
basicToPy Maybe a
Nothing  = IO (Ptr PyObject) -> Py (Ptr PyObject)
forall a. IO a -> Py a
Py IO (Ptr PyObject)
[CU.exp| PyObject* { Py_None } |]
  basicToPy (Just a
a) = a -> Py (Ptr PyObject)
forall a. ToPy a => a -> Py (Ptr PyObject)
basicToPy a
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 :: Ptr PyObject -> Py (Maybe a)
basicFromPy Ptr PyObject
p =
    IO CBool -> Py CBool
forall a. IO a -> Py a
Py [CU.exp| bool { Py_None == $(PyObject *p) } |] Py CBool -> (CBool -> Py (Maybe a)) -> Py (Maybe a)
forall a b. Py a -> (a -> Py b) -> Py b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      CBool
0 -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Py a -> Py (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr PyObject -> Py a
forall a. FromPy a => Ptr PyObject -> Py a
basicFromPy Ptr PyObject
p
      CBool
_ -> Maybe a -> Py (Maybe a)
forall a. a -> Py a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing


instance (ToPy a) => ToPy [a] where
  basicToPy :: [a] -> Py (Ptr PyObject)
basicToPy = [a] -> Py (Ptr PyObject)
forall a. ToPy a => [a] -> Py (Ptr PyObject)
basicListToPy

-- | Will accept any iterable
instance (FromPy a) => FromPy [a] where
  basicFromPy :: Ptr PyObject -> Py [a]
basicFromPy Ptr PyObject
p_list = do
    p_iter <- IO (Ptr PyObject) -> Py (Ptr PyObject)
forall a. IO a -> Py a
Py [CU.block| PyObject* {
      PyObject* iter = PyObject_GetIter( $(PyObject *p_list) );
      if( PyErr_Occurred() ) {
          PyErr_Clear();
      }
      return iter;
      } |]
    when (nullPtr == p_iter) $ throwM BadPyType
    --
    f <- foldPyIterable p_iter
      (\[a] -> [a]
f Ptr PyObject
p -> do a <- Ptr PyObject -> Py a
forall a. FromPy a => Ptr PyObject -> Py a
basicFromPy Ptr PyObject
p
                  pure (f . (a:)))
      id
    pure $ f []

instance (ToPy a, Ord a) => ToPy (Set.Set a) where
  basicToPy :: Set a -> Py (Ptr PyObject)
basicToPy Set a
set = Program (Ptr PyObject) (Ptr PyObject) -> Py (Ptr PyObject)
forall a. Program a a -> Py a
runProgram (Program (Ptr PyObject) (Ptr PyObject) -> Py (Ptr PyObject))
-> Program (Ptr PyObject) (Ptr PyObject) -> Py (Ptr PyObject)
forall a b. (a -> b) -> a -> b
$ do
    p_set <- Ptr PyObject -> Program (Ptr PyObject) (Ptr PyObject)
forall r. Ptr PyObject -> Program r (Ptr PyObject)
takeOwnership (Ptr PyObject -> Program (Ptr PyObject) (Ptr PyObject))
-> Program (Ptr PyObject) (Ptr PyObject)
-> Program (Ptr PyObject) (Ptr PyObject)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Py (Ptr PyObject) -> Program (Ptr PyObject) (Ptr PyObject)
forall a. Py (Ptr a) -> Program (Ptr a) (Ptr a)
checkNull Py (Ptr PyObject)
basicNewSet
    progPy $ do
      let loop []     = Ptr PyObject
p_set Ptr PyObject -> Py () -> Py (Ptr PyObject)
forall a b. a -> Py b -> Py a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Ptr PyObject -> Py ()
incref Ptr PyObject
p_set
          loop (a
x:[a]
xs) = a -> Py (Ptr PyObject)
forall a. ToPy a => a -> Py (Ptr PyObject)
basicToPy a
x Py (Ptr PyObject)
-> (Ptr PyObject -> Py (Ptr PyObject)) -> Py (Ptr PyObject)
forall a b. Py a -> (a -> Py b) -> Py b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Ptr PyObject
NULL -> Ptr PyObject -> Py (Ptr PyObject)
forall a. a -> Py a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr PyObject
forall a. Ptr a
NULL
            Ptr PyObject
p_a  -> IO CInt -> Py CInt
forall a. IO a -> Py a
Py [C.exp| int { PySet_Add($(PyObject *p_set), $(PyObject *p_a)) }|] Py CInt -> (CInt -> Py (Ptr PyObject)) -> Py (Ptr PyObject)
forall a b. Py a -> (a -> Py b) -> Py b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
              CInt
0 -> Ptr PyObject -> Py ()
decref Ptr PyObject
p_a Py () -> Py (Ptr PyObject) -> Py (Ptr PyObject)
forall a b. Py a -> Py b -> Py b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [a] -> Py (Ptr PyObject)
loop [a]
xs
              CInt
_ -> Py (Ptr PyObject)
forall a. Py a
mustThrowPyError
      loop $ Set.toList set

instance (FromPy a, Ord a) => FromPy (Set.Set a) where
  basicFromPy :: Ptr PyObject -> Py (Set a)
basicFromPy Ptr PyObject
p_set = Ptr PyObject -> Py (Ptr PyObject)
basicGetIter Ptr PyObject
p_set Py (Ptr PyObject) -> (Ptr PyObject -> Py (Set a)) -> Py (Set a)
forall a b. Py a -> (a -> Py b) -> Py b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Ptr PyObject
NULL -> do IO () -> Py ()
forall a. IO a -> Py a
Py IO ()
[C.exp| void { PyErr_Clear() } |]
               PyError -> Py (Set a)
forall e a. (HasCallStack, Exception e) => e -> Py a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM PyError
BadPyType
    Ptr PyObject
p_iter -> Ptr PyObject
-> (Set a -> Ptr PyObject -> Py (Set a)) -> Set a -> Py (Set a)
forall a. Ptr PyObject -> (a -> Ptr PyObject -> Py a) -> a -> Py a
foldPyIterable Ptr PyObject
p_iter
      (\Set a
s Ptr PyObject
p -> do a <- Ptr PyObject -> Py a
forall a. FromPy a => Ptr PyObject -> Py a
basicFromPy Ptr PyObject
p
                  pure $! Set.insert a s)
      Set a
forall a. Set a
Set.empty


instance (ToPy k, ToPy v, Ord k) => ToPy (Map.Map k v) where
  basicToPy :: Map k v -> Py (Ptr PyObject)
basicToPy Map k v
dct = Program (Ptr PyObject) (Ptr PyObject) -> Py (Ptr PyObject)
forall a. Program a a -> Py a
runProgram (Program (Ptr PyObject) (Ptr PyObject) -> Py (Ptr PyObject))
-> Program (Ptr PyObject) (Ptr PyObject) -> Py (Ptr PyObject)
forall a b. (a -> b) -> a -> b
$ do
    p_dict <- Ptr PyObject -> Program (Ptr PyObject) (Ptr PyObject)
forall r. Ptr PyObject -> Program r (Ptr PyObject)
takeOwnership (Ptr PyObject -> Program (Ptr PyObject) (Ptr PyObject))
-> Program (Ptr PyObject) (Ptr PyObject)
-> Program (Ptr PyObject) (Ptr PyObject)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Py (Ptr PyObject) -> Program (Ptr PyObject) (Ptr PyObject)
forall a. Py (Ptr a) -> Program (Ptr a) (Ptr a)
checkNull Py (Ptr PyObject)
basicNewDict
    progPy $ do
      let loop []         = Ptr PyObject
p_dict Ptr PyObject -> Py () -> Py (Ptr PyObject)
forall a b. a -> Py b -> Py a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Ptr PyObject -> Py ()
incref Ptr PyObject
p_dict
          loop ((a
k,a
v):[(a, a)]
xs) = a -> Py (Ptr PyObject)
forall a. ToPy a => a -> Py (Ptr PyObject)
basicToPy a
k Py (Ptr PyObject)
-> (Ptr PyObject -> Py (Ptr PyObject)) -> Py (Ptr PyObject)
forall a b. Py a -> (a -> Py b) -> Py b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Ptr PyObject
NULL -> Py (Ptr PyObject)
forall a. Py a
mustThrowPyError
            Ptr PyObject
p_k  -> (Py (Ptr PyObject) -> Py () -> Py (Ptr PyObject))
-> Py () -> Py (Ptr PyObject) -> Py (Ptr PyObject)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Py (Ptr PyObject) -> Py () -> Py (Ptr PyObject)
forall (m :: * -> *) a b.
(HasCallStack, MonadMask m) =>
m a -> m b -> m a
finally (Ptr PyObject -> Py ()
decref Ptr PyObject
p_k) (Py (Ptr PyObject) -> Py (Ptr PyObject))
-> Py (Ptr PyObject) -> Py (Ptr PyObject)
forall a b. (a -> b) -> a -> b
$ a -> Py (Ptr PyObject)
forall a. ToPy a => a -> Py (Ptr PyObject)
basicToPy a
v Py (Ptr PyObject)
-> (Ptr PyObject -> Py (Ptr PyObject)) -> Py (Ptr PyObject)
forall a b. Py a -> (a -> Py b) -> Py b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
              Ptr PyObject
NULL -> Py (Ptr PyObject)
forall a. Py a
mustThrowPyError
              Ptr PyObject
p_v  -> IO CInt -> Py CInt
forall a. IO a -> Py a
Py [CU.exp| int { PyDict_SetItem($(PyObject *p_dict), $(PyObject* p_k), $(PyObject *p_v)) }|] Py CInt -> (CInt -> Py (Ptr PyObject)) -> Py (Ptr PyObject)
forall a b. Py a -> (a -> Py b) -> Py b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                CInt
0 -> [(a, a)] -> Py (Ptr PyObject)
loop [(a, a)]
xs
                CInt
_ -> Ptr PyObject
forall a. Ptr a
nullPtr Ptr PyObject -> Py () -> Py (Ptr PyObject)
forall a b. a -> Py b -> Py a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Ptr PyObject -> Py ()
decref Ptr PyObject
p_v
      loop $ Map.toList dct

instance (FromPy k, FromPy v, Ord k) => FromPy (Map.Map k v) where
  basicFromPy :: Ptr PyObject -> Py (Map k v)
basicFromPy Ptr PyObject
p_dct = Ptr PyObject -> Py (Ptr PyObject)
basicGetIter Ptr PyObject
p_dct Py (Ptr PyObject) -> (Ptr PyObject -> Py (Map k v)) -> Py (Map k v)
forall a b. Py a -> (a -> Py b) -> Py b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Ptr PyObject
NULL   -> do IO () -> Py ()
forall a. IO a -> Py a
Py IO ()
[C.exp| void { PyErr_Clear() } |]
                 PyError -> Py (Map k v)
forall e a. (HasCallStack, Exception e) => e -> Py a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM PyError
BadPyType
    Ptr PyObject
p_iter -> Ptr PyObject
-> (Map k v -> Ptr PyObject -> Py (Map k v))
-> Map k v
-> Py (Map k v)
forall a. Ptr PyObject -> (a -> Ptr PyObject -> Py a) -> a -> Py a
foldPyIterable Ptr PyObject
p_iter
      (\Map k v
m Ptr PyObject
p -> do k <- Ptr PyObject -> Py k
forall a. FromPy a => Ptr PyObject -> Py a
basicFromPy Ptr PyObject
p
                  v <- Py [CU.exp| PyObject* { PyDict_GetItem($(PyObject* p_dct), $(PyObject *p)) }|] >>= \case
                    Ptr PyObject
NULL -> PyError -> Py v
forall e a. (HasCallStack, Exception e) => e -> Py a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM PyError
BadPyType
                    Ptr PyObject
p_v  -> Ptr PyObject -> Py v
forall a. FromPy a => Ptr PyObject -> Py a
basicFromPy Ptr PyObject
p_v
                  pure $! Map.insert k v m)
      Map k v
forall k a. Map k a
Map.empty

-- | Converts to python's list
instance ToPy a => ToPy (V.Vector a) where
  basicToPy :: Vector a -> Py (Ptr PyObject)
basicToPy = Vector a -> Py (Ptr PyObject)
forall (v :: * -> *) a.
(Vector v a, ToPy a) =>
v a -> Py (Ptr PyObject)
vectorToPy
-- | Converts to python's list
instance (ToPy a, VS.Storable a) => ToPy (VS.Vector a) where
  basicToPy :: Vector a -> Py (Ptr PyObject)
basicToPy = Vector a -> Py (Ptr PyObject)
forall (v :: * -> *) a.
(Vector v a, ToPy a) =>
v a -> Py (Ptr PyObject)
vectorToPy
-- | Converts to python's list
instance (ToPy a, VP.Prim a) => ToPy (VP.Vector a) where
  basicToPy :: Vector a -> Py (Ptr PyObject)
basicToPy = Vector a -> Py (Ptr PyObject)
forall (v :: * -> *) a.
(Vector v a, ToPy a) =>
v a -> Py (Ptr PyObject)
vectorToPy
-- | Converts to python's list
instance (ToPy a, VU.Unbox a) => ToPy (VU.Vector a) where
  basicToPy :: Vector a -> Py (Ptr PyObject)
basicToPy = Vector a -> Py (Ptr PyObject)
forall (v :: * -> *) a.
(Vector v a, ToPy a) =>
v a -> Py (Ptr PyObject)
vectorToPy
-- | Converts to python's list
instance (ToPy a) => ToPy (VV.Vector a) where
  basicToPy :: Vector a -> Py (Ptr PyObject)
basicToPy = Vector a -> Py (Ptr PyObject)
forall (v :: * -> *) a.
(Vector v a, ToPy a) =>
v a -> Py (Ptr PyObject)
vectorToPy

-- | Accepts python's sequence (@len@ and indexing)
instance FromPy a => FromPy (V.Vector a) where
  basicFromPy :: Ptr PyObject -> Py (Vector a)
basicFromPy = Ptr PyObject -> Py (Vector a)
forall (v :: * -> *) a.
(Vector v a, FromPy a) =>
Ptr PyObject -> Py (v a)
vectorFromPy
-- | Accepts python's sequence (@len@ and indexing)
instance (FromPy a, VS.Storable a) => FromPy (VS.Vector a) where
  basicFromPy :: Ptr PyObject -> Py (Vector a)
basicFromPy = Ptr PyObject -> Py (Vector a)
forall (v :: * -> *) a.
(Vector v a, FromPy a) =>
Ptr PyObject -> Py (v a)
vectorFromPy
-- | Accepts python's sequence (@len@ and indexing)
instance (FromPy a, VP.Prim a) => FromPy (VP.Vector a) where
  basicFromPy :: Ptr PyObject -> Py (Vector a)
basicFromPy = Ptr PyObject -> Py (Vector a)
forall (v :: * -> *) a.
(Vector v a, FromPy a) =>
Ptr PyObject -> Py (v a)
vectorFromPy
-- | Accepts python's sequence (@len@ and indexing)
instance (FromPy a, VU.Unbox a) => FromPy (VU.Vector a) where
  basicFromPy :: Ptr PyObject -> Py (Vector a)
basicFromPy = Ptr PyObject -> Py (Vector a)
forall (v :: * -> *) a.
(Vector v a, FromPy a) =>
Ptr PyObject -> Py (v a)
vectorFromPy
-- | Accepts python's sequence (@len@ and indexing)
instance FromPy a => FromPy (VV.Vector a) where
  basicFromPy :: Ptr PyObject -> Py (Vector a)
basicFromPy = Ptr PyObject -> Py (Vector a)
forall (v :: * -> *) a.
(Vector v a, FromPy a) =>
Ptr PyObject -> Py (v a)
vectorFromPy


-- | 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.
  -> a                           -- ^ Initial value
  -> Py a
foldPyIterable :: forall a. Ptr PyObject -> (a -> Ptr PyObject -> Py a) -> a -> Py a
foldPyIterable Ptr PyObject
p_iter a -> Ptr PyObject -> Py a
step a
a0
  = a -> Py a
loop a
a0 Py a -> Py () -> Py a
forall (m :: * -> *) a b.
(HasCallStack, MonadMask m) =>
m a -> m b -> m a
`finally` Ptr PyObject -> Py ()
decref Ptr PyObject
p_iter
  where
    loop :: a -> Py a
loop a
a = Ptr PyObject -> Py (Ptr PyObject)
basicIterNext Ptr PyObject
p_iter Py (Ptr PyObject) -> (Ptr PyObject -> Py a) -> Py a
forall a b. Py a -> (a -> Py b) -> Py b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Ptr PyObject
NULL -> a
a a -> Py () -> Py a
forall a b. a -> Py b -> Py a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Py ()
checkThrowPyError
      Ptr PyObject
p    -> a -> Py a
loop (a -> Py a) -> Py a -> Py a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (a -> Ptr PyObject -> Py a
step a
a Ptr PyObject
p Py a -> Py () -> Py a
forall (m :: * -> *) a b.
(HasCallStack, MonadMask m) =>
m a -> m b -> m a
`finally` Ptr PyObject -> Py ()
decref Ptr PyObject
p)


vectorFromPy :: (VG.Vector v a, FromPy a) => Ptr PyObject -> Py (v a)
{-# INLINE vectorFromPy #-}
vectorFromPy :: forall (v :: * -> *) a.
(Vector v a, FromPy a) =>
Ptr PyObject -> Py (v a)
vectorFromPy Ptr PyObject
p_seq = do
  len <- IO CLLong -> Py CLLong
forall a. IO a -> Py a
Py [CU.exp| long long { PySequence_Size($(PyObject* p_seq)) } |]
  when (len < 0) $ do
    Py [C.exp| void { PyErr_Clear() } |]
    throwM BadPyType
  -- Read data into vector
  buf <- MVG.generateM (fromIntegral len) $ \Int
i -> do
    let i_c :: CLLong
i_c = Int -> CLLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i
    IO (Ptr PyObject) -> Py (Ptr PyObject)
forall a. IO a -> Py a
Py [CU.exp| PyObject* { PySequence_GetItem($(PyObject* p_seq), $(long long i_c)) } |] Py (Ptr PyObject) -> (Ptr PyObject -> Py a) -> Py a
forall a b. Py a -> (a -> Py b) -> Py b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Ptr PyObject
NULL -> Py a
forall a. Py a
mustThrowPyError
      Ptr PyObject
p    -> Ptr PyObject -> Py a
forall a. FromPy a => Ptr PyObject -> Py a
basicFromPy Ptr PyObject
p Py a -> Py () -> Py a
forall (m :: * -> *) a b.
(HasCallStack, MonadMask m) =>
m a -> m b -> m a
`finally` Ptr PyObject -> Py ()
decref Ptr PyObject
p
  VG.unsafeFreeze buf

vectorToPy :: (VG.Vector v a, ToPy a) => v a -> Py (Ptr PyObject)
vectorToPy :: forall (v :: * -> *) a.
(Vector v a, ToPy a) =>
v a -> Py (Ptr PyObject)
vectorToPy v a
vec = Program (Ptr PyObject) (Ptr PyObject) -> Py (Ptr PyObject)
forall a. Program a a -> Py a
runProgram (Program (Ptr PyObject) (Ptr PyObject) -> Py (Ptr PyObject))
-> Program (Ptr PyObject) (Ptr PyObject) -> Py (Ptr PyObject)
forall a b. (a -> b) -> a -> b
$ do
  p_list <- Ptr PyObject -> Program (Ptr PyObject) (Ptr PyObject)
forall r. Ptr PyObject -> Program r (Ptr PyObject)
takeOwnership (Ptr PyObject -> Program (Ptr PyObject) (Ptr PyObject))
-> Program (Ptr PyObject) (Ptr PyObject)
-> Program (Ptr PyObject) (Ptr PyObject)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Py (Ptr PyObject) -> Program (Ptr PyObject) (Ptr PyObject)
forall a. Py (Ptr a) -> Program (Ptr a) (Ptr a)
checkNull (IO (Ptr PyObject) -> Py (Ptr PyObject)
forall a. IO a -> Py a
Py [CU.exp| PyObject* { PyList_New($(long long n_c)) } |])
  progPy $ do
    let loop Int
i
          | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n    = Ptr PyObject
p_list Ptr PyObject -> Py () -> Py (Ptr PyObject)
forall a b. a -> Py b -> Py a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Ptr PyObject -> Py ()
incref Ptr PyObject
p_list
          | Bool
otherwise = a -> Py (Ptr PyObject)
forall a. ToPy a => a -> Py (Ptr PyObject)
basicToPy (v a -> Int -> a
forall (v :: * -> *) a. Vector v a => v a -> Int -> a
VG.unsafeIndex v a
vec Int
i) Py (Ptr PyObject)
-> (Ptr PyObject -> Py (Ptr PyObject)) -> Py (Ptr PyObject)
forall a b. Py a -> (a -> Py b) -> Py b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
              Ptr PyObject
NULL -> Ptr PyObject -> Py (Ptr PyObject)
forall a. a -> Py a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr PyObject
forall a. Ptr a
nullPtr
              Ptr PyObject
p_a  -> do
                let i_c :: CLLong
i_c = Int -> CLLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i :: CLLong
                -- NOTE: PyList_SET_ITEM steals reference
                IO () -> Py ()
forall a. IO a -> Py a
Py [CU.exp| void { PyList_SET_ITEM($(PyObject* p_list), $(long long i_c), $(PyObject* p_a)) } |]
                Int -> Py (Ptr PyObject)
loop (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
    loop 0
  where
    n :: Int
n   = v a -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
VG.length v a
vec
    n_c :: CLLong
n_c = Int -> CLLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n :: CLLong


-- | Converted to @bytes@
--
--   @since 0.2
instance ToPy BS.ByteString where
  basicToPy :: ByteString -> Py (Ptr PyObject)
basicToPy ByteString
bs = IO (Ptr PyObject) -> Py (Ptr PyObject)
forall a. IO a -> Py a
pyIO (IO (Ptr PyObject) -> Py (Ptr PyObject))
-> IO (Ptr PyObject) -> Py (Ptr PyObject)
forall a b. (a -> b) -> a -> b
$ ByteString
-> (CStringLen -> IO (Ptr PyObject)) -> IO (Ptr PyObject)
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.unsafeUseAsCStringLen ByteString
bs ((CStringLen -> IO (Ptr PyObject)) -> IO (Ptr PyObject))
-> (CStringLen -> IO (Ptr PyObject)) -> IO (Ptr PyObject)
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
ptr,Int
len) -> do
    let c_len :: CLLong
c_len = Int -> CLLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len :: CLLong
    py <- [CU.exp| PyObject* { PyBytes_FromStringAndSize($(char* ptr), $(long long c_len)) }|]
    case py of
      Ptr PyObject
NULL -> Py (Ptr PyObject) -> IO (Ptr PyObject)
forall a. Py a -> IO a
unsafeRunPy Py (Ptr PyObject)
forall a. Py a
mustThrowPyError
      Ptr PyObject
_    -> Ptr PyObject -> IO (Ptr PyObject)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr PyObject
py

-- | Accepts @bytes@ and @bytearray@
--
--   @since 0.2
instance FromPy BS.ByteString where
  basicFromPy :: Ptr PyObject -> Py ByteString
basicFromPy Ptr PyObject
py = IO ByteString -> Py ByteString
forall a. IO a -> Py a
pyIO (IO ByteString -> Py ByteString) -> IO ByteString -> Py ByteString
forall a b. (a -> b) -> a -> b
$ do
    [CU.exp| int { PyBytes_Check($(PyObject* py)) } |] IO CInt -> (CInt -> IO ByteString) -> IO ByteString
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      CInt
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)
      CInt
_ -> [CU.exp| int { PyByteArray_Check($(PyObject* py)) } |] IO CInt -> (CInt -> IO ByteString) -> IO ByteString
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        CInt
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)
        CInt
_ -> PyError -> IO ByteString
forall e a. (HasCallStack, Exception e) => e -> IO a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM PyError
BadPyType
    where
      fini :: Ptr CChar -> Int -> IO ByteString
fini Ptr CChar
py_buf Int
sz = do
        hs_buf <- Int -> IO (Ptr CChar)
forall a. Int -> IO (Ptr a)
mallocBytes Int
sz
        copyBytes hs_buf py_buf sz
        BS.unsafePackMallocCStringLen (hs_buf, sz)

-- | Converted to @bytes@
--
--   @since 0.2
instance ToPy BL.ByteString where
  basicToPy :: ByteString -> Py (Ptr PyObject)
basicToPy = ByteString -> Py (Ptr PyObject)
forall a. ToPy a => a -> Py (Ptr PyObject)
basicToPy (ByteString -> Py (Ptr PyObject))
-> (ByteString -> ByteString) -> ByteString -> Py (Ptr PyObject)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict

-- | Accepts @bytes@ and @bytearray@
--
--   @since 0.2
instance FromPy BL.ByteString where
  basicFromPy :: Ptr PyObject -> Py ByteString
basicFromPy = (ByteString -> ByteString) -> Py ByteString -> Py ByteString
forall a b. (a -> b) -> Py a -> Py b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> ByteString
BL.fromStrict (Py ByteString -> Py ByteString)
-> (Ptr PyObject -> Py ByteString) -> Ptr PyObject -> Py ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr PyObject -> Py ByteString
forall a. FromPy a => Ptr PyObject -> Py a
basicFromPy


-- | Accepts @bytes@ and @bytearray@
--
--   @since 0.2
instance FromPy SBS.ShortByteString where
  basicFromPy :: Ptr PyObject -> Py ShortByteString
basicFromPy Ptr PyObject
py = IO ShortByteString -> Py ShortByteString
forall a. IO a -> Py a
pyIO (IO ShortByteString -> Py ShortByteString)
-> IO ShortByteString -> Py ShortByteString
forall a b. (a -> b) -> a -> b
$ do
    [CU.exp| int { PyBytes_Check($(PyObject* py)) } |] IO CInt -> (CInt -> IO ShortByteString) -> IO ShortByteString
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      CInt
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)
      CInt
_ -> [CU.exp| int { PyByteArray_Check($(PyObject* py)) } |] IO CInt -> (CInt -> IO ShortByteString) -> IO ShortByteString
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        CInt
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)
        CInt
_ -> PyError -> IO ShortByteString
forall e a. (HasCallStack, Exception e) => e -> IO a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM PyError
BadPyType
    where
      fini :: Ptr CChar -> Int -> IO ShortByteString
fini Ptr CChar
buf Int
sz = do
        bs <- CStringLen -> IO ByteString
BS.unsafePackCStringLen (Ptr CChar
buf, Int
sz)
        evaluate $ SBS.toShort bs

-- | Converted to @bytes@
--
--   @since 0.2
instance ToPy SBS.ShortByteString where
  basicToPy :: ShortByteString -> Py (Ptr PyObject)
basicToPy ShortByteString
bs = IO (Ptr PyObject) -> Py (Ptr PyObject)
forall a. IO a -> Py a
pyIO (IO (Ptr PyObject) -> Py (Ptr PyObject))
-> IO (Ptr PyObject) -> Py (Ptr PyObject)
forall a b. (a -> b) -> a -> b
$ ShortByteString
-> (CStringLen -> IO (Ptr PyObject)) -> IO (Ptr PyObject)
forall a. ShortByteString -> (CStringLen -> IO a) -> IO a
SBS.useAsCStringLen ShortByteString
bs ((CStringLen -> IO (Ptr PyObject)) -> IO (Ptr PyObject))
-> (CStringLen -> IO (Ptr PyObject)) -> IO (Ptr PyObject)
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
ptr,Int
len) -> do
    let c_len :: CLLong
c_len = Int -> CLLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len :: CLLong
    py <- [CU.exp| PyObject* { PyBytes_FromStringAndSize($(char* ptr), $(long long c_len)) }|]
    case py of
      Ptr PyObject
NULL -> Py (Ptr PyObject) -> IO (Ptr PyObject)
forall a. Py a -> IO a
unsafeRunPy Py (Ptr PyObject)
forall a. Py a
mustThrowPyError
      Ptr PyObject
_    -> Ptr PyObject -> IO (Ptr PyObject)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr PyObject
py


-- | @since 0.2@.
instance ToPy T.Text where
  -- NOTE: Is there ore efficient way to access
  basicToPy :: Text -> Py (Ptr PyObject)
basicToPy Text
str = IO (Ptr PyObject) -> Py (Ptr PyObject)
forall a. IO a -> Py a
pyIO (IO (Ptr PyObject) -> Py (Ptr PyObject))
-> IO (Ptr PyObject) -> Py (Ptr PyObject)
forall a b. (a -> b) -> a -> b
$ ByteString
-> (CStringLen -> IO (Ptr PyObject)) -> IO (Ptr PyObject)
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.unsafeUseAsCStringLen ByteString
bs ((CStringLen -> IO (Ptr PyObject)) -> IO (Ptr PyObject))
-> (CStringLen -> IO (Ptr PyObject)) -> IO (Ptr PyObject)
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
ptr,Int
len) -> do
    let c_len :: CLLong
c_len = Int -> CLLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len :: CLLong
    py <- [CU.exp| PyObject* { PyUnicode_FromStringAndSize($(char* ptr), $(long long c_len)) } |]
    case py of
      Ptr PyObject
NULL -> Py (Ptr PyObject) -> IO (Ptr PyObject)
forall a. Py a -> IO a
unsafeRunPy Py (Ptr PyObject)
forall a. Py a
mustThrowPyError
      Ptr PyObject
_    -> Ptr PyObject -> IO (Ptr PyObject)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr PyObject
py
    where
      bs :: ByteString
bs = Text -> ByteString
T.encodeUtf8 Text
str

-- | @since 0.2@.
instance ToPy TL.Text where
  basicToPy :: Text -> Py (Ptr PyObject)
basicToPy = Text -> Py (Ptr PyObject)
forall a. ToPy a => a -> Py (Ptr PyObject)
basicToPy (Text -> Py (Ptr PyObject))
-> (Text -> Text) -> Text -> Py (Ptr PyObject)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.toStrict

-- | @since 0.2@.
instance FromPy T.Text where
  basicFromPy :: Ptr PyObject -> Py Text
basicFromPy Ptr PyObject
py = IO Text -> Py Text
forall a. IO a -> Py a
pyIO (IO Text -> Py Text) -> IO Text -> Py Text
forall a b. (a -> b) -> a -> b
$ do
    [CU.exp| int { PyUnicode_Check($(PyObject* py)) } |] IO CInt -> (CInt -> IO Text) -> IO Text
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      CInt
TRUE -> (Ptr CLong -> IO Text) -> IO Text
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CLong -> IO Text) -> IO Text)
-> (Ptr CLong -> IO Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ \Ptr CLong
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
      CInt
_ -> PyError -> IO Text
forall e a. (HasCallStack, Exception e) => e -> IO a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM PyError
BadPyType

-- | @since 0.2@.
instance FromPy TL.Text where
  basicFromPy :: Ptr PyObject -> Py Text
basicFromPy = (Text -> Text) -> Py Text -> Py Text
forall a b. (a -> b) -> Py a -> Py b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
TL.fromStrict (Py Text -> Py Text)
-> (Ptr PyObject -> Py Text) -> Ptr PyObject -> Py Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr PyObject -> Py Text
forall a. FromPy a => Ptr PyObject -> Py a
basicFromPy



----------------------------------------------------------------
-- Functions marshalling
----------------------------------------------------------------

-- NOTE: [Creation of python functions]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--
-- We need to call haskell from python we need to first to create
-- FunPtr on haskell side and wrap it using python's C API. Process is
-- unpleasantly convoluted.
--
-- Function marshalled from haskell side could only be called with
-- using positional arguments. Two calling conventions are supported:
--
--  - METH_O        for 1-argument
--  - METH_FASTCALL for 2+ argument functions
--
-- One problem is we need to keep PyMethodDef struct alive while
-- function object is alive and GC it when function object is GC'd.
-- To that end we use horrible hack.
--
-- PyMethodDef is allocated on C heap, wrapped into PyCapsule passed
-- to CFunction as self. It does seems hacky. However it does the trick.
-- Maybe there's other way.



-- NOTE: [Exceptions in callbacks]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--
-- We absolutely must not allow unhandled haskell exceptions in
-- callbacks from python. Else they will hit C wall and terminate
-- program. They MUST be converted to python ones.
--
-- FIXME: figure out masking for python's call. I DON'T want get hit
--        with async exception out of the blue


-- | Converted to 0-ary function
instance (ToPy b) => ToPy (IO b) where
  basicToPy :: IO b -> Py (Ptr PyObject)
basicToPy IO b
f = IO (Ptr PyObject) -> Py (Ptr PyObject)
forall a. IO a -> Py a
Py (IO (Ptr PyObject) -> Py (Ptr PyObject))
-> IO (Ptr PyObject) -> Py (Ptr PyObject)
forall a b. (a -> b) -> a -> b
$ do
    --
    f_ptr <- FunWrapper (Ptr PyObject -> Ptr PyObject -> IO (Ptr PyObject))
wrapCFunction FunWrapper (Ptr PyObject -> Ptr PyObject -> IO (Ptr PyObject))
-> FunWrapper (Ptr PyObject -> Ptr PyObject -> IO (Ptr PyObject))
forall a b. (a -> b) -> a -> b
$ \Ptr PyObject
_ Ptr PyObject
_ -> Program (Ptr PyObject) (Ptr PyObject) -> IO (Ptr PyObject)
pyCallback (Program (Ptr PyObject) (Ptr PyObject) -> IO (Ptr PyObject))
-> Program (Ptr PyObject) (Ptr PyObject) -> IO (Ptr PyObject)
forall a b. (a -> b) -> a -> b
$ do
      Py (Ptr PyObject) -> Program (Ptr PyObject) (Ptr PyObject)
forall a r. Py a -> Program r a
progPy (Py (Ptr PyObject) -> Program (Ptr PyObject) (Ptr PyObject))
-> Py (Ptr PyObject) -> Program (Ptr PyObject) (Ptr PyObject)
forall a b. (a -> b) -> a -> b
$ b -> Py (Ptr PyObject)
forall a. ToPy a => a -> Py (Ptr PyObject)
basicToPy (b -> Py (Ptr PyObject)) -> Py b -> Py (Ptr PyObject)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO b -> Py b
forall a. IO a -> Py a
dropGIL IO b
f
    --
    [CU.exp| PyObject* { inline_py_callback_METH_NOARGS($(PyCFunction f_ptr)) } |]

-- | Only accepts positional parameters
instance (FromPy a, Show a, ToPy b) => ToPy (a -> IO b) where
  basicToPy :: (a -> IO b) -> Py (Ptr PyObject)
basicToPy a -> IO b
f = IO (Ptr PyObject) -> Py (Ptr PyObject)
forall a. IO a -> Py a
Py (IO (Ptr PyObject) -> Py (Ptr PyObject))
-> IO (Ptr PyObject) -> Py (Ptr PyObject)
forall a b. (a -> b) -> a -> b
$ do
    --
    f_ptr <- FunWrapper (Ptr PyObject -> Ptr PyObject -> IO (Ptr PyObject))
wrapCFunction FunWrapper (Ptr PyObject -> Ptr PyObject -> IO (Ptr PyObject))
-> FunWrapper (Ptr PyObject -> Ptr PyObject -> IO (Ptr PyObject))
forall a b. (a -> b) -> a -> b
$ \Ptr PyObject
_ Ptr PyObject
p_a -> Program (Ptr PyObject) (Ptr PyObject) -> IO (Ptr PyObject)
pyCallback (Program (Ptr PyObject) (Ptr PyObject) -> IO (Ptr PyObject))
-> Program (Ptr PyObject) (Ptr PyObject) -> IO (Ptr PyObject)
forall a b. (a -> b) -> a -> b
$ do
      a <- Ptr PyObject -> Int -> Int64 -> Program (Ptr PyObject) a
forall a.
FromPy a =>
Ptr PyObject -> Int -> Int64 -> Program (Ptr PyObject) a
loadArg Ptr PyObject
p_a Int
0 Int64
1
      progPy $ basicToPy =<< dropGIL (f a)
    --
    [CU.exp| PyObject* { inline_py_callback_METH_O($(PyCFunction f_ptr)) } |]

-- | Only accepts positional parameters
instance (FromPy a1, FromPy a2, ToPy b) => ToPy (a1 -> a2 -> IO b) where
  basicToPy :: (a1 -> a2 -> IO b) -> Py (Ptr PyObject)
basicToPy a1 -> a2 -> IO b
f = IO (Ptr PyObject) -> Py (Ptr PyObject)
forall a. IO a -> Py a
Py (IO (Ptr PyObject) -> Py (Ptr PyObject))
-> IO (Ptr PyObject) -> Py (Ptr PyObject)
forall a b. (a -> b) -> a -> b
$ do
    --
    f_ptr <- FunWrapper
  (Ptr PyObject -> Ptr (Ptr PyObject) -> Int64 -> IO (Ptr PyObject))
wrapFastcall FunWrapper
  (Ptr PyObject -> Ptr (Ptr PyObject) -> Int64 -> IO (Ptr PyObject))
-> FunWrapper
     (Ptr PyObject -> Ptr (Ptr PyObject) -> Int64 -> IO (Ptr PyObject))
forall a b. (a -> b) -> a -> b
$ \Ptr PyObject
_ Ptr (Ptr PyObject)
p_arr Int64
n -> Program (Ptr PyObject) (Ptr PyObject) -> IO (Ptr PyObject)
pyCallback (Program (Ptr PyObject) (Ptr PyObject) -> IO (Ptr PyObject))
-> Program (Ptr PyObject) (Ptr PyObject) -> IO (Ptr PyObject)
forall a b. (a -> b) -> a -> b
$ do
      Bool -> Program (Ptr PyObject) () -> Program (Ptr PyObject) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int64
n Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Int64
2) (Program (Ptr PyObject) () -> Program (Ptr PyObject) ())
-> Program (Ptr PyObject) () -> Program (Ptr PyObject) ()
forall a b. (a -> b) -> a -> b
$ Py (Ptr PyObject) -> Program (Ptr PyObject) ()
forall r a. Py r -> Program r a
abortM (Py (Ptr PyObject) -> Program (Ptr PyObject) ())
-> Py (Ptr PyObject) -> Program (Ptr PyObject) ()
forall a b. (a -> b) -> a -> b
$ CInt -> Int64 -> Py (Ptr PyObject)
raiseBadNArgs CInt
2 Int64
n
      a1 <- Ptr (Ptr PyObject) -> Int -> Int64 -> Program (Ptr PyObject) a1
forall a.
FromPy a =>
Ptr (Ptr PyObject) -> Int -> Int64 -> Program (Ptr PyObject) a
loadArgFastcall Ptr (Ptr PyObject)
p_arr Int
0 Int64
n
      a2 <- loadArgFastcall p_arr 1 n
      progPy $ basicToPy =<< dropGIL (f a1 a2)
    --
    [CU.exp| PyObject* { inline_py_callback_METH_FASTCALL($(PyCFunctionFast f_ptr)) } |]


-- | Converted to 0-ary function
instance (ToPy b) => ToPy (Py b) where
  basicToPy :: Py b -> Py (Ptr PyObject)
basicToPy Py b
f = IO (Ptr PyObject) -> Py (Ptr PyObject)
forall a. IO a -> Py a
Py (IO (Ptr PyObject) -> Py (Ptr PyObject))
-> IO (Ptr PyObject) -> Py (Ptr PyObject)
forall a b. (a -> b) -> a -> b
$ do
    --
    f_ptr <- FunWrapper (Ptr PyObject -> Ptr PyObject -> IO (Ptr PyObject))
wrapCFunction FunWrapper (Ptr PyObject -> Ptr PyObject -> IO (Ptr PyObject))
-> FunWrapper (Ptr PyObject -> Ptr PyObject -> IO (Ptr PyObject))
forall a b. (a -> b) -> a -> b
$ \Ptr PyObject
_ Ptr PyObject
_ -> Program (Ptr PyObject) (Ptr PyObject) -> IO (Ptr PyObject)
pyCallback (Program (Ptr PyObject) (Ptr PyObject) -> IO (Ptr PyObject))
-> Program (Ptr PyObject) (Ptr PyObject) -> IO (Ptr PyObject)
forall a b. (a -> b) -> a -> b
$ do
      Py (Ptr PyObject) -> Program (Ptr PyObject) (Ptr PyObject)
forall a r. Py a -> Program r a
progPy (Py (Ptr PyObject) -> Program (Ptr PyObject) (Ptr PyObject))
-> Py (Ptr PyObject) -> Program (Ptr PyObject) (Ptr PyObject)
forall a b. (a -> b) -> a -> b
$ b -> Py (Ptr PyObject)
forall a. ToPy a => a -> Py (Ptr PyObject)
basicToPy (b -> Py (Ptr PyObject)) -> Py b -> Py (Ptr PyObject)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Py b
f
    --
    [CU.exp| PyObject* { inline_py_callback_METH_NOARGS($(PyCFunction f_ptr)) } |]

-- | Only accepts positional parameters
instance (FromPy a, Show a, ToPy b) => ToPy (a -> Py b) where
  basicToPy :: (a -> Py b) -> Py (Ptr PyObject)
basicToPy a -> Py b
f = IO (Ptr PyObject) -> Py (Ptr PyObject)
forall a. IO a -> Py a
Py (IO (Ptr PyObject) -> Py (Ptr PyObject))
-> IO (Ptr PyObject) -> Py (Ptr PyObject)
forall a b. (a -> b) -> a -> b
$ do
    --
    f_ptr <- FunWrapper (Ptr PyObject -> Ptr PyObject -> IO (Ptr PyObject))
wrapCFunction FunWrapper (Ptr PyObject -> Ptr PyObject -> IO (Ptr PyObject))
-> FunWrapper (Ptr PyObject -> Ptr PyObject -> IO (Ptr PyObject))
forall a b. (a -> b) -> a -> b
$ \Ptr PyObject
_ Ptr PyObject
p_a -> Program (Ptr PyObject) (Ptr PyObject) -> IO (Ptr PyObject)
pyCallback (Program (Ptr PyObject) (Ptr PyObject) -> IO (Ptr PyObject))
-> Program (Ptr PyObject) (Ptr PyObject) -> IO (Ptr PyObject)
forall a b. (a -> b) -> a -> b
$ do
      a <- Ptr PyObject -> Int -> Int64 -> Program (Ptr PyObject) a
forall a.
FromPy a =>
Ptr PyObject -> Int -> Int64 -> Program (Ptr PyObject) a
loadArg Ptr PyObject
p_a Int
0 Int64
1
      progPy $ basicToPy =<< f a
    --
    [CU.exp| PyObject* { inline_py_callback_METH_O($(PyCFunction f_ptr)) } |]

-- | Only accepts positional parameters
instance (FromPy a1, FromPy a2, ToPy b) => ToPy (a1 -> a2 -> Py b) where
  basicToPy :: (a1 -> a2 -> Py b) -> Py (Ptr PyObject)
basicToPy a1 -> a2 -> Py b
f = IO (Ptr PyObject) -> Py (Ptr PyObject)
forall a. IO a -> Py a
Py (IO (Ptr PyObject) -> Py (Ptr PyObject))
-> IO (Ptr PyObject) -> Py (Ptr PyObject)
forall a b. (a -> b) -> a -> b
$ do
    --
    f_ptr <- FunWrapper
  (Ptr PyObject -> Ptr (Ptr PyObject) -> Int64 -> IO (Ptr PyObject))
wrapFastcall FunWrapper
  (Ptr PyObject -> Ptr (Ptr PyObject) -> Int64 -> IO (Ptr PyObject))
-> FunWrapper
     (Ptr PyObject -> Ptr (Ptr PyObject) -> Int64 -> IO (Ptr PyObject))
forall a b. (a -> b) -> a -> b
$ \Ptr PyObject
_ Ptr (Ptr PyObject)
p_arr Int64
n -> Program (Ptr PyObject) (Ptr PyObject) -> IO (Ptr PyObject)
pyCallback (Program (Ptr PyObject) (Ptr PyObject) -> IO (Ptr PyObject))
-> Program (Ptr PyObject) (Ptr PyObject) -> IO (Ptr PyObject)
forall a b. (a -> b) -> a -> b
$ do
      Bool -> Program (Ptr PyObject) () -> Program (Ptr PyObject) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int64
n Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Int64
2) (Program (Ptr PyObject) () -> Program (Ptr PyObject) ())
-> Program (Ptr PyObject) () -> Program (Ptr PyObject) ()
forall a b. (a -> b) -> a -> b
$ Py (Ptr PyObject) -> Program (Ptr PyObject) ()
forall r a. Py r -> Program r a
abortM (Py (Ptr PyObject) -> Program (Ptr PyObject) ())
-> Py (Ptr PyObject) -> Program (Ptr PyObject) ()
forall a b. (a -> b) -> a -> b
$ CInt -> Int64 -> Py (Ptr PyObject)
raiseBadNArgs CInt
2 Int64
n
      a1 <- Ptr (Ptr PyObject) -> Int -> Int64 -> Program (Ptr PyObject) a1
forall a.
FromPy a =>
Ptr (Ptr PyObject) -> Int -> Int64 -> Program (Ptr PyObject) a
loadArgFastcall Ptr (Ptr PyObject)
p_arr Int
0 Int64
n
      a2 <- loadArgFastcall p_arr 1 n
      progPy $ basicToPy =<< f a1 a2
    --
    [CU.exp| PyObject* { inline_py_callback_METH_FASTCALL($(PyCFunctionFast f_ptr)) } |]



----------------------------------------------------------------
-- Helpers
----------------------------------------------------------------


-- | Execute haskell callback function
pyCallback :: Program (Ptr PyObject) (Ptr PyObject) -> IO (Ptr PyObject)
pyCallback :: Program (Ptr PyObject) (Ptr PyObject) -> IO (Ptr PyObject)
pyCallback Program (Ptr PyObject) (Ptr PyObject)
io = IO (Ptr PyObject) -> IO (Ptr PyObject)
forall a. IO a -> IO a
callbackEnsurePyLock (IO (Ptr PyObject) -> IO (Ptr PyObject))
-> IO (Ptr PyObject) -> IO (Ptr PyObject)
forall a b. (a -> b) -> a -> b
$ Py (Ptr PyObject) -> IO (Ptr PyObject)
forall a. Py a -> IO a
unsafeRunPy (Py (Ptr PyObject) -> IO (Ptr PyObject))
-> Py (Ptr PyObject) -> IO (Ptr PyObject)
forall a b. (a -> b) -> a -> b
$ Py (Ptr PyObject) -> Py (Ptr PyObject)
forall a. Py a -> Py a
ensureGIL (Py (Ptr PyObject) -> Py (Ptr PyObject))
-> Py (Ptr PyObject) -> Py (Ptr PyObject)
forall a b. (a -> b) -> a -> b
$ Program (Ptr PyObject) (Ptr PyObject) -> Py (Ptr PyObject)
forall a. Program a a -> Py a
runProgram Program (Ptr PyObject) (Ptr PyObject)
io Py (Ptr PyObject)
-> (SomeException -> Py (Ptr PyObject)) -> Py (Ptr PyObject)
forall e a.
(HasCallStack, Exception e) =>
Py a -> (e -> Py a) -> Py a
forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
`catch` SomeException -> Py (Ptr PyObject)
convertHaskell2Py

-- | Load argument from python object for haskell evaluation
loadArg
  :: FromPy a
  => (Ptr PyObject) -- ^ Python object to decode
  -> Int            -- ^ Argument number (0-based)
  -> Int64          -- ^ Total number of arguments
  -> Program (Ptr PyObject) a
loadArg :: forall a.
FromPy a =>
Ptr PyObject -> Int -> Int64 -> Program (Ptr PyObject) a
loadArg Ptr PyObject
p (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> CInt
i) (Int64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int64
tot) = ContT (Ptr PyObject) Py a -> Program (Ptr PyObject) a
forall r a. ContT r Py a -> Program r a
Program (ContT (Ptr PyObject) Py a -> Program (Ptr PyObject) a)
-> ContT (Ptr PyObject) Py a -> Program (Ptr PyObject) a
forall a b. (a -> b) -> a -> b
$ ((a -> Py (Ptr PyObject)) -> Py (Ptr PyObject))
-> ContT (Ptr PyObject) Py a
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((a -> Py (Ptr PyObject)) -> Py (Ptr PyObject))
 -> ContT (Ptr PyObject) Py a)
-> ((a -> Py (Ptr PyObject)) -> Py (Ptr PyObject))
-> ContT (Ptr PyObject) Py a
forall a b. (a -> b) -> a -> b
$ \a -> Py (Ptr PyObject)
success -> do
  Py a -> Py (Either PyError a)
forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (Ptr PyObject -> Py a
forall a. FromPy a => Ptr PyObject -> Py a
basicFromPy Ptr PyObject
p) Py (Either PyError a)
-> (Either PyError a -> Py (Ptr PyObject)) -> Py (Ptr PyObject)
forall a b. Py a -> (a -> Py b) -> Py b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Right a
a          -> a -> Py (Ptr PyObject)
success a
a
    Left  PyError
BadPyType  -> Py (Ptr PyObject)
oops
    Left  PyError
OutOfRange -> Py (Ptr PyObject)
oops
    Left  PyError
e          -> PyError -> Py (Ptr PyObject)
forall e a. (HasCallStack, Exception e) => e -> Py a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM PyError
e
    where
      oops :: Py (Ptr PyObject)
oops = IO (Ptr PyObject) -> Py (Ptr PyObject)
forall a. IO a -> Py a
Py [CU.block| PyObject* {
        char err[256];
        sprintf(err, "Failed to decode function argument %i of %li", $(int i)+1, $(int64_t tot));
        PyErr_SetString(PyExc_TypeError, err);
        return NULL;
        } |]

-- | Load i-th argument from array as haskell parameter
loadArgFastcall
  :: FromPy a
  => Ptr (Ptr PyObject) -- ^ Array of arguments
  -> Int                -- ^ Argument number (0-based)
  -> Int64              -- ^ Total number of arguments
  -> Program (Ptr PyObject) a
loadArgFastcall :: forall a.
FromPy a =>
Ptr (Ptr PyObject) -> Int -> Int64 -> Program (Ptr PyObject) a
loadArgFastcall Ptr (Ptr PyObject)
p_arr Int
i Int64
tot = do
  p <- IO (Ptr PyObject) -> Program (Ptr PyObject) (Ptr PyObject)
forall a r. IO a -> Program r a
progIO (IO (Ptr PyObject) -> Program (Ptr PyObject) (Ptr PyObject))
-> IO (Ptr PyObject) -> Program (Ptr PyObject) (Ptr PyObject)
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr PyObject) -> Int -> IO (Ptr PyObject)
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr (Ptr PyObject)
p_arr Int
i
  loadArg p i tot

raiseBadNArgs :: CInt -> Int64 -> Py (Ptr PyObject)
raiseBadNArgs :: CInt -> Int64 -> Py (Ptr PyObject)
raiseBadNArgs CInt
expected Int64
got = IO (Ptr PyObject) -> Py (Ptr PyObject)
forall a. IO a -> Py a
Py [CU.block| PyObject* {
  char err[256];
  sprintf(err, "Function takes exactly %i arguments (%li given)", $(int expected), $(int64_t got));
  PyErr_SetString(PyExc_TypeError, err);
  return NULL;
  } |]


type FunWrapper a = a -> IO (FunPtr a)

foreign import ccall "wrapper" wrapCFunction
  :: FunWrapper (Ptr PyObject -> Ptr PyObject -> IO (Ptr PyObject))

foreign import ccall "wrapper" wrapFastcall
  :: FunWrapper (Ptr PyObject -> Ptr (Ptr PyObject) -> Int64 -> IO (Ptr PyObject))


wordSizeInBits :: Int
wordSizeInBits :: Int
wordSizeInBits = Word -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize (Word
0 :: Word)
{-# INLINE wordSizeInBits #-}