diff --git a/changelog.md b/changelog.md new file mode 100644 --- /dev/null +++ b/changelog.md @@ -0,0 +1,7 @@ +# 3.5.0 + +* made the compilation compatible with different python3 versions +* fix a bug, which caused various garbage collection calls to result in SEGEGV +* cabal metadata changes + +## Moved from [jmillikin/haskell-cpython](https://github.com/jmillikin/haskell-cpython) to [zsedem/haskell-cpython](https://github.com/zsedem/haskell-cpython) diff --git a/cpython.cabal b/cpython.cabal --- a/cpython.cabal +++ b/cpython.cabal @@ -1,31 +1,31 @@ name: cpython -version: 3.4.0 +version: 3.5.0 license: GPL-3 license-file: license.txt author: John Millikin -maintainer: John Millikin +maintainer: Adam Zsigmond build-type: Simple -cabal-version: >= 1.6 +cabal-version: >= 1.10 category: Foreign -homepage: https://john-millikin.com/software/haskell-python/ - +homepage: https://github.com/zsedem/haskell-cpython +extra-source-files: changelog.md synopsis: Bindings for libpython description: These bindings allow Haskell code to call CPython code. It is not currently possible to call Haskell code from CPython, but this feature is planned. -extra-source-files: - cbits/hscpython-shim.h +Flag usepython38 + Description: + Fix python version to 3.8. Needed in case of the libpython3.so does + not exists or not a full python3 module. (If enabled, then only works + for python 3.8) + Default: False -source-repository head - type: git - location: https://john-millikin.com/code/haskell-cpython/ -source-repository this +source-repository head type: git - location: https://john-millikin.com/code/haskell-cpython/ - tag: haskell-cpython_3.4.0 + location: https://github.com/zsedem/haskell-cpython library ghc-options: -Wall -O2 -fno-warn-orphans @@ -40,6 +40,10 @@ build-tools: c2hs >= 0.15 + includes: + cbits/hscpython-shim.h + install-includes: + cbits/hscpython-shim.h exposed-modules: CPython CPython.Types @@ -81,4 +85,25 @@ c-sources: cbits/hscpython-shim.c include-dirs: cbits - pkgconfig-depends: python-3.4 + if flag(usepython38) + pkgconfig-depends: python-3.8 + else + pkgconfig-depends: python3 + default-language: Haskell2010 + +test-suite cpython-testsuite + type: exitcode-stdio-1.0 + main-is: Tests.hs + ghc-options: -Wall -fno-warn-orphans + hs-source-dirs: tests + + build-depends: + base > 4.0 && < 5.0 + , text + , cpython + if flag(usepython38) + extra-libraries: python3.8 + pkgconfig-depends: python-3.8 + else + pkgconfig-depends: python3 + default-language: Haskell2010 diff --git a/lib/CPython.chs b/lib/CPython.chs --- a/lib/CPython.chs +++ b/lib/CPython.chs @@ -16,26 +16,26 @@ -- along with this program. If not, see . module CPython - ( initialize - , isInitialized - , finalize - , newInterpreter - , endInterpreter - , getProgramName - , setProgramName - , getPrefix - , getExecPrefix - , getProgramFullPath - , getPath - , getVersion - , getPlatform - , getCopyright - , getCompiler - , getBuildInfo - , setArgv - , getPythonHome - , setPythonHome - ) where + ( initialize + , isInitialized + , finalize + , newInterpreter + , endInterpreter + , getProgramName + , setProgramName + , getPrefix + , getExecPrefix + , getProgramFullPath + , getPath + , getVersion + , getPlatform + , getCopyright + , getCompiler + , getBuildInfo + , setArgv + , getPythonHome + , setPythonHome + ) where #include @@ -54,13 +54,13 @@ -- first). There is no return value; it is a fatal error if the initialization -- fails. {# fun Py_Initialize as initialize - {} -> `()' id #} + {} -> `()' id #} -- | Return 'True' when the Python interpreter has been initialized, 'False' -- if not. After 'finalize' is called, this returns 'False' until -- 'initialize' is called again. {# fun Py_IsInitialized as isInitialized - {} -> `Bool' #} + {} -> `Bool' #} -- | Undo all initializations made by 'initialize' and subsequent use of -- Python/C API computations, and destroy all sub-interpreters (see @@ -89,7 +89,7 @@ -- initialization routine is called more than once; this can happen if an -- application calls 'initialize' and 'finalize' more than once. {# fun Py_Finalize as finalize - {} -> `()' id #} + {} -> `()' id #} newtype ThreadState = ThreadState (Ptr ThreadState) @@ -147,10 +147,10 @@ -- work). Simple things may work, but confusing behavior will always be near. newInterpreter :: IO (Maybe ThreadState) newInterpreter = do - ptr <- {# call Py_NewInterpreter as ^ #} - return $ if ptr == nullPtr - then Nothing - else Just $ ThreadState $ castPtr ptr + ptr <- {# call Py_NewInterpreter as ^ #} + return $ if ptr == nullPtr + then Nothing + else Just $ ThreadState $ castPtr ptr -- | Destroy the (sub-)interpreter represented by the given thread state. -- The given thread state must be the current thread state. See the @@ -162,14 +162,14 @@ -- explicitly destroyed at that point. endInterpreter :: ThreadState -> IO () endInterpreter (ThreadState ptr) = - {# call Py_EndInterpreter as ^ #} $ castPtr ptr + {# call Py_EndInterpreter as ^ #} $ castPtr ptr -- | Return the program name set with 'setProgramName', or the default. getProgramName :: IO Text getProgramName = pyGetProgramName >>= peekTextW foreign import ccall safe "hscpython-shim.h Py_GetProgramName" - pyGetProgramName :: IO CWString + pyGetProgramName :: IO CWString -- | This computation should be called before 'initialize' is called for the -- first time, if it is called at all. It tells the interpreter the value of @@ -182,7 +182,7 @@ setProgramName name = withTextW name cSetProgramName foreign import ccall safe "hscpython-shim.h hscpython_SetProgramName" - cSetProgramName :: CWString -> IO () + cSetProgramName :: CWString -> IO () -- | Return the prefix for installed platform-independent files. This is -- derived through a number of complicated rules from the program name set @@ -196,7 +196,7 @@ getPrefix = pyGetPrefix >>= peekTextW foreign import ccall safe "hscpython-shim.h Py_GetPrefix" - pyGetPrefix :: IO CWString + pyGetPrefix :: IO CWString -- | Return the /exec-prefix/ for installed platform-/dependent/ files. This -- is derived through a number of complicated rules from the program name @@ -232,7 +232,7 @@ getExecPrefix = pyGetExecPrefix >>= peekTextW foreign import ccall safe "hscpython-shim.h Py_GetExecPrefix" - pyGetExecPrefix :: IO CWString + pyGetExecPrefix :: IO CWString -- | Return the full program name of the Python executable; this is computed -- as a side-effect of deriving the default module search path from the @@ -242,7 +242,7 @@ getProgramFullPath = pyGetProgramFullPath >>= peekTextW foreign import ccall safe "hscpython-shim.h Py_GetProgramFullPath" - pyGetProgramFullPath :: IO CWString + pyGetProgramFullPath :: IO CWString -- | Return the default module search path; this is computed from the -- program name (set by 'setProgramName' above) and some environment @@ -255,7 +255,7 @@ getPath = pyGetPath >>= peekTextW foreign import ccall safe "hscpython-shim.h Py_GetPath" - pyGetPath :: IO CWString + pyGetPath :: IO CWString -- | Return the version of this Python interpreter. This is a string that -- looks something like @@ -269,7 +269,7 @@ -- separated by a period. The value is available to Python code as -- @sys.version@. {# fun Py_GetVersion as getVersion - {} -> `Text' peekText* #} + {} -> `Text' peekText* #} -- | Return the platform identifier for the current platform. On Unix, this -- is formed from the “official” name of the operating system, @@ -278,7 +278,7 @@ -- On Mac OS X, it is @\"darwin\"@. On Windows, it is @\"win\"@. The value -- is available to Python code as @sys.platform@. {# fun Py_GetPlatform as getPlatform - {} -> `Text' peekText* #} + {} -> `Text' peekText* #} -- | Return the official copyright string for the current Python version, -- for example @@ -289,7 +289,7 @@ -- -- The value is available to Python code as @sys.copyright@. {# fun Py_GetCopyright as getCopyright - {} -> `Text' peekText* #} + {} -> `Text' peekText* #} -- | Return an indication of the compiler used to build the current Python -- version, in square brackets, for example: @@ -301,7 +301,7 @@ -- The value is available to Python code as part of the variable -- @sys.version@. {# fun Py_GetCompiler as getCompiler - {} -> `Text' peekText* #} + {} -> `Text' peekText* #} -- | Return information about the sequence number and build date and time of -- the current Python interpreter instance, for example @@ -313,7 +313,7 @@ -- The value is available to Python code as part of the variable -- @sys.version@. {# fun Py_GetBuildInfo as getBuildInfo - {} -> `Text' peekText* #} + {} -> `Text' peekText* #} -- | Set @sys.argv@. The first parameter is similar to the result of -- 'getProgName', with the difference that it should refer to the script @@ -327,12 +327,12 @@ -- or just the interactive interpreter), the empty string is used instead. setArgv :: Text -> [Text] -> IO () setArgv argv0 argv = - mapWith withTextW (argv0 : argv) $ \textPtrs -> - let argc = fromIntegral $ length textPtrs in - withArray textPtrs $ pySetArgv argc + mapWith withTextW (argv0 : argv) $ \textPtrs -> + let argc = fromIntegral $ length textPtrs in + withArray textPtrs $ pySetArgv argc foreign import ccall safe "hscpython-shim.h PySys_SetArgv" - pySetArgv :: CInt -> Ptr CWString -> IO () + pySetArgv :: CInt -> Ptr CWString -> IO () -- | Return the default “home”, that is, the value set by a -- previous call to 'setPythonHome', or the value of the @PYTHONHOME@ @@ -341,7 +341,7 @@ getPythonHome = pyGetPythonHome >>= peekMaybeTextW foreign import ccall safe "hscpython-shim.h Py_GetPythonHome" - pyGetPythonHome :: IO CWString + pyGetPythonHome :: IO CWString -- | Set the default “home” directory, that is, the location -- of the standard Python libraries. The libraries are searched in @@ -351,4 +351,4 @@ setPythonHome name = withMaybeTextW name cSetPythonHome foreign import ccall safe "hscpython-shim.h hscpython_SetPythonHome" - cSetPythonHome :: CWString -> IO () + cSetPythonHome :: CWString -> IO () diff --git a/lib/CPython/Constants.chs b/lib/CPython/Constants.chs --- a/lib/CPython/Constants.chs +++ b/lib/CPython/Constants.chs @@ -16,13 +16,13 @@ -- along with this program. If not, see . module CPython.Constants - ( none - , true - , false - , isNone - , isTrue - , isFalse - ) where + ( none + , true + , false + , isNone + , isTrue + , isFalse + ) where #include @@ -30,24 +30,24 @@ -- | The Python @None@ object, denoting lack of value. {# fun unsafe hscpython_Py_None as none - {} -> `SomeObject' peekObject* #} + {} -> `SomeObject' peekObject* #} -- | The Python @True@ object. {# fun unsafe hscpython_Py_True as true - {} -> `SomeObject' peekObject* #} + {} -> `SomeObject' peekObject* #} -- | The Python @False@ object. {# fun unsafe hscpython_Py_False as false - {} -> `SomeObject' peekObject* #} + {} -> `SomeObject' peekObject* #} {# fun pure unsafe hscpython_Py_None as rawNone - {} -> `Ptr ()' id #} + {} -> `Ptr ()' id #} {# fun pure unsafe hscpython_Py_True as rawTrue - {} -> `Ptr ()' id #} + {} -> `Ptr ()' id #} {# fun pure unsafe hscpython_Py_False as rawFalse - {} -> `Ptr ()' id #} + {} -> `Ptr ()' id #} isNone :: SomeObject -> IO Bool isNone obj = withObject obj $ \ptr -> return $ ptr == rawNone diff --git a/lib/CPython/Internal.chs b/lib/CPython/Internal.chs --- a/lib/CPython/Internal.chs +++ b/lib/CPython/Internal.chs @@ -18,72 +18,72 @@ -- along with this program. If not, see . module CPython.Internal - ( - -- * FFI support - module Foreign - , module Foreign.C - , cToBool - , cFromBool - , peekText - , peekTextW - , peekMaybeTextW - , withText - , withTextW - , withMaybeTextW - , mapWith - , unsafePerformIO - - -- * Fundamental types - , SomeObject (..) - , Type (..) - , Dictionary (..) - , List (..) - , Tuple (..) - - -- * Objects - , Object (..) - , Concrete (..) - , withObject - , peekObject - , peekStaticObject - , stealObject - , incref - , decref - , callObjectRaw - , unsafeCast - - -- * Exceptions - , Exception (..) - , exceptionIf - , checkStatusCode - , checkBoolReturn - , checkIntReturn - - -- * Other classes - -- ** Mapping - , Mapping (..) - , SomeMapping (..) - , unsafeCastToMapping - - -- ** Sequence - , Sequence (..) - , SomeSequence (..) - , unsafeCastToSequence - - -- ** Iterator - , Iterator (..) - , SomeIterator (..) - , unsafeCastToIterator - ) where + ( + -- * FFI support + module Foreign + , module Foreign.C + , cToBool + , cFromBool + , peekText + , peekTextW + , peekMaybeTextW + , withText + , withTextW + , withMaybeTextW + , mapWith + , unsafePerformIO + + -- * Fundamental types + , SomeObject (..) + , Type (..) + , Dictionary (..) + , List (..) + , Tuple (..) + + -- * Objects + , Object (..) + , Concrete (..) + , withObject + , peekObject + , peekStaticObject + , stealObject + , incref + , decref + , callObjectRaw + , unsafeCast + + -- * Exceptions + , Exception (..) + , exceptionIf + , checkStatusCode + , checkBoolReturn + , checkIntReturn + + -- * Other classes + -- ** Mapping + , Mapping (..) + , SomeMapping (..) + , unsafeCastToMapping + + -- ** Sequence + , Sequence (..) + , SomeSequence (..) + , unsafeCastToSequence + + -- ** Iterator + , Iterator (..) + , SomeIterator (..) + , unsafeCastToIterator + ) where #include -import Control.Applicative ((<$>)) import qualified Control.Exception as E import qualified Data.Text as T import Data.Typeable (Typeable) -import Foreign hiding (unsafePerformIO) +import Foreign hiding (newForeignPtr, newForeignPtr_) import Foreign.C +import Foreign.Concurrent(newForeignPtr) import System.IO.Unsafe (unsafePerformIO) cToBool :: CInt -> Bool @@ -112,169 +112,170 @@ mapWith :: (a -> (b -> IO c) -> IO c) -> [a] -> ([b] -> IO c) -> IO c mapWith with' = step [] where - step acc [] io = io acc - step acc (x:xs) io = with' x $ \y -> step (acc ++ [y]) xs io + step acc [] io = io acc + step acc (x:xs) io = with' x $ \y -> step (acc ++ [y]) xs io data SomeObject = forall a. (Object a) => SomeObject (ForeignPtr a) class Object a where - toObject :: a -> SomeObject - fromForeignPtr :: ForeignPtr a -> a + toObject :: a -> SomeObject + fromForeignPtr :: ForeignPtr a -> a class Object a => Concrete a where - concreteType :: a -> Type + concreteType :: a -> Type instance Object SomeObject where - toObject = id - fromForeignPtr = SomeObject + toObject = id + fromForeignPtr = SomeObject newtype Type = Type (ForeignPtr Type) instance Object Type where - toObject (Type x) = SomeObject x - fromForeignPtr = Type + toObject (Type x) = SomeObject x + fromForeignPtr = Type newtype Dictionary = Dictionary (ForeignPtr Dictionary) instance Object Dictionary where - toObject (Dictionary x) = SomeObject x - fromForeignPtr = Dictionary + toObject (Dictionary x) = SomeObject x + fromForeignPtr = Dictionary newtype List = List (ForeignPtr List) instance Object List where - toObject (List x) = SomeObject x - fromForeignPtr = List + toObject (List x) = SomeObject x + fromForeignPtr = List newtype Tuple = Tuple (ForeignPtr Tuple) instance Object Tuple where - toObject (Tuple x) = SomeObject x - fromForeignPtr = Tuple + toObject (Tuple x) = SomeObject x + fromForeignPtr = Tuple withObject :: Object obj => obj -> (Ptr a -> IO b) -> IO b withObject obj io = case toObject obj of - SomeObject ptr -> withForeignPtr ptr (io . castPtr) + SomeObject ptr -> withForeignPtr ptr (io . castPtr) peekObject :: Object obj => Ptr a -> IO obj peekObject ptr = E.bracketOnError incPtr decref mkObj where - incPtr = incref ptr >> return ptr - mkObj _ = fromForeignPtr <$> newForeignPtr staticDecref (castPtr ptr) + incPtr = incref ptr >> return ptr + mkObj _ = fromForeignPtr <$> newForeignPtr (castPtr ptr) (decref ptr) peekStaticObject :: Object obj => Ptr a -> IO obj peekStaticObject ptr = fromForeignPtr <$> newForeignPtr_ (castPtr ptr) + where + newForeignPtr_ p = newForeignPtr p (return ()) + + unsafeStealObject :: Object obj => Ptr a -> IO obj -unsafeStealObject ptr = fromForeignPtr <$> newForeignPtr staticDecref (castPtr ptr) +unsafeStealObject ptr = fromForeignPtr <$> newForeignPtr (castPtr ptr) (decref ptr) stealObject :: Object obj => Ptr a -> IO obj stealObject ptr = exceptionIf (ptr == nullPtr) >> unsafeStealObject ptr {# fun hscpython_Py_INCREF as incref - { castPtr `Ptr a' - } -> `()' id #} + { castPtr `Ptr a' + } -> `()' id #} {# fun hscpython_Py_DECREF as decref - { castPtr `Ptr a' - } -> `()' id #} - -foreign import ccall "hscpython-shim.h &hscpython_Py_DECREF" - staticDecref :: FunPtr (Ptr a -> IO ()) + { castPtr `Ptr a' + } -> `()' id #} {# fun PyObject_CallObject as callObjectRaw - `(Object self, Object args)' => - { withObject* `self' - , withObject* `args' - } -> `SomeObject' stealObject* #} + `(Object self, Object args)' => + { withObject* `self' + , withObject* `args' + } -> `SomeObject' stealObject* #} unsafeCast :: (Object a, Object b) => a -> b unsafeCast a = case toObject a of - SomeObject ptr -> fromForeignPtr (castForeignPtr ptr) + SomeObject ptr -> fromForeignPtr (castForeignPtr ptr) data Exception = Exception - { exceptionType :: SomeObject - , exceptionValue :: SomeObject - , exceptionTraceback :: Maybe SomeObject - } - deriving (Typeable) + { exceptionType :: SomeObject + , exceptionValue :: SomeObject + , exceptionTraceback :: Maybe SomeObject + } + deriving (Typeable) instance Show Exception where - show _ = "" + show _ = "" instance E.Exception Exception exceptionIf :: Bool -> IO () exceptionIf False = return () exceptionIf True = - alloca $ \pType -> - alloca $ \pValue -> - alloca $ \pTrace -> do - {# call PyErr_Fetch as ^ #} pType pValue pTrace - {# call PyErr_NormalizeException as ^ #} pType pValue pTrace - eType <- unsafeStealObject =<< peek pType - eValue <- unsafeStealObject =<< peek pValue - eTrace <- maybePeek unsafeStealObject =<< peek pTrace - E.throwIO $ Exception eType eValue eTrace + alloca $ \pType -> + alloca $ \pValue -> + alloca $ \pTrace -> do + {# call PyErr_Fetch as ^ #} pType pValue pTrace + {# call PyErr_NormalizeException as ^ #} pType pValue pTrace + eType <- unsafeStealObject =<< peek pType + eValue <- unsafeStealObject =<< peek pValue + eTrace <- maybePeek unsafeStealObject =<< peek pTrace + E.throwIO $ Exception eType eValue eTrace checkStatusCode :: CInt -> IO () checkStatusCode = exceptionIf . (== -1) checkBoolReturn :: CInt -> IO Bool checkBoolReturn x = do - exceptionIf $ x == -1 - return $ x /= 0 + exceptionIf $ x == -1 + return $ x /= 0 checkIntReturn :: Integral a => a -> IO Integer checkIntReturn x = do - exceptionIf $ x == -1 - return $ toInteger x + exceptionIf $ x == -1 + return $ toInteger x data SomeMapping = forall a. (Mapping a) => SomeMapping (ForeignPtr a) class Object a => Mapping a where - toMapping :: a -> SomeMapping + toMapping :: a -> SomeMapping instance Object SomeMapping where - toObject (SomeMapping x) = SomeObject x - fromForeignPtr = SomeMapping + toObject (SomeMapping x) = SomeObject x + fromForeignPtr = SomeMapping instance Mapping SomeMapping where - toMapping = id + toMapping = id unsafeCastToMapping :: Object a => a -> SomeMapping unsafeCastToMapping x = case toObject x of - SomeObject ptr -> let - ptr' = castForeignPtr ptr :: ForeignPtr SomeMapping - in SomeMapping ptr' + SomeObject ptr -> let + ptr' = castForeignPtr ptr :: ForeignPtr SomeMapping + in SomeMapping ptr' data SomeSequence = forall a. (Sequence a) => SomeSequence (ForeignPtr a) class Object a => Sequence a where - toSequence :: a -> SomeSequence + toSequence :: a -> SomeSequence instance Object SomeSequence where - toObject (SomeSequence x) = SomeObject x - fromForeignPtr = SomeSequence + toObject (SomeSequence x) = SomeObject x + fromForeignPtr = SomeSequence instance Sequence SomeSequence where - toSequence = id + toSequence = id unsafeCastToSequence :: Object a => a -> SomeSequence unsafeCastToSequence x = case toObject x of - SomeObject ptr -> let - ptr' = castForeignPtr ptr :: ForeignPtr SomeSequence - in SomeSequence ptr' + SomeObject ptr -> let + ptr' = castForeignPtr ptr :: ForeignPtr SomeSequence + in SomeSequence ptr' data SomeIterator = forall a. (Iterator a) => SomeIterator (ForeignPtr a) class Object a => Iterator a where - toIterator :: a -> SomeIterator + toIterator :: a -> SomeIterator instance Object SomeIterator where - toObject (SomeIterator x) = SomeObject x - fromForeignPtr = SomeIterator + toObject (SomeIterator x) = SomeObject x + fromForeignPtr = SomeIterator instance Iterator SomeIterator where - toIterator = id + toIterator = id unsafeCastToIterator :: Object a => a -> SomeIterator unsafeCastToIterator x = case toObject x of - SomeObject ptr -> let - ptr' = castForeignPtr ptr :: ForeignPtr SomeIterator - in SomeIterator ptr' + SomeObject ptr -> let + ptr' = castForeignPtr ptr :: ForeignPtr SomeIterator + in SomeIterator ptr' diff --git a/lib/CPython/Protocols/Iterator.chs b/lib/CPython/Protocols/Iterator.chs --- a/lib/CPython/Protocols/Iterator.chs +++ b/lib/CPython/Protocols/Iterator.chs @@ -16,11 +16,11 @@ -- along with this program. If not, see . module CPython.Protocols.Iterator - ( Iterator (..) - , SomeIterator - , castToIterator - , next - ) where + ( Iterator (..) + , SomeIterator + , castToIterator + , next + ) where #include @@ -30,21 +30,21 @@ -- not implement the iterator protocol, returns 'Nothing'. castToIterator :: Object a => a -> IO (Maybe SomeIterator) castToIterator obj = - withObject obj $ \objPtr -> do - isIter <- fmap cToBool $ {# call hscpython_PyIter_Check as ^ #} objPtr - return $ if isIter - then Just $ unsafeCastToIterator obj - else Nothing + withObject obj $ \objPtr -> do + isIter <- fmap cToBool $ {# call hscpython_PyIter_Check as ^ #} objPtr + return $ if isIter + then Just $ unsafeCastToIterator obj + else Nothing -- | Return the next value from the iteration, or 'Nothing' if there are no -- remaining items. next :: Iterator iter => iter -> IO (Maybe SomeObject) next iter = - withObject iter $ \iterPtr -> do - raw <- {# call PyIter_Next as ^ #} iterPtr - if raw == nullPtr - then do - err <- {# call PyErr_Occurred as ^ #} - exceptionIf $ err /= nullPtr - return Nothing - else fmap Just $ stealObject raw + withObject iter $ \iterPtr -> do + raw <- {# call PyIter_Next as ^ #} iterPtr + if raw == nullPtr + then do + err <- {# call PyErr_Occurred as ^ #} + exceptionIf $ err /= nullPtr + return Nothing + else fmap Just $ stealObject raw diff --git a/lib/CPython/Protocols/Mapping.chs b/lib/CPython/Protocols/Mapping.chs --- a/lib/CPython/Protocols/Mapping.chs +++ b/lib/CPython/Protocols/Mapping.chs @@ -16,75 +16,75 @@ -- along with this program. If not, see . module CPython.Protocols.Mapping - ( Mapping (..) - , SomeMapping - , castToMapping - , getItem - , setItem - , deleteItem - , size - , hasKey - , keys - , values - , items - ) where + ( Mapping (..) + , SomeMapping + , castToMapping + , getItem + , setItem + , deleteItem + , size + , hasKey + , keys + , values + , items + ) where #include import CPython.Internal instance Mapping Dictionary where - toMapping = unsafeCastToMapping + toMapping = unsafeCastToMapping castToMapping :: Object a => a -> IO (Maybe SomeMapping) castToMapping obj = - withObject obj $ \objPtr -> do - isMapping <- fmap cToBool $ {# call PyMapping_Check as ^ #} objPtr - return $ if isMapping - then Just $ unsafeCastToMapping obj - else Nothing + withObject obj $ \objPtr -> do + isMapping <- fmap cToBool $ {# call PyMapping_Check as ^ #} objPtr + return $ if isMapping + then Just $ unsafeCastToMapping obj + else Nothing {# fun PyObject_GetItem as getItem - `(Mapping self, Object key)' => - { withObject* `self' - , withObject* `key' - } -> `SomeObject' stealObject* #} + `(Mapping self, Object key)' => + { withObject* `self' + , withObject* `key' + } -> `SomeObject' stealObject* #} {# fun PyObject_SetItem as setItem - `(Mapping self, Object key, Object value)' => - { withObject* `self' - , withObject* `key' - , withObject* `value' - } -> `()' checkStatusCode* #} + `(Mapping self, Object key, Object value)' => + { withObject* `self' + , withObject* `key' + , withObject* `value' + } -> `()' checkStatusCode* #} {# fun PyObject_DelItem as deleteItem - `(Mapping self, Object key)' => - { withObject* `self' - , withObject* `key' - } -> `()' checkStatusCode* #} + `(Mapping self, Object key)' => + { withObject* `self' + , withObject* `key' + } -> `()' checkStatusCode* #} {# fun PyMapping_Size as size - `Mapping self' => - { withObject* `self' - } -> `Integer' checkIntReturn* #} + `Mapping self' => + { withObject* `self' + } -> `Integer' checkIntReturn* #} {# fun PyMapping_HasKey as hasKey - `(Mapping self, Object key)' => - { withObject* `self' - , withObject* `key' - } -> `Bool' #} + `(Mapping self, Object key)' => + { withObject* `self' + , withObject* `key' + } -> `Bool' #} {# fun PyMapping_Keys as keys - `Mapping self' => - { withObject* `self' - } -> `List' stealObject* #} + `Mapping self' => + { withObject* `self' + } -> `List' stealObject* #} {# fun PyMapping_Values as values - `Mapping self' => - { withObject* `self' - } -> `List' stealObject* #} + `Mapping self' => + { withObject* `self' + } -> `List' stealObject* #} {# fun PyMapping_Items as items - `Mapping self' => - { withObject* `self' - } -> `List' stealObject* #} + `Mapping self' => + { withObject* `self' + } -> `List' stealObject* #} diff --git a/lib/CPython/Protocols/Number.chs b/lib/CPython/Protocols/Number.chs --- a/lib/CPython/Protocols/Number.chs +++ b/lib/CPython/Protocols/Number.chs @@ -17,42 +17,42 @@ -- along with this program. If not, see . module CPython.Protocols.Number - ( Number (..) - , SomeNumber - , castToNumber - , add - , subtract - , multiply - , floorDivide - , trueDivide - , remainder - , divmod - , power - , negative - , positive - , absolute - , invert - , shiftL - , shiftR - , and - , xor - , or - , inPlaceAdd - , inPlaceSubtract - , inPlaceMultiply - , inPlaceFloorDivide - , inPlaceTrueDivide - , inPlaceRemainder - , inPlacePower - , inPlaceShiftL - , inPlaceShiftR - , inPlaceAnd - , inPlaceXor - , inPlaceOr - , toInteger - , toFloat - , toBase - ) where + ( Number (..) + , SomeNumber + , castToNumber + , add + , subtract + , multiply + , floorDivide + , trueDivide + , remainder + , divmod + , power + , negative + , positive + , absolute + , invert + , shiftL + , shiftR + , and + , xor + , or + , inPlaceAdd + , inPlaceSubtract + , inPlaceMultiply + , inPlaceFloorDivide + , inPlaceTrueDivide + , inPlaceRemainder + , inPlacePower + , inPlaceShiftL + , inPlaceShiftR + , inPlaceAnd + , inPlaceXor + , inPlaceOr + , toInteger + , toFloat + , toBase + ) where #include @@ -70,44 +70,44 @@ data SomeNumber = forall a. (Number a) => SomeNumber (ForeignPtr a) class Object a => Number a where - toNumber :: a -> SomeNumber + toNumber :: a -> SomeNumber instance Object SomeNumber where - toObject (SomeNumber x) = SomeObject x - fromForeignPtr = SomeNumber + toObject (SomeNumber x) = SomeObject x + fromForeignPtr = SomeNumber instance Number SomeNumber where - toNumber = id + toNumber = id instance Number Integer where - toNumber = unsafeCastToNumber + toNumber = unsafeCastToNumber instance Number Float where - toNumber = unsafeCastToNumber + toNumber = unsafeCastToNumber instance Number Complex where - toNumber = unsafeCastToNumber + toNumber = unsafeCastToNumber -- lol wut instance Number Set where - toNumber = unsafeCastToNumber + toNumber = unsafeCastToNumber instance Number FrozenSet where - toNumber = unsafeCastToNumber + toNumber = unsafeCastToNumber unsafeCastToNumber :: Object a => a -> SomeNumber unsafeCastToNumber x = case toObject x of - SomeObject ptr -> let - ptr' = castForeignPtr ptr :: ForeignPtr SomeNumber - in SomeNumber ptr' + SomeObject ptr -> let + ptr' = castForeignPtr ptr :: ForeignPtr SomeNumber + in SomeNumber ptr' castToNumber :: Object a => a -> IO (Maybe SomeNumber) castToNumber obj = - withObject obj $ \objPtr -> do - isNumber <- fmap cToBool $ {# call PyNumber_Check as ^ #} objPtr - return $ if isNumber - then Just $ unsafeCastToNumber obj - else Nothing + withObject obj $ \objPtr -> do + isNumber <- fmap cToBool $ {# call PyNumber_Check as ^ #} objPtr + return $ if isNumber + then Just $ unsafeCastToNumber obj + else Nothing add :: (Number a, Number b) => a -> b -> IO SomeNumber add = c_add @@ -115,193 +115,193 @@ -- c2hs won't accept functions named "add" any more, so have it generate -- c_add and then wrap that manually. {# fun PyNumber_Add as c_add - `(Number a, Number b)' => - { withObject* `a' - , withObject* `b' - } -> `SomeNumber' stealObject* #} + `(Number a, Number b)' => + { withObject* `a' + , withObject* `b' + } -> `SomeNumber' stealObject* #} {# fun PyNumber_Subtract as subtract - `(Number a, Number b)' => - { withObject* `a' - , withObject* `b' - } -> `SomeNumber' stealObject* #} + `(Number a, Number b)' => + { withObject* `a' + , withObject* `b' + } -> `SomeNumber' stealObject* #} {# fun PyNumber_Multiply as multiply - `(Number a, Number b)' => - { withObject* `a' - , withObject* `b' - } -> `SomeNumber' stealObject* #} + `(Number a, Number b)' => + { withObject* `a' + , withObject* `b' + } -> `SomeNumber' stealObject* #} {# fun PyNumber_FloorDivide as floorDivide - `(Number a, Number b)' => - { withObject* `a' - , withObject* `b' - } -> `SomeNumber' stealObject* #} + `(Number a, Number b)' => + { withObject* `a' + , withObject* `b' + } -> `SomeNumber' stealObject* #} {# fun PyNumber_TrueDivide as trueDivide - `(Number a, Number b)' => - { withObject* `a' - , withObject* `b' - } -> `SomeNumber' stealObject* #} + `(Number a, Number b)' => + { withObject* `a' + , withObject* `b' + } -> `SomeNumber' stealObject* #} {# fun PyNumber_Remainder as remainder - `(Number a, Number b)' => - { withObject* `a' - , withObject* `b' - } -> `SomeNumber' stealObject* #} + `(Number a, Number b)' => + { withObject* `a' + , withObject* `b' + } -> `SomeNumber' stealObject* #} {# fun PyNumber_Divmod as divmod - `(Number a, Number b)' => - { withObject* `a' - , withObject* `b' - } -> `SomeNumber' stealObject* #} + `(Number a, Number b)' => + { withObject* `a' + , withObject* `b' + } -> `SomeNumber' stealObject* #} power :: (Number a, Number b, Number c) => a -> b -> Maybe c -> IO SomeNumber power a b mc = - withObject a $ \aPtr -> - withObject b $ \bPtr -> - maybe none (return . toObject) mc >>= \c -> - withObject c $ \cPtr -> - {# call PyNumber_Power as ^ #} aPtr bPtr cPtr - >>= stealObject + withObject a $ \aPtr -> + withObject b $ \bPtr -> + maybe none (return . toObject) mc >>= \c -> + withObject c $ \cPtr -> + {# call PyNumber_Power as ^ #} aPtr bPtr cPtr + >>= stealObject {# fun PyNumber_Negative as negative - `Number a' => - { withObject* `a' - } -> `SomeNumber' stealObject* #} + `Number a' => + { withObject* `a' + } -> `SomeNumber' stealObject* #} {# fun PyNumber_Positive as positive - `Number a' => - { withObject* `a' - } -> `SomeNumber' stealObject* #} + `Number a' => + { withObject* `a' + } -> `SomeNumber' stealObject* #} {# fun PyNumber_Absolute as absolute - `Number a' => - { withObject* `a' - } -> `SomeNumber' stealObject* #} + `Number a' => + { withObject* `a' + } -> `SomeNumber' stealObject* #} {# fun PyNumber_Invert as invert - `Number a' => - { withObject* `a' - } -> `SomeNumber' stealObject* #} + `Number a' => + { withObject* `a' + } -> `SomeNumber' stealObject* #} {# fun PyNumber_Lshift as shiftL - `(Number a, Number b)' => - { withObject* `a' - , withObject* `b' - } -> `SomeNumber' stealObject* #} + `(Number a, Number b)' => + { withObject* `a' + , withObject* `b' + } -> `SomeNumber' stealObject* #} {# fun PyNumber_Rshift as shiftR - `(Number a, Number b)' => - { withObject* `a' - , withObject* `b' - } -> `SomeNumber' stealObject* #} + `(Number a, Number b)' => + { withObject* `a' + , withObject* `b' + } -> `SomeNumber' stealObject* #} {# fun PyNumber_And as and - `(Number a, Number b)' => - { withObject* `a' - , withObject* `b' - } -> `SomeNumber' stealObject* #} + `(Number a, Number b)' => + { withObject* `a' + , withObject* `b' + } -> `SomeNumber' stealObject* #} {# fun PyNumber_Xor as xor - `(Number a, Number b)' => - { withObject* `a' - , withObject* `b' - } -> `SomeNumber' stealObject* #} + `(Number a, Number b)' => + { withObject* `a' + , withObject* `b' + } -> `SomeNumber' stealObject* #} {# fun PyNumber_Or as or - `(Number a, Number b)' => - { withObject* `a' - , withObject* `b' - } -> `SomeNumber' stealObject* #} + `(Number a, Number b)' => + { withObject* `a' + , withObject* `b' + } -> `SomeNumber' stealObject* #} {# fun PyNumber_InPlaceAdd as inPlaceAdd - `(Number a, Number b)' => - { withObject* `a' - , withObject* `b' - } -> `SomeNumber' stealObject* #} + `(Number a, Number b)' => + { withObject* `a' + , withObject* `b' + } -> `SomeNumber' stealObject* #} {# fun PyNumber_InPlaceSubtract as inPlaceSubtract - `(Number a, Number b)' => - { withObject* `a' - , withObject* `b' - } -> `SomeNumber' stealObject* #} + `(Number a, Number b)' => + { withObject* `a' + , withObject* `b' + } -> `SomeNumber' stealObject* #} {# fun PyNumber_InPlaceMultiply as inPlaceMultiply - `(Number a, Number b)' => - { withObject* `a' - , withObject* `b' - } -> `SomeNumber' stealObject* #} + `(Number a, Number b)' => + { withObject* `a' + , withObject* `b' + } -> `SomeNumber' stealObject* #} {# fun PyNumber_InPlaceFloorDivide as inPlaceFloorDivide - `(Number a, Number b)' => - { withObject* `a' - , withObject* `b' - } -> `SomeNumber' stealObject* #} + `(Number a, Number b)' => + { withObject* `a' + , withObject* `b' + } -> `SomeNumber' stealObject* #} {# fun PyNumber_InPlaceTrueDivide as inPlaceTrueDivide - `(Number a, Number b)' => - { withObject* `a' - , withObject* `b' - } -> `SomeNumber' stealObject* #} + `(Number a, Number b)' => + { withObject* `a' + , withObject* `b' + } -> `SomeNumber' stealObject* #} {# fun PyNumber_InPlaceRemainder as inPlaceRemainder - `(Number a, Number b)' => - { withObject* `a' - , withObject* `b' - } -> `SomeNumber' stealObject* #} + `(Number a, Number b)' => + { withObject* `a' + , withObject* `b' + } -> `SomeNumber' stealObject* #} inPlacePower ::(Number a, Number b, Number c) => a -> b -> Maybe c -> IO SomeNumber inPlacePower a b mc = - withObject a $ \aPtr -> - withObject b $ \bPtr -> - maybe none (return . toObject) mc >>= \c -> - withObject c $ \cPtr -> - {# call PyNumber_InPlacePower as ^ #} aPtr bPtr cPtr - >>= stealObject + withObject a $ \aPtr -> + withObject b $ \bPtr -> + maybe none (return . toObject) mc >>= \c -> + withObject c $ \cPtr -> + {# call PyNumber_InPlacePower as ^ #} aPtr bPtr cPtr + >>= stealObject {# fun PyNumber_InPlaceLshift as inPlaceShiftL - `(Number a, Number b)' => - { withObject* `a' - , withObject* `b' - } -> `SomeNumber' stealObject* #} + `(Number a, Number b)' => + { withObject* `a' + , withObject* `b' + } -> `SomeNumber' stealObject* #} {# fun PyNumber_InPlaceRshift as inPlaceShiftR - `(Number a, Number b)' => - { withObject* `a' - , withObject* `b' - } -> `SomeNumber' stealObject* #} + `(Number a, Number b)' => + { withObject* `a' + , withObject* `b' + } -> `SomeNumber' stealObject* #} {# fun PyNumber_InPlaceAnd as inPlaceAnd - `(Number a, Number b)' => - { withObject* `a' - , withObject* `b' - } -> `SomeNumber' stealObject* #} + `(Number a, Number b)' => + { withObject* `a' + , withObject* `b' + } -> `SomeNumber' stealObject* #} {# fun PyNumber_InPlaceXor as inPlaceXor - `(Number a, Number b)' => - { withObject* `a' - , withObject* `b' - } -> `SomeNumber' stealObject* #} + `(Number a, Number b)' => + { withObject* `a' + , withObject* `b' + } -> `SomeNumber' stealObject* #} {# fun PyNumber_InPlaceOr as inPlaceOr - `(Number a, Number b)' => - { withObject* `a' - , withObject* `b' - } -> `SomeNumber' stealObject* #} + `(Number a, Number b)' => + { withObject* `a' + , withObject* `b' + } -> `SomeNumber' stealObject* #} {# fun PyNumber_Long as toInteger - `Number a' => - { withObject* `a' - } -> `Integer' stealObject* #} + `Number a' => + { withObject* `a' + } -> `Integer' stealObject* #} {# fun PyNumber_Float as toFloat - `Number a' => - { withObject* `a' - } -> `Float' stealObject* #} + `Number a' => + { withObject* `a' + } -> `Float' stealObject* #} {# fun PyNumber_ToBase as toBase - `Number a' => - { withObject* `a' - , fromIntegral `Prelude.Integer' - } -> `Unicode' stealObject* #} + `Number a' => + { withObject* `a' + , fromIntegral `Prelude.Integer' + } -> `Unicode' stealObject* #} diff --git a/lib/CPython/Protocols/Object.chs b/lib/CPython/Protocols/Object.chs --- a/lib/CPython/Protocols/Object.chs +++ b/lib/CPython/Protocols/Object.chs @@ -16,45 +16,45 @@ -- along with this program. If not, see . module CPython.Protocols.Object - ( Object - , Concrete - , SomeObject - - -- * Types and casting - , getType - , isInstance - , isSubclass - , toObject - , cast - - -- * Attributes - , hasAttribute - , getAttribute - , setAttribute - , deleteAttribute - - -- * Display and debugging - , print - , repr - , ascii - , string - , bytes - - -- * Callables - , callable - , call - , callArgs - , callMethod - , callMethodArgs - - -- * Misc - , Comparison (..) - , richCompare - , toBool - , hash - , dir - , getIterator - ) where + ( Object + , Concrete + , SomeObject + + -- * Types and casting + , getType + , isInstance + , isSubclass + , toObject + , cast + + -- * Attributes + , hasAttribute + , getAttribute + , setAttribute + , deleteAttribute + + -- * Display and debugging + , print + , repr + , ascii + , string + , bytes + + -- * Callables + , callable + , call + , callArgs + , callMethod + , callMethodArgs + + -- * Misc + , Comparison (..) + , richCompare + , toBool + , hash + , dir + , getIterator + ) where #include @@ -73,9 +73,9 @@ -- failure, throws @SystemError@. This is equivalent to the Python expression -- @type(o)@. {# fun PyObject_Type as getType - `Object self' => - { withObject* `self' - } -> `Type' stealObject* #} + `Object self' => + { withObject* `self' + } -> `Type' stealObject* #} -- | Returns 'True' if /inst/ is an instance of the class /cls/ or a -- subclass of /cls/, or 'False' if not. On error, throws an exception. @@ -99,10 +99,10 @@ -- A ߞ the presence of the @__bases__@ attribute is considered -- sufficient for this determination. {# fun PyObject_IsInstance as isInstance - `(Object self, Object cls)' => - { withObject* `self' - , withObject* `cls' - } -> `Bool' checkBoolReturn* #} + `(Object self, Object cls)' => + { withObject* `self' + , withObject* `cls' + } -> `Bool' checkBoolReturn* #} -- | Returns 'True' if the class /derived/ is identical to or derived from -- the class /cls/, otherwise returns 'False'. In case of an error, throws @@ -112,58 +112,57 @@ -- is not an actual class object (or tuple), this function uses the generic -- algorithm described above. {# fun PyObject_IsSubclass as isSubclass - `(Object derived, Object cls)' => - { withObject* `derived' - , withObject* `cls' - } -> `Bool' checkBoolReturn* #} + `(Object derived, Object cls)' => + { withObject* `derived' + , withObject* `cls' + } -> `Bool' checkBoolReturn* #} -- | Attempt to cast an object to some concrete class. If the object -- isn't an instance of the class or subclass, returns 'Nothing'. cast :: (Object a, Concrete b) => a -> IO (Maybe b) -cast obj = do - let castObj = case toObject obj of - SomeObject ptr -> fromForeignPtr $ castForeignPtr ptr - validCast <- isInstance obj $ concreteType castObj - return $ if validCast - then Just castObj - else Nothing +cast obj = let castObj = case toObject obj of SomeObject ptr -> fromForeignPtr $ castForeignPtr ptr + in do + validCast <- isInstance obj $ concreteType castObj + return $ if validCast + then Just castObj + else Nothing -- | Returns 'True' if /self/ has an attribute with the given name, and -- 'False' otherwise. This is equivalent to the Python expression -- @hasattr(self, name)@ {# fun PyObject_HasAttr as hasAttribute - `Object self' => - { withObject* `self' - , withObject* `U.Unicode' - } -> `Bool' checkBoolReturn* #} + `Object self' => + { withObject* `self' + , withObject* `U.Unicode' + } -> `Bool' checkBoolReturn* #} -- | Retrieve an attribute with the given name from object /self/. Returns -- the attribute value on success, and throws an exception on failure. This -- is the equivalent of the Python expression @self.name@. {# fun PyObject_GetAttr as getAttribute - `Object self' => - { withObject* `self' - , withObject* `U.Unicode' - } -> `SomeObject' stealObject* #} + `Object self' => + { withObject* `self' + , withObject* `U.Unicode' + } -> `SomeObject' stealObject* #} -- | Set the value of the attribute with the given name, for object /self/, -- to the value /v/. THrows an exception on failure. This is the equivalent -- of the Python statement @self.name = v@. {# fun PyObject_SetAttr as setAttribute - `(Object self, Object v)' => - { withObject* `self' - , withObject* `U.Unicode' - , withObject* `v' - } -> `()' checkStatusCode* #} + `(Object self, Object v)' => + { withObject* `self' + , withObject* `U.Unicode' + , withObject* `v' + } -> `()' checkStatusCode* #} -- | Delete an attribute with the given name, for object /self/. Throws an -- exception on failure. This is the equivalent of the Python statement -- @del self.name@. {# fun hscpython_PyObject_DelAttr as deleteAttribute - `Object self' => - { withObject* `self' - , withObject* `U.Unicode' - } -> `()' checkStatusCode* #} + `Object self' => + { withObject* `self' + , withObject* `U.Unicode' + } -> `()' checkStatusCode* #} -- | Print @repr(self)@ to a handle. print :: Object self => self -> Handle -> IO () @@ -172,38 +171,38 @@ -- | Compute a string representation of object /self/, or throw an exception -- on failure. This is the equivalent of the Python expression @repr(self)@. {# fun PyObject_Repr as repr - `Object self' => - { withObject* `self' - } -> `U.Unicode' stealObject* #} + `Object self' => + { withObject* `self' + } -> `U.Unicode' stealObject* #} -- \ As 'ascii', compute a string representation of object /self/, but escape -- the non-ASCII characters in the string returned by 'repr' with @\x@, @\u@ -- or @\U@ escapes. This generates a string similar to that returned by -- 'repr' in Python 2. {# fun PyObject_ASCII as ascii - `Object self' => - { withObject* `self' - } -> `U.Unicode' stealObject* #} + `Object self' => + { withObject* `self' + } -> `U.Unicode' stealObject* #} -- | Compute a string representation of object /self/, or throw an exception -- on failure. This is the equivalent of the Python expression @str(self)@. {# fun PyObject_Str as string - `Object self' => - { withObject* `self' - } -> `U.Unicode' stealObject* #} + `Object self' => + { withObject* `self' + } -> `U.Unicode' stealObject* #} -- | Compute a bytes representation of object /self/, or throw an exception -- on failure. This is equivalent to the Python expression @bytes(self)@. {# fun PyObject_Bytes as bytes - `Object self' => - { withObject* `self' - } -> `B.Bytes' stealObject* #} + `Object self' => + { withObject* `self' + } -> `B.Bytes' stealObject* #} -- | Determine if the object /self/ is callable. {# fun PyCallable_Check as callable - `Object self' => - { withObject* `self' - } -> `Bool' checkBoolReturn* #} + `Object self' => + { withObject* `self' + } -> `Bool' checkBoolReturn* #} -- | Call a callable Python object /self/, with arguments given by the -- tuple and named arguments given by the dictionary. Returns the result of @@ -211,17 +210,17 @@ -- equivalent of the Python expression @self(*args, **kw)@. call :: Object self => self -> Tuple -> Dictionary -> IO SomeObject call self args kwargs = - withObject self $ \selfPtr -> - withObject args $ \argsPtr -> - withObject kwargs $ \kwargsPtr -> - {# call PyObject_Call as ^ #} selfPtr argsPtr kwargsPtr - >>= stealObject + withObject self $ \selfPtr -> + withObject args $ \argsPtr -> + withObject kwargs $ \kwargsPtr -> + {# call PyObject_Call as ^ #} selfPtr argsPtr kwargsPtr + >>= stealObject -- | Call a callable Python object /self/, with arguments given by the list. callArgs :: Object self => self -> [SomeObject] -> IO SomeObject callArgs self args = do - args' <- Tuple.toTuple args - D.new >>= call self args' + args' <- Tuple.toTuple args + D.new >>= call self args' -- | Call the named method of object /self/, with arguments given by the -- tuple and named arguments given by the dictionary. Returns the result of @@ -229,8 +228,8 @@ -- equivalent of the Python expression @self.method(args)@. callMethod :: Object self => self -> T.Text -> Tuple -> Dictionary -> IO SomeObject callMethod self name args kwargs = do - method <- getAttribute self =<< U.toUnicode name - call method args kwargs + method <- getAttribute self =<< U.toUnicode name + call method args kwargs -- | Call the named method of object /self/, with arguments given by the -- list. Returns the result of the call on success, or throws an exception @@ -238,59 +237,59 @@ -- @self.method(args)@. callMethodArgs :: Object self => self -> T.Text -> [SomeObject] -> IO SomeObject callMethodArgs self name args = do - args' <- Tuple.toTuple args - D.new >>= callMethod self name args' + args' <- Tuple.toTuple args + D.new >>= callMethod self name args' data Comparison = LT | LE | EQ | NE | GT | GE - deriving (Show) + deriving (Show) comparisonToInt :: Comparison -> CInt comparisonToInt = fromIntegral . fromEnum . enum where - enum LT = HSCPYTHON_LT - enum LE = HSCPYTHON_LE - enum EQ = HSCPYTHON_EQ - enum NE = HSCPYTHON_NE - enum GT = HSCPYTHON_GT - enum GE = HSCPYTHON_GE + enum LT = HSCPYTHON_LT + enum LE = HSCPYTHON_LE + enum EQ = HSCPYTHON_EQ + enum NE = HSCPYTHON_NE + enum GT = HSCPYTHON_GT + enum GE = HSCPYTHON_GE -- | Compare the values of /a/ and /b/ using the specified comparison. -- If an exception is raised, throws an exception. {# fun PyObject_RichCompareBool as richCompare - `(Object a, Object b)' => - { withObject* `a' - , withObject* `b' - , comparisonToInt `Comparison' - } -> `Bool' checkBoolReturn* #} + `(Object a, Object b)' => + { withObject* `a' + , withObject* `b' + , comparisonToInt `Comparison' + } -> `Bool' checkBoolReturn* #} -- | Returns 'True' if the object /self/ is considered to be true, and 'False' -- otherwise. This is equivalent to the Python expression @not not self@. On -- failure, throws an exception. {# fun PyObject_IsTrue as toBool - `Object self' => - { withObject* `self' - } -> `Bool' checkBoolReturn* #} + `Object self' => + { withObject* `self' + } -> `Bool' checkBoolReturn* #} -- | Compute and return the hash value of an object /self/. On failure, -- throws an exception. This is the equivalent of the Python expression -- @hash(self)@. {# fun PyObject_Hash as hash - `Object self' => - { withObject* `self' - } -> `Integer' checkIntReturn* #} + `Object self' => + { withObject* `self' + } -> `Integer' checkIntReturn* #} -- | This is equivalent to the Python expression @dir(self)@, returning a -- (possibly empty) list of strings appropriate for the object argument, -- or throws an exception if there was an error. {# fun PyObject_Dir as dir - `Object self' => - { withObject* `self' - } -> `List' stealObject* #} + `Object self' => + { withObject* `self' + } -> `List' stealObject* #} -- | This is equivalent to the Python expression @iter(self)@. It returns a -- new iterator for the object argument, or the object itself if the object -- is already an iterator. Throws @TypeError@ if the object cannot be -- iterated. {# fun PyObject_GetIter as getIterator - `Object self' => - { withObject* `self' - } -> `SomeObject' stealObject* #} + `Object self' => + { withObject* `self' + } -> `SomeObject' stealObject* #} diff --git a/lib/CPython/Protocols/Sequence.chs b/lib/CPython/Protocols/Sequence.chs --- a/lib/CPython/Protocols/Sequence.chs +++ b/lib/CPython/Protocols/Sequence.chs @@ -16,27 +16,27 @@ -- along with this program. If not, see . module CPython.Protocols.Sequence - ( Sequence (..) - , SomeSequence - , castToSequence - , length - , append - , repeat - , inPlaceAppend - , inPlaceRepeat - , getItem - , setItem - , deleteItem - , getSlice - , setSlice - , deleteSlice - , count - , contains - , index - , toList - , toTuple - , fast - ) where + ( Sequence (..) + , SomeSequence + , castToSequence + , length + , append + , repeat + , inPlaceAppend + , inPlaceRepeat + , getItem + , setItem + , deleteItem + , getSlice + , setSlice + , deleteSlice + , count + , contains + , index + , toList + , toTuple + , fast + ) where #include @@ -49,139 +49,139 @@ import CPython.Types.Unicode (Unicode) instance Sequence ByteArray where - toSequence = unsafeCastToSequence + toSequence = unsafeCastToSequence instance Sequence Bytes where - toSequence = unsafeCastToSequence + toSequence = unsafeCastToSequence instance Sequence List where - toSequence = unsafeCastToSequence + toSequence = unsafeCastToSequence instance Sequence Tuple where - toSequence = unsafeCastToSequence + toSequence = unsafeCastToSequence instance Sequence Unicode where - toSequence = unsafeCastToSequence + toSequence = unsafeCastToSequence -- | Attempt to convert an object to a generic 'Sequence'. If the object does -- not implement the sequence protocol, returns 'Nothing'. castToSequence :: Object a => a -> IO (Maybe SomeSequence) castToSequence obj = - withObject obj $ \objPtr -> do - isSequence <- fmap cToBool $ {# call PySequence_Check as ^ #} objPtr - return $ if isSequence - then Just $ unsafeCastToSequence obj - else Nothing + withObject obj $ \objPtr -> do + isSequence <- fmap cToBool $ {# call PySequence_Check as ^ #} objPtr + return $ if isSequence + then Just $ unsafeCastToSequence obj + else Nothing {# fun PySequence_Size as length - `Sequence self' => - { withObject* `self' - } -> `Integer' checkIntReturn* #} + `Sequence self' => + { withObject* `self' + } -> `Integer' checkIntReturn* #} {# fun PySequence_Concat as append - `(Sequence a, Sequence b)' => - { withObject* `a' - , withObject* `b' - } -> `SomeSequence' stealObject* #} + `(Sequence a, Sequence b)' => + { withObject* `a' + , withObject* `b' + } -> `SomeSequence' stealObject* #} {# fun PySequence_Repeat as repeat - `Sequence a' => - { withObject* `a' - , fromIntegral `Integer' - } -> `a' stealObject* #} + `Sequence a' => + { withObject* `a' + , fromIntegral `Integer' + } -> `a' stealObject* #} {# fun PySequence_InPlaceConcat as inPlaceAppend - `(Sequence a, Sequence b)' => - { withObject* `a' - , withObject* `b' - } -> `SomeSequence' stealObject* #} + `(Sequence a, Sequence b)' => + { withObject* `a' + , withObject* `b' + } -> `SomeSequence' stealObject* #} {# fun PySequence_InPlaceRepeat as inPlaceRepeat - `Sequence a' => - { withObject* `a' - , fromIntegral `Integer' - } -> `a' stealObject* #} + `Sequence a' => + { withObject* `a' + , fromIntegral `Integer' + } -> `a' stealObject* #} {# fun PySequence_GetItem as getItem - `Sequence self' => - { withObject* `self' - , fromIntegral `Integer' - } -> `SomeObject' stealObject* #} + `Sequence self' => + { withObject* `self' + , fromIntegral `Integer' + } -> `SomeObject' stealObject* #} {# fun PySequence_SetItem as setItem - `(Sequence self, Object v)' => - { withObject* `self' - , fromIntegral `Integer' - , withObject* `v' - } -> `()' checkStatusCode* #} + `(Sequence self, Object v)' => + { withObject* `self' + , fromIntegral `Integer' + , withObject* `v' + } -> `()' checkStatusCode* #} {# fun PySequence_DelItem as deleteItem - `Sequence self' => - { withObject* `self' - , fromIntegral `Integer' - } -> `()' checkStatusCode* #} + `Sequence self' => + { withObject* `self' + , fromIntegral `Integer' + } -> `()' checkStatusCode* #} {# fun PySequence_GetSlice as getSlice - `Sequence self' => - { withObject* `self' - , fromIntegral `Integer' - , fromIntegral `Integer' - } -> `SomeObject' stealObject* #} + `Sequence self' => + { withObject* `self' + , fromIntegral `Integer' + , fromIntegral `Integer' + } -> `SomeObject' stealObject* #} {# fun PySequence_SetSlice as setSlice - `(Sequence self, Object v)' => - { withObject* `self' - , fromIntegral `Integer' - , fromIntegral `Integer' - , withObject* `v' - } -> `()' checkStatusCode* #} + `(Sequence self, Object v)' => + { withObject* `self' + , fromIntegral `Integer' + , fromIntegral `Integer' + , withObject* `v' + } -> `()' checkStatusCode* #} {# fun PySequence_DelSlice as deleteSlice - `Sequence self' => - { withObject* `self' - , fromIntegral `Integer' - , fromIntegral `Integer' - } -> `()' checkStatusCode* #} + `Sequence self' => + { withObject* `self' + , fromIntegral `Integer' + , fromIntegral `Integer' + } -> `()' checkStatusCode* #} {# fun PySequence_Count as count - `(Sequence self, Object v)' => - { withObject* `self' - , withObject* `v' - } -> `Integer' checkIntReturn* #} + `(Sequence self, Object v)' => + { withObject* `self' + , withObject* `v' + } -> `Integer' checkIntReturn* #} {# fun PySequence_Contains as contains - `(Sequence self, Object v)' => - { withObject* `self' - , withObject* `v' - } -> `Bool' checkBoolReturn* #} + `(Sequence self, Object v)' => + { withObject* `self' + , withObject* `v' + } -> `Bool' checkBoolReturn* #} -- | Return the first index /i/ for which @self[i] == v@. This is equivalent -- to the Python expression @self.index(v)@. {# fun PySequence_Index as index - `(Sequence self, Object v)' => - { withObject* `self' - , withObject* `v' - } -> `Integer' checkIntReturn* #} + `(Sequence self, Object v)' => + { withObject* `self' + , withObject* `v' + } -> `Integer' checkIntReturn* #} -- | Return a list object with the same contents as the arbitrary sequence -- /seq/. The returned list is guaranteed to be new. {# fun PySequence_List as toList - `Sequence seq' => - { withObject* `seq' - } -> `List' stealObject* #} + `Sequence seq' => + { withObject* `seq' + } -> `List' stealObject* #} -- | Return a tuple object with the same contents as the arbitrary sequence -- /seq/. If /seq/ is already a tuple, it is re-used rather than copied. {# fun PySequence_Tuple as toTuple - `Sequence seq' => - { withObject* `seq' - } -> `Tuple' stealObject* #} + `Sequence seq' => + { withObject* `seq' + } -> `Tuple' stealObject* #} -- | Returns the sequence /seq/ as a tuple, unless it is already a tuple or -- list, in which case /seq/ is returned. If an error occurs, throws -- @TypeError@ with the given text as the exception text. {# fun PySequence_Fast as fast - `Sequence seq' => - { withObject* `seq' - , withText* `Text' - } -> `SomeSequence' stealObject* #} + `Sequence seq' => + { withObject* `seq' + , withText* `Text' + } -> `SomeSequence' stealObject* #} diff --git a/lib/CPython/Reflection.chs b/lib/CPython/Reflection.chs --- a/lib/CPython/Reflection.chs +++ b/lib/CPython/Reflection.chs @@ -16,13 +16,13 @@ -- along with this program. If not, see . -- module CPython.Reflection - ( getBuiltins - , getLocals - , getGlobals - , getFrame - , getFunctionName - , getFunctionDescription - ) where + ( getBuiltins + , getLocals + , getGlobals + , getFrame + , getFunctionName + , getFunctionDescription + ) where #include @@ -33,7 +33,7 @@ -- | Return a 'Dictionary' of the builtins in the current execution frame, -- or the interpreter of the thread state if no frame is currently executing. {# fun PyEval_GetBuiltins as getBuiltins - {} -> `Dictionary' peekObject* #} + {} -> `Dictionary' peekObject* #} -- | Return a 'Dictionary' of the local variables in the current execution -- frame, or 'Nothing' if no frame is currently executing. @@ -53,15 +53,15 @@ -- | Return the name of /func/ if it is a function, class or instance object, -- else the name of /func/'s type. {# fun PyEval_GetFuncName as getFunctionName - `Object func' => - { withObject* `func' - } -> `Text' peekText* #} + `Object func' => + { withObject* `func' + } -> `Text' peekText* #} -- | Return a description string, depending on the type of func. Return -- values include @\"()\"@ for functions and methods, @\"constructor\"@, -- @\"instance\"@, and @\"object\"@. Concatenated with the result of -- 'getFunctionName', the result will be a description of /func/. {# fun PyEval_GetFuncDesc as getFunctionDescription - `Object func' => - { withObject* `func' - } -> `Text' peekText* #} + `Object func' => + { withObject* `func' + } -> `Text' peekText* #} diff --git a/lib/CPython/System.chs b/lib/CPython/System.chs --- a/lib/CPython/System.chs +++ b/lib/CPython/System.chs @@ -16,13 +16,13 @@ -- along with this program. If not, see . module CPython.System - ( getObject - , setObject - , deleteObject - , resetWarnOptions - , addWarnOption - , setPath - ) where + ( getObject + , setObject + , deleteObject + , resetWarnOptions + , addWarnOption + , setPath + ) where #include @@ -34,37 +34,37 @@ -- not exist. getObject :: Text -> IO (Maybe SomeObject) getObject name = - withText name $ \cstr -> do - raw <- {# call PySys_GetObject as ^ #} cstr - maybePeek peekObject raw + withText name $ \cstr -> do + raw <- {# call PySys_GetObject as ^ #} cstr + maybePeek peekObject raw -- getFile -- | Set /name/ in the @sys@ module to a value. setObject :: Object a => Text -> a -> IO () setObject name v = - withText name $ \cstr -> - withObject v $ \vPtr -> - {# call PySys_SetObject as ^ #} cstr vPtr - >>= checkStatusCode + withText name $ \cstr -> + withObject v $ \vPtr -> + {# call PySys_SetObject as ^ #} cstr vPtr + >>= checkStatusCode -- | Delete /name/ from the @sys@ module. deleteObject :: Text -> IO () deleteObject name = - withText name $ \cstr -> - {# call PySys_SetObject as ^ #} cstr nullPtr - >>= checkStatusCode + withText name $ \cstr -> + {# call PySys_SetObject as ^ #} cstr nullPtr + >>= checkStatusCode -- | Reset @sys.warnoptions@ to an empty list. {# fun PySys_ResetWarnOptions as resetWarnOptions - {} -> `()' id #} + {} -> `()' id #} -- | Add an entry to @sys.warnoptions@. addWarnOption :: Text -> IO () addWarnOption str = withTextW str pySysAddWarnOption foreign import ccall safe "hscpython-shim.h PySys_AddWarnOption" - pySysAddWarnOption :: CWString -> IO () + pySysAddWarnOption :: CWString -> IO () -- | Set @sys.path@ to a list object of paths found in the parameter, which -- should be a list of paths separated with the platform's search path @@ -73,4 +73,4 @@ setPath path = withTextW path pySysSetPath foreign import ccall safe "hscpython-shim.h PySys_SetPath" - pySysSetPath :: CWString -> IO () + pySysSetPath :: CWString -> IO () diff --git a/lib/CPython/Types.hs b/lib/CPython/Types.hs --- a/lib/CPython/Types.hs +++ b/lib/CPython/Types.hs @@ -14,84 +14,84 @@ -- along with this program. If not, see . module CPython.Types - ( - -- * Types and classes - ByteArray - , Bytes - , Capsule - , Cell - , Code - , Complex - , Dictionary - , Exception - , CPython.Types.Float.Float - , Function - , InstanceMethod - , CPython.Types.Integer.Integer - , SequenceIterator - , CallableIterator - , List - , Method - , Module - , AnySet - , Set - , FrozenSet - , Slice - , Tuple - , Type - , Unicode - , Reference - , Proxy - - -- * Python 'Type' values - , byteArrayType - , bytesType - , capsuleType - , cellType - , codeType - , complexType - , dictionaryType - , floatType - , functionType - , instanceMethodType - , integerType - , sequenceIteratorType - , callableIteratorType - , listType - , methodType - , moduleType - , setType - , frozenSetType - , sliceType - , tupleType - , typeType - , unicodeType - - -- * Building and parsing values - , toByteArray - , fromByteArray - , toBytes - , fromBytes - , toComplex - , fromComplex - , toFloat - , fromFloat - , CPython.Types.Integer.toInteger - , CPython.Types.Integer.fromInteger - , toList - , iterableToList - , fromList - , toSet - , toFrozenSet - , iterableToSet - , iterableToFrozenSet - , fromSet - , CPython.Types.Tuple.toTuple - , iterableToTuple - , fromTuple - , toUnicode - , fromUnicode - ) where + ( + -- * Types and classes + ByteArray + , Bytes + , Capsule + , Cell + , Code + , Complex + , Dictionary + , Exception + , CPython.Types.Float.Float + , Function + , InstanceMethod + , CPython.Types.Integer.Integer + , SequenceIterator + , CallableIterator + , List + , Method + , Module + , AnySet + , Set + , FrozenSet + , Slice + , Tuple + , Type + , Unicode + , Reference + , Proxy + + -- * Python 'Type' values + , byteArrayType + , bytesType + , capsuleType + , cellType + , codeType + , complexType + , dictionaryType + , floatType + , functionType + , instanceMethodType + , integerType + , sequenceIteratorType + , callableIteratorType + , listType + , methodType + , moduleType + , setType + , frozenSetType + , sliceType + , tupleType + , typeType + , unicodeType + + -- * Building and parsing values + , toByteArray + , fromByteArray + , toBytes + , fromBytes + , toComplex + , fromComplex + , toFloat + , fromFloat + , CPython.Types.Integer.toInteger + , CPython.Types.Integer.fromInteger + , toList + , iterableToList + , fromList + , toSet + , toFrozenSet + , iterableToSet + , iterableToFrozenSet + , fromSet + , CPython.Types.Tuple.toTuple + , iterableToTuple + , fromTuple + , toUnicode + , fromUnicode + ) where import CPython.Types.ByteArray import CPython.Types.Bytes diff --git a/lib/CPython/Types/ByteArray.chs b/lib/CPython/Types/ByteArray.chs --- a/lib/CPython/Types/ByteArray.chs +++ b/lib/CPython/Types/ByteArray.chs @@ -16,15 +16,15 @@ -- along with this program. If not, see . module CPython.Types.ByteArray - ( ByteArray - , byteArrayType - , toByteArray - , fromByteArray - , fromObject - , append - , length - , resize - ) where + ( ByteArray + , byteArrayType + , toByteArray + , fromByteArray + , fromObject + , append + , length + , resize + ) where #include @@ -37,45 +37,45 @@ newtype ByteArray = ByteArray (ForeignPtr ByteArray) instance Object ByteArray where - toObject (ByteArray x) = SomeObject x - fromForeignPtr = ByteArray + toObject (ByteArray x) = SomeObject x + fromForeignPtr = ByteArray instance Concrete ByteArray where - concreteType _ = byteArrayType + concreteType _ = byteArrayType {# fun pure unsafe hscpython_PyByteArray_Type as byteArrayType - {} -> `Type' peekStaticObject* #} + {} -> `Type' peekStaticObject* #} toByteArray :: B.ByteString -> IO ByteArray toByteArray bytes = let - mkByteArray = {# call PyByteArray_FromStringAndSize as ^ #} - in B.unsafeUseAsCStringLen bytes $ \(cstr, len) -> - stealObject =<< mkByteArray cstr (fromIntegral len) + mkByteArray = {# call PyByteArray_FromStringAndSize as ^ #} + in B.unsafeUseAsCStringLen bytes $ \(cstr, len) -> + stealObject =<< mkByteArray cstr (fromIntegral len) fromByteArray :: ByteArray -> IO B.ByteString fromByteArray py = - withObject py $ \pyPtr -> do - size' <- {# call PyByteArray_Size as ^ #} pyPtr - bytes <- {# call PyByteArray_AsString as ^ #} pyPtr - B.packCStringLen (bytes, fromIntegral size') + withObject py $ \pyPtr -> do + size' <- {# call PyByteArray_Size as ^ #} pyPtr + bytes <- {# call PyByteArray_AsString as ^ #} pyPtr + B.packCStringLen (bytes, fromIntegral size') -- | Create a new byte array from any object which implements the buffer -- protocol. {# fun PyByteArray_FromObject as fromObject - `Object self ' => - { withObject* `self' - } -> `ByteArray' stealObject* #} + `Object self ' => + { withObject* `self' + } -> `ByteArray' stealObject* #} {# fun PyByteArray_Concat as append - { withObject* `ByteArray' - , withObject* `ByteArray' - } -> `ByteArray' stealObject* #} + { withObject* `ByteArray' + , withObject* `ByteArray' + } -> `ByteArray' stealObject* #} {# fun PyByteArray_Size as length - { withObject* `ByteArray' - } -> `Integer' checkIntReturn* #} + { withObject* `ByteArray' + } -> `Integer' checkIntReturn* #} {# fun PyByteArray_Resize as resize - { withObject* `ByteArray' - , fromIntegral `Integer' - } -> `()' checkStatusCode* #} + { withObject* `ByteArray' + , fromIntegral `Integer' + } -> `()' checkStatusCode* #} diff --git a/lib/CPython/Types/Bytes.chs b/lib/CPython/Types/Bytes.chs --- a/lib/CPython/Types/Bytes.chs +++ b/lib/CPython/Types/Bytes.chs @@ -16,14 +16,14 @@ -- along with this program. If not, see . module CPython.Types.Bytes - ( Bytes - , bytesType - , toBytes - , fromBytes - , fromObject - , length - , append - ) where + ( Bytes + , bytesType + , toBytes + , fromBytes + , fromObject + , length + , append + ) where #include @@ -36,50 +36,52 @@ newtype Bytes = Bytes (ForeignPtr Bytes) instance Object Bytes where - toObject (Bytes x) = SomeObject x - fromForeignPtr = Bytes + toObject (Bytes x) = SomeObject x + fromForeignPtr = Bytes instance Concrete Bytes where - concreteType _ = bytesType + concreteType _ = bytesType {# fun pure unsafe hscpython_PyBytes_Type as bytesType - {} -> `Type' peekStaticObject* #} + {} -> `Type' peekStaticObject* #} toBytes :: B.ByteString -> IO Bytes toBytes bytes = let - mkBytes = {# call PyBytes_FromStringAndSize as ^ #} - in B.unsafeUseAsCStringLen bytes $ \(cstr, len) -> - stealObject =<< mkBytes cstr (fromIntegral len) + mkBytes = {# call PyBytes_FromStringAndSize as ^ #} + in B.unsafeUseAsCStringLen bytes $ \(cstr, len) -> + stealObject =<< mkBytes cstr (fromIntegral len) fromBytes :: Bytes -> IO B.ByteString fromBytes py = - alloca $ \bytesPtr -> - alloca $ \lenPtr -> - withObject py $ \pyPtr -> do - {# call PyBytes_AsStringAndSize as ^ #} pyPtr bytesPtr lenPtr - >>= checkStatusCode - bytes <- peek bytesPtr - len <- peek lenPtr - B.packCStringLen (bytes, fromIntegral len) + alloca $ \bytesPtr -> + alloca $ \lenPtr -> + withObject py $ \pyPtr -> + do + {# call PyBytes_AsStringAndSize as ^ #} pyPtr bytesPtr lenPtr >>= checkStatusCode + bytes <- peek bytesPtr + len <- peek lenPtr + B.packCStringLen (bytes, fromIntegral len) -- | Create a new byte string from any object which implements the buffer -- protocol. {# fun PyBytes_FromObject as fromObject - `Object self ' => - { withObject* `self' - } -> `Bytes' stealObject* #} + `Object self ' => + { withObject* `self' + } -> `Bytes' stealObject* #} {# fun PyBytes_Size as length - { withObject* `Bytes' - } -> `Integer' checkIntReturn* #} + { withObject* `Bytes' + } -> `Integer' checkIntReturn* #} append :: Bytes -> Bytes -> IO Bytes append self next = - alloca $ \tempPtr -> - withObject self $ \selfPtr -> do - incref selfPtr - poke tempPtr selfPtr - withObject next $ \nextPtr -> do - {# call PyBytes_Concat as ^ #} tempPtr nextPtr - newSelf <- peek tempPtr - stealObject newSelf + alloca $ \tempPtr -> + do + withObject self $ \selfPtr -> + do incref selfPtr + poke tempPtr selfPtr + withObject next $ \nextPtr -> + do + {# call PyBytes_Concat as ^ #} tempPtr nextPtr + newSelf <- peek tempPtr + stealObject newSelf diff --git a/lib/CPython/Types/Capsule.chs b/lib/CPython/Types/Capsule.chs --- a/lib/CPython/Types/Capsule.chs +++ b/lib/CPython/Types/Capsule.chs @@ -16,20 +16,20 @@ -- along with this program. If not, see . module CPython.Types.Capsule - ( Capsule - , capsuleType - --, new - , getPointer - --, getDestructor - , getContext - , getName - , importNamed - , isValid - , setPointer - --, setDestructor - , setContext - --, setName - ) where + ( Capsule + , capsuleType + --, new + , getPointer + --, getDestructor + , getContext + , getName + , importNamed + , isValid + , setPointer + --, setDestructor + , setContext + --, setName + ) where #include @@ -41,14 +41,14 @@ newtype Capsule = Capsule (ForeignPtr Capsule) instance Object Capsule where - toObject (Capsule x) = SomeObject x - fromForeignPtr = Capsule + toObject (Capsule x) = SomeObject x + fromForeignPtr = Capsule instance Concrete Capsule where - concreteType _ = capsuleType + concreteType _ = capsuleType {# fun pure unsafe hscpython_PyCapsule_Type as capsuleType - {} -> `Type' peekStaticObject* #} + {} -> `Type' peekStaticObject* #} -- new :: Ptr () -> Maybe Text -> Destructor -> IO Capsule -- new = undefined @@ -62,9 +62,9 @@ -- names. getPointer :: Capsule -> Maybe Text -> IO (Ptr ()) getPointer py name = - withObject py $ \pyPtr -> - maybeWith withText name $ \namePtr -> - {# call PyCapsule_GetPointer as ^ #} pyPtr namePtr + withObject py $ \pyPtr -> + maybeWith withText name $ \namePtr -> + {# call PyCapsule_GetPointer as ^ #} pyPtr namePtr -- getDestructor :: Capsule -> IO (Maybe Destructor) -- getDestructor = undefined @@ -72,28 +72,28 @@ -- | Return the current context stored in the capsule, which might be @NULL@. getContext :: Capsule -> IO (Ptr ()) getContext py = - withObject py $ \pyPtr -> do - {# call PyErr_Clear as ^ #} - ptr <- {# call PyCapsule_GetContext as ^ #} pyPtr - if ptr /= nullPtr - then return ptr - else do - exc <- {# call PyErr_Occurred as ^ #} - exceptionIf $ exc /= nullPtr - return ptr + withObject py $ \pyPtr -> do + {# call PyErr_Clear as ^ #} + ptr <- {# call PyCapsule_GetContext as ^ #} pyPtr + if ptr /= nullPtr + then return ptr + else do + exc <- {# call PyErr_Occurred as ^ #} + exceptionIf $ exc /= nullPtr + return ptr -- | Return the current name stored in the capsule, which might be 'Nothing'. getName :: Capsule -> IO (Maybe Text) getName py = - withObject py $ \pyPtr -> do - {# call PyErr_Clear as ^ #} - ptr <- {# call PyCapsule_GetName as ^ #} pyPtr - if ptr /= nullPtr - then Just `fmap` peekText ptr - else do - exc <- {# call PyErr_Occurred as ^ #} - exceptionIf $ exc /= nullPtr - return Nothing + withObject py $ \pyPtr -> do + {# call PyErr_Clear as ^ #} + ptr <- {# call PyCapsule_GetName as ^ #} pyPtr + if ptr /= nullPtr + then Just `fmap` peekText ptr + else do + exc <- {# call PyErr_Occurred as ^ #} + exceptionIf $ exc /= nullPtr + return Nothing -- | Import a pointer to a C object from a capsule attribute in a module. -- The name parameter should specify the full name to the attribute, as in @@ -107,16 +107,16 @@ -- non-blocking mode, returns 'Nothing'. importNamed :: Text -> Bool -> IO (Maybe (Ptr ())) importNamed name block = - withText name $ \namePtr -> - let noBlock = cFromBool (not block) in do - {# call PyErr_Clear as ^ #} - ptr <- {# call PyCapsule_Import as ^ #} namePtr noBlock - if ptr /= nullPtr - then return $ Just ptr - else do - exc <- {# call PyErr_Occurred as ^ #} - exceptionIf $ exc /= nullPtr - return Nothing + withText name $ \namePtr -> + let noBlock = cFromBool (not block) in do + {# call PyErr_Clear as ^ #} + ptr <- {# call PyCapsule_Import as ^ #} namePtr noBlock + if ptr /= nullPtr + then return $ Just ptr + else do + exc <- {# call PyErr_Occurred as ^ #} + exceptionIf $ exc /= nullPtr + return Nothing -- | Determines whether or not a capsule is valid. A valid capsule's type is -- 'capsuleType', has a non-NULL pointer stored in it, and its internal name @@ -127,25 +127,25 @@ -- accessors (any function starting with @get@) are guaranteed to succeed. isValid :: Capsule -> Maybe Text -> IO Bool isValid py name = - withObject py $ \pyPtr -> - maybeWith withText name $ \namePtr -> - {# call PyCapsule_IsValid as ^ #} pyPtr namePtr - >>= checkBoolReturn + withObject py $ \pyPtr -> + maybeWith withText name $ \namePtr -> + {# call PyCapsule_IsValid as ^ #} pyPtr namePtr + >>= checkBoolReturn -- | Set the void pointer inside the capsule. The pointer may not be @NULL@. {# fun PyCapsule_SetPointer as setPointer - { withObject* `Capsule' - , id `Ptr ()' - } -> `()' checkStatusCode* #} + { withObject* `Capsule' + , id `Ptr ()' + } -> `()' checkStatusCode* #} -- setDestructor :: Capsule -> Maybe Destructor -> IO () -- setDestructor = undefined -- | Set the context pointer inside the capsule. {# fun PyCapsule_SetContext as setContext - { withObject* `Capsule' - , id `Ptr ()' - } -> `()' checkStatusCode* #} + { withObject* `Capsule' + , id `Ptr ()' + } -> `()' checkStatusCode* #} -- setName :: Capsule -> Maybe Text -> IO () -- setName = undefined diff --git a/lib/CPython/Types/Cell.chs b/lib/CPython/Types/Cell.chs --- a/lib/CPython/Types/Cell.chs +++ b/lib/CPython/Types/Cell.chs @@ -16,12 +16,12 @@ -- along with this program. If not, see . module CPython.Types.Cell - ( Cell - , cellType - , new - , get - , set - ) where + ( Cell + , cellType + , new + , get + , set + ) where #include @@ -30,34 +30,34 @@ newtype Cell = Cell (ForeignPtr Cell) instance Object Cell where - toObject (Cell x) = SomeObject x - fromForeignPtr = Cell + toObject (Cell x) = SomeObject x + fromForeignPtr = Cell instance Concrete Cell where - concreteType _ = cellType + concreteType _ = cellType {# fun pure unsafe hscpython_PyCell_Type as cellType - {} -> `Type' peekStaticObject* #} + {} -> `Type' peekStaticObject* #} -- | Create and return a new cell containing the value /obj/. new :: Object obj => Maybe obj -> IO Cell new obj = - maybeWith withObject obj $ \objPtr -> - {# call PyCell_New as ^ #} objPtr - >>= stealObject + maybeWith withObject obj $ \objPtr -> + {# call PyCell_New as ^ #} objPtr + >>= stealObject -- | Return the contents of a cell. get :: Cell -> IO (Maybe SomeObject) get cell = - withObject cell $ \cellPtr -> - {# call PyCell_Get as ^ #} cellPtr - >>= maybePeek stealObject + withObject cell $ \cellPtr -> + {# call PyCell_Get as ^ #} cellPtr + >>= maybePeek stealObject -- | Set the contents of a cell to /obj/. This releases the reference to any -- current content of the cell. set :: Object obj => Cell -> Maybe obj -> IO () set cell obj = - withObject cell $ \cellPtr -> - maybeWith withObject obj $ \objPtr -> - {# call PyCell_Set as ^ #} cellPtr objPtr - >>= checkStatusCode + withObject cell $ \cellPtr -> + maybeWith withObject obj $ \objPtr -> + {# call PyCell_Set as ^ #} cellPtr objPtr + >>= checkStatusCode diff --git a/lib/CPython/Types/Code.chs b/lib/CPython/Types/Code.chs --- a/lib/CPython/Types/Code.chs +++ b/lib/CPython/Types/Code.chs @@ -16,9 +16,9 @@ -- along with this program. If not, see . module CPython.Types.Code - ( Code - , codeType - ) where + ( Code + , codeType + ) where #include @@ -27,11 +27,11 @@ newtype Code = Code (ForeignPtr Code) instance Object Code where - toObject (Code x) = SomeObject x - fromForeignPtr = Code + toObject (Code x) = SomeObject x + fromForeignPtr = Code instance Concrete Code where - concreteType _ = codeType + concreteType _ = codeType {# fun pure unsafe hscpython_PyCode_Type as codeType - {} -> `Type' peekStaticObject* #} + {} -> `Type' peekStaticObject* #} diff --git a/lib/CPython/Types/Complex.chs b/lib/CPython/Types/Complex.chs --- a/lib/CPython/Types/Complex.chs +++ b/lib/CPython/Types/Complex.chs @@ -16,11 +16,11 @@ -- along with this program. If not, see . module CPython.Types.Complex - ( Complex - , complexType - , toComplex - , fromComplex - ) where + ( Complex + , complexType + , toComplex + , fromComplex + ) where #include @@ -31,23 +31,23 @@ newtype Complex = Complex (ForeignPtr Complex) instance Object Complex where - toObject (Complex x) = SomeObject x - fromForeignPtr = Complex + toObject (Complex x) = SomeObject x + fromForeignPtr = Complex instance Concrete Complex where - concreteType _ = complexType + concreteType _ = complexType {# fun pure unsafe hscpython_PyComplex_Type as complexType - {} -> `Type' peekStaticObject* #} + {} -> `Type' peekStaticObject* #} toComplex :: C.Complex Double -> IO Complex toComplex x = raw >>= stealObject where - real = realToFrac $ C.realPart x - imag = realToFrac $ C.imagPart x - raw = {# call PyComplex_FromDoubles as ^ #} real imag + real = realToFrac $ C.realPart x + imag = realToFrac $ C.imagPart x + raw = {# call PyComplex_FromDoubles as ^ #} real imag fromComplex :: Complex -> IO (C.Complex Double) fromComplex py = withObject py $ \pyPtr -> do - real <- {# call PyComplex_RealAsDouble as ^ #} pyPtr - imag <- {# call PyComplex_ImagAsDouble as ^ #} pyPtr - return $ realToFrac real C.:+ realToFrac imag + real <- {# call PyComplex_RealAsDouble as ^ #} pyPtr + imag <- {# call PyComplex_ImagAsDouble as ^ #} pyPtr + return $ realToFrac real C.:+ realToFrac imag diff --git a/lib/CPython/Types/Dictionary.chs b/lib/CPython/Types/Dictionary.chs --- a/lib/CPython/Types/Dictionary.chs +++ b/lib/CPython/Types/Dictionary.chs @@ -16,120 +16,120 @@ -- along with this program. If not, see . module CPython.Types.Dictionary - ( Dictionary - , dictionaryType - , new - , clear - , contains - , copy - , getItem - , setItem - , deleteItem - , items - , keys - , values - , size - , merge - , update - , mergeFromSeq2 - ) where + ( Dictionary + , dictionaryType + , new + , clear + , contains + , copy + , getItem + , setItem + , deleteItem + , items + , keys + , values + , size + , merge + , update + , mergeFromSeq2 + ) where #include import CPython.Internal hiding (new) instance Concrete Dictionary where - concreteType _ = dictionaryType + concreteType _ = dictionaryType {# fun pure unsafe hscpython_PyDict_Type as dictionaryType - {} -> `Type' peekStaticObject* #} + {} -> `Type' peekStaticObject* #} {# fun PyDict_New as new - {} -> `Dictionary' stealObject* #} + {} -> `Dictionary' stealObject* #} -- newProxy -- | Empty an existing dictionary of all key-value pairs. {# fun PyDict_Clear as clear - { withObject* `Dictionary' - } -> `()' id #} + { withObject* `Dictionary' + } -> `()' id #} -- | Determine if a dictionary contains /key/. If an item in the dictionary -- matches /key/, return 'True', otherwise return 'False'. On error, throws -- an exception. This is equivalent to the Python expression @key in d@. {# fun PyDict_Contains as contains - `Object key' => - { withObject* `Dictionary' - , withObject* `key' - } -> `Bool' checkBoolReturn* #} + `Object key' => + { withObject* `Dictionary' + , withObject* `key' + } -> `Bool' checkBoolReturn* #} -- | Return a new dictionary that contains the same key-value pairs as the -- old dictionary. {# fun PyDict_Copy as copy - { withObject* `Dictionary' - } -> `Dictionary' stealObject* #} + { withObject* `Dictionary' + } -> `Dictionary' stealObject* #} -- | Return the object from a dictionary which has a key /key/. Return -- 'Nothing' if the key is not present. getItem :: Object key => Dictionary -> key -> IO (Maybe SomeObject) getItem dict key = - withObject dict $ \dict' -> - withObject key $ \key' -> do - {# call PyErr_Clear as ^ #} - raw <- {# call PyDict_GetItemWithError as ^ #} dict' key' - if raw /= nullPtr - then Just `fmap` peekObject raw - else do - exc <- {# call PyErr_Occurred as ^ #} - exceptionIf $ exc /= nullPtr - return Nothing + withObject dict $ \dict' -> + withObject key $ \key' -> do + {# call PyErr_Clear as ^ #} + raw <- {# call PyDict_GetItemWithError as ^ #} dict' key' + if raw /= nullPtr + then Just `fmap` peekObject raw + else do + exc <- {# call PyErr_Occurred as ^ #} + exceptionIf $ exc /= nullPtr + return Nothing -- getItemString -- | Inserts /value/ into a dictionary with a key of /key/. /key/ must be -- hashable; if it isn’t, throws @TypeError@. {# fun PyDict_SetItem as setItem - `(Object key, Object value)' => - { withObject* `Dictionary' - , withObject* `key' - , withObject* `value' - } -> `()' checkStatusCode* #} + `(Object key, Object value)' => + { withObject* `Dictionary' + , withObject* `key' + , withObject* `value' + } -> `()' checkStatusCode* #} -- setItemString -- | Remove the entry in a dictionary with key /key/. /key/ must be hashable; -- if it isn’t, throws @TypeError@. {# fun PyDict_DelItem as deleteItem - `Object key' => - { withObject* `Dictionary' - , withObject* `key' - } -> `()' checkStatusCode* #} + `Object key' => + { withObject* `Dictionary' + , withObject* `key' + } -> `()' checkStatusCode* #} -- deleteItemString -- | Return a 'List' containing all the items in the dictionary, as in -- the Python method @dict.items()@. {# fun PyDict_Items as items - { withObject* `Dictionary' - } -> `List' stealObject* #} + { withObject* `Dictionary' + } -> `List' stealObject* #} -- | Return a 'List' containing all the keys in the dictionary, as in -- the Python method @dict.keys()@. {# fun PyDict_Keys as keys - { withObject* `Dictionary' - } -> `List' stealObject* #} + { withObject* `Dictionary' + } -> `List' stealObject* #} -- | Return a 'List' containing all the values in the dictionary, as in -- the Python method @dict.values()@. {# fun PyDict_Values as values - { withObject* `Dictionary' - } -> `List' stealObject* #} + { withObject* `Dictionary' + } -> `List' stealObject* #} -- | Return the number of items in the dictionary. This is equivalent to -- @len(d)@. {# fun PyDict_Size as size - { withObject* `Dictionary' - } -> `Integer' checkIntReturn* #} + { withObject* `Dictionary' + } -> `Integer' checkIntReturn* #} -- next @@ -139,19 +139,19 @@ -- matching key is found in /b/, otherwise pairs will only be added if there -- is not already a matching key. {# fun PyDict_Merge as merge - `Mapping b' => - { withObject* `Dictionary' - , withObject* `b' - , `Bool' - } -> `()' checkStatusCode* #} + `Mapping b' => + { withObject* `Dictionary' + , withObject* `b' + , `Bool' + } -> `()' checkStatusCode* #} -- | This is the same as @(\\a b -> 'merge' a b True)@ in Haskell, or -- @a.update(b)@ in Python. {# fun PyDict_Update as update - `Mapping b' => - { withObject* `Dictionary' - , withObject* `b' - } -> `()' checkStatusCode* #} + `Mapping b' => + { withObject* `Dictionary' + , withObject* `b' + } -> `()' checkStatusCode* #} -- | Update or merge into a dictionary, from the key-value pairs in /seq2/. -- /seq2/ must be an iterable object producing iterable objects of length 2, @@ -161,13 +161,13 @@ -- -- @ -- def mergeFromSeq2(a, seq2, override): --- for key, value in seq2: --- if override or key not in a: --- a[key] = value +-- for key, value in seq2: +-- if override or key not in a: +-- a[key] = value -- @ {# fun PyDict_MergeFromSeq2 as mergeFromSeq2 - `Object seq2' => - { withObject* `Dictionary' - , withObject* `seq2' - , `Bool' - } -> `()' checkStatusCode* #} + `Object seq2' => + { withObject* `Dictionary' + , withObject* `seq2' + , `Bool' + } -> `()' checkStatusCode* #} diff --git a/lib/CPython/Types/Exception.chs b/lib/CPython/Types/Exception.chs --- a/lib/CPython/Types/Exception.chs +++ b/lib/CPython/Types/Exception.chs @@ -16,10 +16,10 @@ -- along with this program. If not, see . module CPython.Types.Exception - ( Exception - , exceptionType - , exceptionValue - , exceptionTraceback - ) where + ( Exception + , exceptionType + , exceptionValue + , exceptionTraceback + ) where import CPython.Internal diff --git a/lib/CPython/Types/Float.chs b/lib/CPython/Types/Float.chs --- a/lib/CPython/Types/Float.chs +++ b/lib/CPython/Types/Float.chs @@ -16,11 +16,11 @@ -- along with this program. If not, see . module CPython.Types.Float - ( Float - , floatType - , toFloat - , fromFloat - ) where + ( Float + , floatType + , toFloat + , fromFloat + ) where #include @@ -31,19 +31,19 @@ newtype Float = Float (ForeignPtr Float) instance Object Float where - toObject (Float x) = SomeObject x - fromForeignPtr = Float + toObject (Float x) = SomeObject x + fromForeignPtr = Float instance Concrete Float where - concreteType _ = floatType + concreteType _ = floatType {# fun pure unsafe hscpython_PyFloat_Type as floatType - {} -> `Type' peekStaticObject* #} + {} -> `Type' peekStaticObject* #} {# fun PyFloat_FromDouble as toFloat - { realToFrac `Double' - } -> `Float' stealObject* #} + { realToFrac `Double' + } -> `Float' stealObject* #} {# fun PyFloat_AsDouble as fromFloat - { withObject* `Float' - } -> `Double' realToFrac #} + { withObject* `Float' + } -> `Double' realToFrac #} diff --git a/lib/CPython/Types/Function.chs b/lib/CPython/Types/Function.chs --- a/lib/CPython/Types/Function.chs +++ b/lib/CPython/Types/Function.chs @@ -16,19 +16,19 @@ -- along with this program. If not, see . module CPython.Types.Function - ( Function - , functionType - , new - , getCode - , getGlobals - , getModule - , getDefaults - , setDefaults - , getClosure - , setClosure - , getAnnotations - , setAnnotations - ) where + ( Function + , functionType + , new + , getCode + , getGlobals + , getModule + , getDefaults + , setDefaults + , getClosure + , setClosure + , getAnnotations + , setAnnotations + ) where #include @@ -39,14 +39,14 @@ newtype Function = Function (ForeignPtr Function) instance Object Function where - toObject (Function x) = SomeObject x - fromForeignPtr = Function + toObject (Function x) = SomeObject x + fromForeignPtr = Function instance Concrete Function where - concreteType _ = functionType + concreteType _ = functionType {# fun pure unsafe hscpython_PyFunction_Type as functionType - {} -> `Type' peekStaticObject* #} + {} -> `Type' peekStaticObject* #} -- | Return a new function associated with the given code object. The second -- parameter will be used as the globals accessible to the function. @@ -54,31 +54,31 @@ -- The function's docstring, name, and @__module__@ are retrieved from the -- code object. The parameter defaults and closure are set to 'Nothing'. {# fun PyFunction_New as new - { withObject* `Code' - , withObject* `Dictionary' - } -> `Function' stealObject* #} + { withObject* `Code' + , withObject* `Dictionary' + } -> `Function' stealObject* #} -- | Return the code object associated with a function. {# fun PyFunction_GetCode as getCode - { withObject* `Function' - } -> `Code' peekObject* #} + { withObject* `Function' + } -> `Code' peekObject* #} -- | Return the globals dictionary associated with a function. {# fun PyFunction_GetGlobals as getGlobals - { withObject* `Function' - } -> `Dictionary' peekObject* #} + { withObject* `Function' + } -> `Dictionary' peekObject* #} -- | Return the @__module__@ attribute of a function. This is normally -- a 'Unicode' containing the module name, but can be set to any other -- object by Python code. {# fun PyFunction_GetModule as getModule - { withObject* `Function' - } -> `SomeObject' peekObject* #} + { withObject* `Function' + } -> `SomeObject' peekObject* #} withNullableObject :: Object obj => Maybe obj -> (Ptr a -> IO b) -> IO b withNullableObject Nothing io = do - none <- Const.none - withObject none io + none <- Const.none + withObject none io withNullableObject (Just obj) io = withObject obj io peekNullableObject :: Object obj => Ptr a -> IO (Maybe obj) @@ -87,36 +87,36 @@ -- | Return the default parameter values for a function. This can be a tuple -- or 'Nothing'. {# fun PyFunction_GetDefaults as getDefaults - { withObject* `Function' - } -> `Maybe Tuple' peekNullableObject* #} + { withObject* `Function' + } -> `Maybe Tuple' peekNullableObject* #} -- | Set the default values for a function. {# fun PyFunction_SetDefaults as setDefaults - { withObject* `Function' - , withNullableObject* `Maybe Tuple' - } -> `()' checkStatusCode* #} + { withObject* `Function' + , withNullableObject* `Maybe Tuple' + } -> `()' checkStatusCode* #} -- | Return the closure associated with a function. This can be 'Nothing', -- or a tuple of 'Cell's. {# fun PyFunction_GetClosure as getClosure - { withObject* `Function' - } -> `Maybe Tuple' peekNullableObject* #} + { withObject* `Function' + } -> `Maybe Tuple' peekNullableObject* #} -- | Set the closure associated with a function. The tuple should contain -- 'Cell's. {# fun PyFunction_SetClosure as setClosure - { withObject* `Function' - , withNullableObject* `Maybe Tuple' - } -> `()' checkStatusCode* #} + { withObject* `Function' + , withNullableObject* `Maybe Tuple' + } -> `()' checkStatusCode* #} -- | Return the annotations for a function. This can be a mutable dictionary, -- or 'Nothing'. {# fun PyFunction_GetAnnotations as getAnnotations - { withObject* `Function' - } -> `Maybe Dictionary' peekNullableObject* #} + { withObject* `Function' + } -> `Maybe Dictionary' peekNullableObject* #} -- | Set the annotations for a function object. {# fun PyFunction_SetAnnotations as setAnnotations - { withObject* `Function' - , withNullableObject* `Maybe Dictionary' - } -> `()' checkStatusCode* #} + { withObject* `Function' + , withNullableObject* `Maybe Dictionary' + } -> `()' checkStatusCode* #} diff --git a/lib/CPython/Types/InstanceMethod.chs b/lib/CPython/Types/InstanceMethod.chs --- a/lib/CPython/Types/InstanceMethod.chs +++ b/lib/CPython/Types/InstanceMethod.chs @@ -16,11 +16,11 @@ -- along with this program. If not, see . module CPython.Types.InstanceMethod - ( InstanceMethod - , instanceMethodType - , new - , function - ) where + ( InstanceMethod + , instanceMethodType + , new + , function + ) where #include @@ -29,20 +29,20 @@ newtype InstanceMethod = InstanceMethod (ForeignPtr InstanceMethod) instance Object InstanceMethod where - toObject (InstanceMethod x) = SomeObject x - fromForeignPtr = InstanceMethod + toObject (InstanceMethod x) = SomeObject x + fromForeignPtr = InstanceMethod instance Concrete InstanceMethod where - concreteType _ = instanceMethodType + concreteType _ = instanceMethodType {# fun pure unsafe hscpython_PyInstanceMethod_Type as instanceMethodType - {} -> `Type' peekStaticObject* #} + {} -> `Type' peekStaticObject* #} {# fun PyInstanceMethod_New as new - `Object func' => - { withObject* `func' - } -> `InstanceMethod' stealObject* #} + `Object func' => + { withObject* `func' + } -> `InstanceMethod' stealObject* #} {# fun PyInstanceMethod_Function as function - { withObject* `InstanceMethod' - } -> `SomeObject' peekObject* #} + { withObject* `InstanceMethod' + } -> `SomeObject' peekObject* #} diff --git a/lib/CPython/Types/Integer.chs b/lib/CPython/Types/Integer.chs --- a/lib/CPython/Types/Integer.chs +++ b/lib/CPython/Types/Integer.chs @@ -16,11 +16,11 @@ -- along with this program. If not, see . module CPython.Types.Integer - ( Integer - , integerType - , toInteger - , fromInteger - ) where + ( Integer + , integerType + , toInteger + , fromInteger + ) where #include @@ -35,32 +35,32 @@ newtype Integer = Integer (ForeignPtr Integer) instance Object Integer where - toObject (Integer x) = SomeObject x - fromForeignPtr = Integer + toObject (Integer x) = SomeObject x + fromForeignPtr = Integer instance Concrete Integer where - concreteType _ = integerType + concreteType _ = integerType {# fun pure unsafe hscpython_PyLong_Type as integerType - {} -> `Type' peekStaticObject* #} + {} -> `Type' peekStaticObject* #} toInteger :: Prelude.Integer -> IO Integer toInteger int = do - let longlong = fromIntegral int - let [_, min', max'] = [longlong, minBound, maxBound] - stealObject =<< if Prelude.toInteger min' < int && int < Prelude.toInteger max' - then {# call PyLong_FromLongLong as ^ #} longlong - else withCString (show int) $ \cstr -> - {# call PyLong_FromString as ^ #} cstr nullPtr 10 + let longlong = fromIntegral int + let [_, min', max'] = [longlong, minBound, maxBound] + stealObject =<< if Prelude.toInteger min' < int && int < Prelude.toInteger max' + then {# call PyLong_FromLongLong as ^ #} longlong + else withCString (show int) $ \cstr -> + {# call PyLong_FromString as ^ #} cstr nullPtr 10 fromInteger :: Integer -> IO Prelude.Integer fromInteger py = do - (long, overflow) <- (withObject py $ \pyPtr -> - alloca $ \overflowPtr -> do - poke overflowPtr 0 - long <- {# call PyLong_AsLongAndOverflow as ^ #} pyPtr overflowPtr - overflow <- peek overflowPtr - return (long, overflow)) - if overflow == 0 - then return $ Prelude.toInteger long - else fmap (read . T.unpack) $ U.fromUnicode =<< O.string py + (long, overflow) <- (withObject py $ \pyPtr -> + alloca $ \overflowPtr -> do + poke overflowPtr 0 + long <- {# call PyLong_AsLongAndOverflow as ^ #} pyPtr overflowPtr + overflow <- peek overflowPtr + return (long, overflow)) + if overflow == 0 + then return $ Prelude.toInteger long + else fmap (read . T.unpack) $ U.fromUnicode =<< O.string py diff --git a/lib/CPython/Types/Iterator.chs b/lib/CPython/Types/Iterator.chs --- a/lib/CPython/Types/Iterator.chs +++ b/lib/CPython/Types/Iterator.chs @@ -16,14 +16,14 @@ -- along with this program. If not, see . module CPython.Types.Iterator - ( SequenceIterator - , sequenceIteratorType - , sequenceIteratorNew - - , CallableIterator - , callableIteratorType - , callableIteratorNew - ) where + ( SequenceIterator + , sequenceIteratorType + , sequenceIteratorNew + + , CallableIterator + , callableIteratorType + , callableIteratorNew + ) where #include @@ -32,47 +32,47 @@ newtype SequenceIterator = SequenceIterator (ForeignPtr SequenceIterator) instance Iterator SequenceIterator where - toIterator = unsafeCastToIterator + toIterator = unsafeCastToIterator instance Object SequenceIterator where - toObject (SequenceIterator x) = SomeObject x - fromForeignPtr = SequenceIterator + toObject (SequenceIterator x) = SomeObject x + fromForeignPtr = SequenceIterator instance Concrete SequenceIterator where - concreteType _ = sequenceIteratorType + concreteType _ = sequenceIteratorType newtype CallableIterator = CallableIterator (ForeignPtr CallableIterator) instance Iterator CallableIterator where - toIterator = unsafeCastToIterator + toIterator = unsafeCastToIterator instance Object CallableIterator where - toObject (CallableIterator x) = SomeObject x - fromForeignPtr = CallableIterator + toObject (CallableIterator x) = SomeObject x + fromForeignPtr = CallableIterator instance Concrete CallableIterator where - concreteType _ = callableIteratorType + concreteType _ = callableIteratorType {# fun pure unsafe hscpython_PySeqIter_Type as sequenceIteratorType - {} -> `Type' peekStaticObject* #} + {} -> `Type' peekStaticObject* #} {# fun pure unsafe hscpython_PyCallIter_Type as callableIteratorType - {} -> `Type' peekStaticObject* #} + {} -> `Type' peekStaticObject* #} -- | Return an 'Iterator' that works with a general sequence object, /seq/. -- The iteration ends when the sequence raises @IndexError@ for the -- subscripting operation. {# fun PySeqIter_New as sequenceIteratorNew - `Sequence seq' => - { withObject* `seq' - } -> `SequenceIterator' stealObject* #} + `Sequence seq' => + { withObject* `seq' + } -> `SequenceIterator' stealObject* #} -- | Return a new 'Iterator'. The first parameter, /callable/, can be any -- Python callable object that can be called with no parameters; each call -- to it should return the next item in the iteration. When /callable/ -- returns a value equal to /sentinel/, the iteration will be terminated. {# fun PyCallIter_New as callableIteratorNew - `(Object callable, Object sentinel)' => - { withObject* `callable' - , withObject* `sentinel' - } -> `CallableIterator' stealObject* #} + `(Object callable, Object sentinel)' => + { withObject* `callable' + , withObject* `sentinel' + } -> `CallableIterator' stealObject* #} diff --git a/lib/CPython/Types/List.chs b/lib/CPython/Types/List.chs --- a/lib/CPython/Types/List.chs +++ b/lib/CPython/Types/List.chs @@ -16,22 +16,22 @@ -- along with this program. If not, see . module CPython.Types.List - ( List - , listType - , toList - , iterableToList - , fromList - , length - , getItem - , setItem - , insert - , append - , getSlice - , setSlice - , sort - , reverse - , toTuple - ) where + ( List + , listType + , toList + , iterableToList + , fromList + , length + , getItem + , setItem + , insert + , append + , getSlice + , setSlice + , sort + , reverse + , toTuple + ) where #include @@ -41,80 +41,80 @@ import qualified CPython.Types.Tuple as T instance Concrete List where - concreteType _ = listType + concreteType _ = listType {# fun pure unsafe hscpython_PyList_Type as listType - {} -> `Type' peekStaticObject* #} + {} -> `Type' peekStaticObject* #} toList :: [SomeObject] -> IO List toList xs = - mapWith withObject xs $ \ptrs -> - withArrayLen ptrs $ \count array -> - {# call hscpython_poke_list #} (fromIntegral count) array - >>= stealObject + mapWith withObject xs $ \ptrs -> + withArrayLen ptrs $ \count array -> + {# call hscpython_poke_list #} (fromIntegral count) array + >>= stealObject -- | Convert any object implementing the iterator protocol to a 'List'. iterableToList :: Object iter => iter -> IO List iterableToList iter = do - raw <- callObjectRaw listType =<< T.toTuple [toObject iter] - return $ unsafeCast raw + raw <- callObjectRaw listType =<< T.toTuple [toObject iter] + return $ unsafeCast raw fromList :: List -> IO [SomeObject] fromList py = - withObject py $ \pyPtr -> - ({# call PyList_Size as ^ #} pyPtr >>=) $ \size -> - let size' = fromIntegral size :: Int in - withArray (replicate size' nullPtr) $ \ptrs -> - {# call hscpython_peek_list #} pyPtr size ptrs >> - peekArray size' ptrs >>= mapM peekObject + withObject py $ \pyPtr -> + ({# call PyList_Size as ^ #} pyPtr >>=) $ \size -> + let size' = fromIntegral size :: Int in + withArray (replicate size' nullPtr) $ \ptrs -> + {# call hscpython_peek_list #} pyPtr size ptrs >> + peekArray size' ptrs >>= mapM peekObject {# fun PyList_Size as length - { withObject* `List' - } -> `Integer' checkIntReturn* #} + { withObject* `List' + } -> `Integer' checkIntReturn* #} -- | Returns the object at a given position in the list. The position must be -- positive; indexing from the end of the list is not supported. If the -- position is out of bounds, throws an @IndexError@ exception. {# fun PyList_GetItem as getItem - { withObject* `List' - , fromIntegral `Integer' - } -> `SomeObject' peekObject* #} + { withObject* `List' + , fromIntegral `Integer' + } -> `SomeObject' peekObject* #} -- | Set the item at a given index. setItem :: Object o => List -> Integer -> o -> IO () setItem self index x = - withObject self $ \selfPtr -> - withObject x $ \xPtr -> do - incref xPtr - {# call PyList_SetItem as ^ #} selfPtr (fromIntegral index) xPtr - >>= checkStatusCode + withObject self $ \selfPtr -> + withObject x $ \xPtr -> do + incref xPtr + {# call PyList_SetItem as ^ #} selfPtr (fromIntegral index) xPtr + >>= checkStatusCode -- | Inserts /item/ into the list in front of the given index. Throws an -- exception if unsuccessful. Analogous to @list.insert(index, item)@. {# fun PyList_Insert as insert - `Object item' => - { withObject* `List' - , fromIntegral `Integer' - , withObject* `item' - } -> `()' checkStatusCode* #} + `Object item' => + { withObject* `List' + , fromIntegral `Integer' + , withObject* `item' + } -> `()' checkStatusCode* #} -- | Append /item/ to the end of th list. Throws an exception if unsuccessful. -- Analogous to @list.append(item)@. {# fun PyList_Append as append - `Object item' => - { withObject* `List' - , withObject* `item' - } -> `()' checkStatusCode* #} + `Object item' => + { withObject* `List' + , withObject* `item' + } -> `()' checkStatusCode* #} -- | Return a list of the objects in list containing the objects between -- the given indexes. Throws an exception if unsuccessful. Analogous to -- @list[low:high]@. Negative indices, as when slicing from Python, are not -- supported. {# fun PyList_GetSlice as getSlice - { withObject* `List' - , fromIntegral `Integer' - , fromIntegral `Integer' - } -> `List' stealObject* #} + { withObject* `List' + , fromIntegral `Integer' + , fromIntegral `Integer' + } -> `List' stealObject* #} -- | Sets the slice of a list between /low/ and /high/ to the contents of -- a replacement list. Analogous to @list[low:high] = replacement@. The @@ -122,32 +122,32 @@ -- (slice deletion). Negative indices, as when slicing from Python, are not -- supported. setSlice - :: List - -> Integer -- ^ Low - -> Integer -- ^ High - -> Maybe List -- ^ Replacement - -> IO () + :: List + -> Integer -- ^ Low + -> Integer -- ^ High + -> Maybe List -- ^ Replacement + -> IO () setSlice self low high items = let - low' = fromIntegral low - high' = fromIntegral high in - withObject self $ \selfPtr -> - maybeWith withObject items $ \itemsPtr -> do - {# call PyList_SetSlice as ^ #} selfPtr low' high' itemsPtr - >>= checkStatusCode + low' = fromIntegral low + high' = fromIntegral high in + withObject self $ \selfPtr -> + maybeWith withObject items $ \itemsPtr -> do + {# call PyList_SetSlice as ^ #} selfPtr low' high' itemsPtr + >>= checkStatusCode -- | Sort the items of a list in place. This is equivalent to @list.sort()@. {# fun PyList_Sort as sort - { withObject* `List' - } -> `()' checkStatusCode* #} + { withObject* `List' + } -> `()' checkStatusCode* #} -- | Reverses the items of a list in place. This is equivalent to -- @list.reverse()@. {# fun PyList_Reverse as reverse - { withObject* `List' - } -> `()' checkStatusCode* #} + { withObject* `List' + } -> `()' checkStatusCode* #} -- | Return a new 'Tuple' containing the contents of a list; equivalent to -- @tuple(list)@. {# fun PyList_AsTuple as toTuple - { withObject* `List' - } -> `Tuple' stealObject* #} + { withObject* `List' + } -> `Tuple' stealObject* #} diff --git a/lib/CPython/Types/Method.chs b/lib/CPython/Types/Method.chs --- a/lib/CPython/Types/Method.chs +++ b/lib/CPython/Types/Method.chs @@ -17,12 +17,12 @@ -- module CPython.Types.Method - ( Method - , methodType - , new - , function - , self - ) where + ( Method + , methodType + , new + , function + , self + ) where #include @@ -31,25 +31,25 @@ newtype Method = Method (ForeignPtr Method) instance Object Method where - toObject (Method x) = SomeObject x - fromForeignPtr = Method + toObject (Method x) = SomeObject x + fromForeignPtr = Method instance Concrete Method where - concreteType _ = methodType + concreteType _ = methodType {# fun pure unsafe hscpython_PyMethod_Type as methodType - {} -> `Type' peekStaticObject* #} + {} -> `Type' peekStaticObject* #} {# fun PyMethod_New as new - `(Object func, Object self)' => - { withObject* `func' - , withObject* `self' - } -> `Method' stealObject* #} + `(Object func, Object self)' => + { withObject* `func' + , withObject* `self' + } -> `Method' stealObject* #} {# fun PyMethod_Function as function - { withObject* `Method' - } -> `SomeObject' peekObject* #} + { withObject* `Method' + } -> `SomeObject' peekObject* #} {# fun PyMethod_Self as self - { withObject* `Method' - } -> `SomeObject' peekObject* #} + { withObject* `Method' + } -> `SomeObject' peekObject* #} diff --git a/lib/CPython/Types/Module.chs b/lib/CPython/Types/Module.chs --- a/lib/CPython/Types/Module.chs +++ b/lib/CPython/Types/Module.chs @@ -17,18 +17,18 @@ -- module CPython.Types.Module - ( Module - , moduleType - , new - , getDictionary - , getName - , getFilename - , addObject - , addIntegerConstant - , addTextConstant - , importModule - , reload - ) where + ( Module + , moduleType + , new + , getDictionary + , getName + , getFilename + , addObject + , addIntegerConstant + , addTextConstant + , importModule + , reload + ) where #include @@ -42,60 +42,60 @@ newtype Module = Module (ForeignPtr Module) instance Object Module where - toObject (Module x) = SomeObject x - fromForeignPtr = Module + toObject (Module x) = SomeObject x + fromForeignPtr = Module instance Concrete Module where - concreteType _ = moduleType + concreteType _ = moduleType {# fun pure unsafe hscpython_PyModule_Type as moduleType - {} -> `Type' peekStaticObject* #} + {} -> `Type' peekStaticObject* #} -- | Return a new module object with the @__name__@ attribute set. Only the -- module’s @__doc__@ and @__name__@ attributes are filled in; the -- caller is responsible for providing a @__file__@ attribute. {# fun PyModule_New as new - { withText* `Text' - } -> `Module' stealObject* #} + { withText* `Text' + } -> `Module' stealObject* #} -- | Return the dictionary object that implements a module’s namespace; -- this object is the same as the @__dict__@ attribute of the module. This -- computation never fails. It is recommended extensions use other -- computations rather than directly manipulate a module’s @__dict__@. {# fun PyModule_GetDict as getDictionary - { withObject* `Module' - } -> `Dictionary' peekObject* #} + { withObject* `Module' + } -> `Dictionary' peekObject* #} -- | Returns a module’s @__name__@ value. If the module does not -- provide one, or if it is not a string, throws @SystemError@. getName :: Module -> IO Text getName py = - withObject py $ \py' -> do - raw <- {# call PyModule_GetName as ^ #} py' - exceptionIf $ raw == nullPtr - peekText raw + withObject py $ \py' -> do + raw <- {# call PyModule_GetName as ^ #} py' + exceptionIf $ raw == nullPtr + peekText raw -- | Returns the name of the file from which a module was loaded using the -- module’s @__file__@ attribute. If this is not defined, or if it is -- not a string, throws @SystemError@. getFilename :: Module -> IO Text getFilename py = - withObject py $ \py' -> do - raw <- {# call PyModule_GetFilename as ^ #} py' - exceptionIf $ raw == nullPtr - peekText raw + withObject py $ \py' -> do + raw <- {# call PyModule_GetFilename as ^ #} py' + exceptionIf $ raw == nullPtr + peekText raw -- | Add an object to a module with the given name. This is a convenience -- computation which can be used from the module’s initialization -- computation. addObject :: Object value => Module -> Text -> value -> IO () addObject py name val = - withObject py $ \py' -> - withText name $ \name' -> - withObject val $ \val' -> - incref val' >> - {# call PyModule_AddObject as ^ #} py' name' val' - >>= checkStatusCode + withObject py $ \py' -> + withText name $ \name' -> + withObject val $ \val' -> + incref val' >> + {# call PyModule_AddObject as ^ #} py' name' val' + >>= checkStatusCode -- | Add an integer constant to a module. This convenience computation can be -- used from the module’s initialization computation. @@ -116,13 +116,13 @@ -- This computation always uses absolute imports. importModule :: Text -> IO Module importModule name = do - pyName <- toUnicode name - withObject pyName $ \namePtr -> - {# call PyImport_Import as ^ #} namePtr - >>= stealObject + pyName <- toUnicode name + withObject pyName $ \namePtr -> + {# call PyImport_Import as ^ #} namePtr + >>= stealObject -- | Reload a module. If an error occurs, an exception is thrown and the old -- module still exists. {# fun PyImport_ReloadModule as reload - { withObject* `Module' - } -> `Module' stealObject* #} + { withObject* `Module' + } -> `Module' stealObject* #} diff --git a/lib/CPython/Types/Set.chs b/lib/CPython/Types/Set.chs --- a/lib/CPython/Types/Set.chs +++ b/lib/CPython/Types/Set.chs @@ -21,23 +21,23 @@ -- 'subtract', 'or', 'xor', 'inPlaceAnd', 'inPlaceSubtract', 'inPlaceOr', -- and 'inPlaceXor'). module CPython.Types.Set - ( AnySet - , Set - , FrozenSet - , setType - , frozenSetType - , toSet - , toFrozenSet - , iterableToSet - , iterableToFrozenSet - , fromSet - , size - , contains - , add - , discard - , pop - , clear - ) where + ( AnySet + , Set + , FrozenSet + , setType + , frozenSetType + , toSet + , toFrozenSet + , iterableToSet + , iterableToFrozenSet + , fromSet + , size + , contains + , add + , discard + , pop + , clear + ) where #include @@ -49,29 +49,29 @@ newtype Set = Set (ForeignPtr Set) instance Object Set where - toObject (Set x) = SomeObject x - fromForeignPtr = Set + toObject (Set x) = SomeObject x + fromForeignPtr = Set instance Concrete Set where - concreteType _ = setType + concreteType _ = setType newtype FrozenSet = FrozenSet (ForeignPtr FrozenSet) instance Object FrozenSet where - toObject (FrozenSet x) = SomeObject x - fromForeignPtr = FrozenSet + toObject (FrozenSet x) = SomeObject x + fromForeignPtr = FrozenSet instance Concrete FrozenSet where - concreteType _ = frozenSetType + concreteType _ = frozenSetType instance AnySet Set instance AnySet FrozenSet {# fun pure unsafe hscpython_PySet_Type as setType - {} -> `Type' peekStaticObject* #} + {} -> `Type' peekStaticObject* #} {# fun pure unsafe hscpython_PyFrozenSet_Type as frozenSetType - {} -> `Type' peekStaticObject* #} + {} -> `Type' peekStaticObject* #} toSet :: [SomeObject] -> IO Set toSet xs = toTuple xs >>= iterableToSet @@ -83,36 +83,36 @@ -- may be 'Nothing' to create an empty set. Throws a @TypeError@ if the object -- is not iterable. {# fun PySet_New as iterableToSet - `Object obj' => - { withObject* `obj' - } -> `Set' stealObject* #} + `Object obj' => + { withObject* `obj' + } -> `Set' stealObject* #} -- | Return a new 'FrozenSet' from the contents of an iterable 'Object'. The -- object may be 'Nothing' to create an empty frozen set. Throws a @TypeError@ -- if the object is not iterable. {# fun PyFrozenSet_New as iterableToFrozenSet - `Object obj' => - { withObject* `obj' - } -> `FrozenSet' stealObject* #} + `Object obj' => + { withObject* `obj' + } -> `FrozenSet' stealObject* #} fromSet :: AnySet set => set -> IO [SomeObject] fromSet set = iterableToTuple set >>= fromTuple -- | Return the size of a 'Set' or 'FrozenSet'. {# fun PySet_Size as size - `AnySet set' => - { withObject* `set' - } -> `Integer' checkIntReturn* #} + `AnySet set' => + { withObject* `set' + } -> `Integer' checkIntReturn* #} -- | Return 'True' if found, 'False' if not found. Unlike the Python -- @__contains__()@ method, this computation does not automatically convert -- unhashable 'Set's into temporary 'FrozenSet's. Throws a @TypeError@ if the -- key is unhashable. {# fun PySet_Contains as contains - `(AnySet set, Object key)' => - { withObject* `set' - , withObject* `key' - } -> `Bool' checkBoolReturn* #} + `(AnySet set, Object key)' => + { withObject* `set' + , withObject* `key' + } -> `Bool' checkBoolReturn* #} -- | Add /key/ to a 'Set'. Also works with 'FrozenSet' (like -- 'CPython.Types.Tuple.setItem' it can be used to fill-in the values of @@ -125,10 +125,10 @@ -- c2hs won't accept functions named "add" any more, so have it generate -- c_add and then wrap that manually. {# fun PySet_Add as c_add - `(AnySet set, Object key)' => - { withObject* `set' - , withObject* `key' - } -> `()' checkStatusCode* #} + `(AnySet set, Object key)' => + { withObject* `set' + , withObject* `key' + } -> `()' checkStatusCode* #} -- | Return 'True' if found and removed, 'False' if not found (no action -- taken). Does not throw @KeyError@ for missing keys. Throws a @TypeError@ @@ -136,18 +136,18 @@ -- computation does not automatically convert unhashable sets into temporary -- 'FrozenSet's. {# fun PySet_Discard as discard - `Object key' => - { withObject* `Set' - , withObject* `key' - } -> `Bool' checkBoolReturn* #} + `Object key' => + { withObject* `Set' + , withObject* `key' + } -> `Bool' checkBoolReturn* #} -- | Return an arbitrary object in the set, and removes the object from the -- set. Throws @KeyError@ if the set is empty. {# fun PySet_Pop as pop - { withObject* `Set' - } -> `SomeObject' stealObject* #} + { withObject* `Set' + } -> `SomeObject' stealObject* #} -- | Remove all elements from a set. {# fun PySet_Clear as clear - { withObject* `Set' - } -> `()' checkStatusCode* #} + { withObject* `Set' + } -> `()' checkStatusCode* #} diff --git a/lib/CPython/Types/Slice.chs b/lib/CPython/Types/Slice.chs --- a/lib/CPython/Types/Slice.chs +++ b/lib/CPython/Types/Slice.chs @@ -16,11 +16,11 @@ -- along with this program. If not, see . module CPython.Types.Slice - ( Slice - , sliceType - , new - , getIndices - ) where + ( Slice + , sliceType + , new + , getIndices + ) where #include @@ -31,14 +31,14 @@ newtype Slice = Slice (ForeignPtr Slice) instance Object Slice where - toObject (Slice x) = SomeObject x - fromForeignPtr = Slice + toObject (Slice x) = SomeObject x + fromForeignPtr = Slice instance Concrete Slice where - concreteType _ = sliceType + concreteType _ = sliceType {# fun pure unsafe hscpython_PySlice_Type as sliceType - {} -> `Type' peekStaticObject* #} + {} -> `Type' peekStaticObject* #} -- | Return a new slice object with the given values. The /start/, /stop/, -- and /step/ parameters are used as the values of the slice object @@ -46,11 +46,11 @@ -- case @None@ will be used for the corresponding attribute. new :: (Object start, Object stop, Object step) => Maybe start -> Maybe stop -> Maybe step -> IO Slice new start stop step = - maybeWith withObject start $ \startPtr -> - maybeWith withObject stop $ \stopPtr -> - maybeWith withObject step $ \stepPtr -> - {# call PySlice_New as ^ #} startPtr stopPtr stepPtr - >>= stealObject + maybeWith withObject start $ \startPtr -> + maybeWith withObject stop $ \stopPtr -> + maybeWith withObject step $ \stepPtr -> + {# call PySlice_New as ^ #} startPtr stopPtr stepPtr + >>= stealObject -- | Retrieve the start, stop, step, and slice length from a 'Slice', -- assuming a sequence of the given length. @@ -58,17 +58,17 @@ -> Integer -- ^ Sequence length -> IO (Integer, Integer, Integer, Integer) getIndices slice length = - withObject slice $ \slicePtr -> - let length' = fromIntegral length in - alloca $ \startPtr -> - alloca $ \stopPtr -> - alloca $ \stepPtr -> - alloca $ \sliceLenPtr -> do - {# call PySlice_GetIndicesEx as ^ #} - slicePtr length' startPtr stopPtr stepPtr sliceLenPtr - >>= checkStatusCode - start <- fmap toInteger $ peek startPtr - stop <- fmap toInteger $ peek stopPtr - step <- fmap toInteger $ peek stepPtr - sliceLen <- fmap toInteger $ peek sliceLenPtr - return (start, stop, step, sliceLen) + withObject slice $ \slicePtr -> + let length' = fromIntegral length in + alloca $ \startPtr -> + alloca $ \stopPtr -> + alloca $ \stepPtr -> + alloca $ \sliceLenPtr -> do + {# call PySlice_GetIndicesEx as ^ #} + slicePtr length' startPtr stopPtr stepPtr sliceLenPtr + >>= checkStatusCode + start <- fmap toInteger $ peek startPtr + stop <- fmap toInteger $ peek stopPtr + step <- fmap toInteger $ peek stepPtr + sliceLen <- fmap toInteger $ peek sliceLenPtr + return (start, stop, step, sliceLen) diff --git a/lib/CPython/Types/Tuple.chs b/lib/CPython/Types/Tuple.chs --- a/lib/CPython/Types/Tuple.chs +++ b/lib/CPython/Types/Tuple.chs @@ -16,16 +16,16 @@ -- along with this program. If not, see . module CPython.Types.Tuple - ( Tuple - , tupleType - , toTuple - , iterableToTuple - , fromTuple - , length - , getItem - , getSlice - , setItem - ) where + ( Tuple + , tupleType + , toTuple + , iterableToTuple + , fromTuple + , length + , getItem + , getSlice + , setItem + ) where #include @@ -34,56 +34,56 @@ import CPython.Internal hiding (new) instance Concrete Tuple where - concreteType _ = tupleType + concreteType _ = tupleType {# fun pure unsafe hscpython_PyTuple_Type as tupleType - {} -> `Type' peekStaticObject* #} + {} -> `Type' peekStaticObject* #} toTuple :: [SomeObject] -> IO Tuple toTuple xs = - mapWith withObject xs $ \ptrs -> - withArrayLen ptrs $ \count array -> - {# call hscpython_poke_tuple #} (fromIntegral count) array - >>= stealObject + mapWith withObject xs $ \ptrs -> + withArrayLen ptrs $ \count array -> + {# call hscpython_poke_tuple #} (fromIntegral count) array + >>= stealObject -- | Convert any object implementing the iterator protocol to a 'Tuple'. iterableToTuple :: Object iter => iter -> IO Tuple iterableToTuple iter = do - raw <- callObjectRaw tupleType =<< toTuple [toObject iter] - return $ unsafeCast raw + raw <- callObjectRaw tupleType =<< toTuple [toObject iter] + return $ unsafeCast raw fromTuple :: Tuple -> IO [SomeObject] fromTuple py = - withObject py $ \pyPtr -> - ({# call PyTuple_Size as ^ #} pyPtr >>=) $ \size -> - let size' = fromIntegral size :: Int in - withArray (replicate size' nullPtr) $ \ptrs -> - {# call hscpython_peek_tuple #} pyPtr size ptrs >> - peekArray size' ptrs >>= mapM peekObject + withObject py $ \pyPtr -> + ({# call PyTuple_Size as ^ #} pyPtr >>=) $ \size -> + let size' = fromIntegral size :: Int in + withArray (replicate size' nullPtr) $ \ptrs -> + {# call hscpython_peek_tuple #} pyPtr size ptrs >> + peekArray size' ptrs >>= mapM peekObject {# fun PyTuple_Size as length - { withObject* `Tuple' - } -> `Integer' checkIntReturn* #} + { withObject* `Tuple' + } -> `Integer' checkIntReturn* #} -- | Return the object at a given index from a tuple, or throws @IndexError@ -- if the index is out of bounds. {# fun PyTuple_GetItem as getItem - { withObject* `Tuple' - , fromIntegral `Integer' - } -> `SomeObject' peekObject* #} + { withObject* `Tuple' + , fromIntegral `Integer' + } -> `SomeObject' peekObject* #} -- | Take a slice of a tuple from /low/ to /high/, and return it as a new -- tuple. {# fun PyTuple_GetSlice as getSlice - { withObject* `Tuple' - , fromIntegral `Integer' - , fromIntegral `Integer' - } -> `Tuple' stealObject* #} + { withObject* `Tuple' + , fromIntegral `Integer' + , fromIntegral `Integer' + } -> `Tuple' stealObject* #} setItem :: Object o => Tuple -> Integer -> o -> IO () setItem self index x = - withObject self $ \selfPtr -> - withObject x $ \xPtr -> do - incref xPtr - {# call PyTuple_SetItem as ^ #} selfPtr (fromIntegral index) xPtr - >>= checkStatusCode + withObject self $ \selfPtr -> + withObject x $ \xPtr -> do + incref xPtr + {# call PyTuple_SetItem as ^ #} selfPtr (fromIntegral index) xPtr + >>= checkStatusCode diff --git a/lib/CPython/Types/Type.chs b/lib/CPython/Types/Type.chs --- a/lib/CPython/Types/Type.chs +++ b/lib/CPython/Types/Type.chs @@ -16,24 +16,24 @@ -- along with this program. If not, see . module CPython.Types.Type - ( Type - , typeType - , isSubtype - ) where + ( Type + , typeType + , isSubtype + ) where #include import CPython.Internal instance Concrete Type where - concreteType _ = typeType + concreteType _ = typeType {# fun pure unsafe hscpython_PyType_Type as typeType - {} -> `Type' peekStaticObject* #} + {} -> `Type' peekStaticObject* #} -- | Returns 'True' if the first parameter is a subtype of the second -- parameter. {# fun PyType_IsSubtype as isSubtype - { withObject* `Type' - , withObject* `Type' - } -> `Bool' #} + { withObject* `Type' + , withObject* `Type' + } -> `Bool' #} diff --git a/lib/CPython/Types/Unicode.chs b/lib/CPython/Types/Unicode.chs --- a/lib/CPython/Types/Unicode.chs +++ b/lib/CPython/Types/Unicode.chs @@ -16,35 +16,35 @@ -- along with this program. If not, see . module CPython.Types.Unicode - ( - -- * Unicode objects - Unicode - , Encoding - , ErrorHandling (..) - , unicodeType - , toUnicode - , fromUnicode - , length - , fromEncodedObject - , fromObject - , encode - , decode - - -- * Methods and slot functions - , append - , split - , splitLines - , translate - , join - , MatchDirection (..) - , tailMatch - , FindDirection (..) - , find - , count - , replace - , format - , contains - ) where + ( + -- * Unicode objects + Unicode + , Encoding + , ErrorHandling (..) + , unicodeType + , toUnicode + , fromUnicode + , length + , fromEncodedObject + , fromObject + , encode + , decode + + -- * Methods and slot functions + , append + , split + , splitLines + , translate + , join + , MatchDirection (..) + , tailMatch + , FindDirection (..) + , find + , count + , replace + , format + , contains + ) where #include @@ -64,55 +64,55 @@ newtype Unicode = Unicode (ForeignPtr Unicode) instance Object Unicode where - toObject (Unicode x) = SomeObject x - fromForeignPtr = Unicode + toObject (Unicode x) = SomeObject x + fromForeignPtr = Unicode instance Concrete Unicode where - concreteType _ = unicodeType + concreteType _ = unicodeType type Encoding = T.Text data ErrorHandling - = Strict - | Replace - | Ignore - deriving (Show, Eq) + = Strict + | Replace + | Ignore + deriving (Show, Eq) withErrors :: ErrorHandling -> (CString -> IO a) -> IO a withErrors errors = withCString $ case errors of - Strict -> "strict" - Replace -> "replace" - Ignore -> "ignore" + Strict -> "strict" + Replace -> "replace" + Ignore -> "ignore" {# fun pure unsafe hscpython_PyUnicode_Type as unicodeType - {} -> `Type' peekStaticObject* #} + {} -> `Type' peekStaticObject* #} toUnicode :: T.Text -> IO Unicode toUnicode str = withBuffer toPython >>= stealObject where - toPython ptr len = let - len' = fromIntegral len - ptr' = castPtr ptr - in {# call hscpython_PyUnicode_FromUnicode #} ptr' len' + toPython ptr len = let + len' = fromIntegral len + ptr' = castPtr ptr + in {# call hscpython_PyUnicode_FromUnicode #} ptr' len' #ifdef Py_UNICODE_WIDE - ords = map (fromIntegral . ord) (T.unpack str) :: [CUInt] - withBuffer = withArrayLen ords . flip + ords = map (fromIntegral . ord) (T.unpack str) :: [CUInt] + withBuffer = withArrayLen ords . flip #else - withBuffer = TF.useAsPtr str + withBuffer = TF.useAsPtr str #endif fromUnicode :: Unicode -> IO T.Text fromUnicode obj = withObject obj $ \ptr -> do - buffer <- {# call hscpython_PyUnicode_AsUnicode #} ptr - size <- {# call hscpython_PyUnicode_GetSize #} ptr + buffer <- {# call hscpython_PyUnicode_AsUnicode #} ptr + size <- {# call hscpython_PyUnicode_GetSize #} ptr #ifdef Py_UNICODE_WIDE - raw <- peekArray (fromIntegral size) buffer - return . T.pack $ map (chr . fromIntegral) raw + raw <- peekArray (fromIntegral size) buffer + return . T.pack $ map (chr . fromIntegral) raw #else - TF.fromPtr (castPtr buffer) (fromIntegral size) + TF.fromPtr (castPtr buffer) (fromIntegral size) #endif {# fun hscpython_PyUnicode_GetSize as length - { withObject* `Unicode' - } -> `Integer' checkIntReturn* #} + { withObject* `Unicode' + } -> `Integer' checkIntReturn* #} -- | Coerce an encoded object /obj/ to an Unicode object. -- @@ -122,11 +122,11 @@ -- All other objects, including 'Unicode' objects, cause a @TypeError@ to be -- thrown. {# fun hscpython_PyUnicode_FromEncodedObject as fromEncodedObject - `Object obj' => - { withObject* `obj' - , withText* `Encoding' - , withErrors* `ErrorHandling' - } -> `Unicode' stealObject* #} + `Object obj' => + { withObject* `obj' + , withText* `Encoding' + , withErrors* `ErrorHandling' + } -> `Unicode' stealObject* #} -- | Shortcut for @'fromEncodedObject' \"utf-8\" 'Strict'@ fromObject :: Object obj => obj -> IO Unicode @@ -137,10 +137,10 @@ -- the the @str.encode()@ method. The codec to be used is looked up using -- the Python codec registry. {# fun hscpython_PyUnicode_AsEncodedString as encode - { withObject* `Unicode' - , withText* `Encoding' - , withErrors* `ErrorHandling' - } -> `Bytes' stealObject* #} + { withObject* `Unicode' + , withText* `Encoding' + , withErrors* `ErrorHandling' + } -> `Bytes' stealObject* #} -- | Create a 'Unicode' object by decoding a 'Bytes' object. The encoding and -- error mode have the same meaning as the parameters of the the @@ -148,47 +148,47 @@ -- codec registry. decode :: Bytes -> Encoding -> ErrorHandling -> IO Unicode decode bytes enc errors = - withObject bytes $ \bytesPtr -> - withText enc $ \encPtr -> - withErrors errors $ \errorsPtr -> - alloca $ \bufferPtr -> - alloca $ \lenPtr -> do - {# call PyBytes_AsStringAndSize as ^ #} bytesPtr bufferPtr lenPtr - >>= checkStatusCode - buffer <- peek bufferPtr - len <- peek lenPtr - {# call hscpython_PyUnicode_Decode #} buffer len encPtr errorsPtr - >>= stealObject + withObject bytes $ \bytesPtr -> + withText enc $ \encPtr -> + withErrors errors $ \errorsPtr -> + alloca $ \bufferPtr -> + alloca $ \lenPtr -> do + {# call PyBytes_AsStringAndSize as ^ #} bytesPtr bufferPtr lenPtr + >>= checkStatusCode + buffer <- peek bufferPtr + len <- peek lenPtr + {# call hscpython_PyUnicode_Decode #} buffer len encPtr errorsPtr + >>= stealObject {# fun hscpython_PyUnicode_Concat as append - { withObject* `Unicode' - , withObject* `Unicode' - } -> `Unicode' stealObject* #} + { withObject* `Unicode' + , withObject* `Unicode' + } -> `Unicode' stealObject* #} -- | Split a string giving a 'List' of 'Unicode' objects. If the separator is -- 'Nothing', splitting will be done at all whitespace substrings. Otherwise, -- splits occur at the given separator. Separators are not included in the -- resulting list. split - :: Unicode - -> Maybe Unicode -- ^ Separator - -> Maybe Integer -- ^ Maximum splits - -> IO List + :: Unicode + -> Maybe Unicode -- ^ Separator + -> Maybe Integer -- ^ Maximum splits + -> IO List split s sep maxsplit = - withObject s $ \sPtr -> - maybeWith withObject sep $ \sepPtr -> - let max' = maybe (- 1) fromInteger maxsplit in - {# call hscpython_PyUnicode_Split #} sPtr sepPtr max' - >>= stealObject + withObject s $ \sPtr -> + maybeWith withObject sep $ \sepPtr -> + let max' = maybe (- 1) fromInteger maxsplit in + {# call hscpython_PyUnicode_Split #} sPtr sepPtr max' + >>= stealObject -- | Split a 'Unicode' string at line breaks, returning a list of 'Unicode' -- strings. CRLF is considered to be one line break. If the second parameter -- is 'False', the line break characters are not included in the resulting -- strings. {# fun hscpython_PyUnicode_Splitlines as splitLines - { withObject* `Unicode' - , `Bool' - } -> `List' stealObject* #} + { withObject* `Unicode' + , `Bool' + } -> `List' stealObject* #} -- | Translate a string by applying a character mapping table to it. -- @@ -201,116 +201,114 @@ -- -- The error mode has the usual meaning for codecs. {# fun hscpython_PyUnicode_Translate as translate - `Object table' => - { withObject* `Unicode' - , withObject* `table' - , withErrors* `ErrorHandling' - } -> `Unicode' stealObject* #} + `Object table' => + { withObject* `Unicode' + , withObject* `table' + , withErrors* `ErrorHandling' + } -> `Unicode' stealObject* #} -- | Join a sequence of strings using the given separator. {# fun hscpython_PyUnicode_Join as join - `Sequence seq' => - { withObject* `Unicode' - , withObject* `seq' - } -> `Unicode' stealObject* #} + `Sequence seq' => + { withObject* `Unicode' + , withObject* `seq' + } -> `Unicode' stealObject* #} data MatchDirection = Prefix | Suffix - deriving (Show, Eq) + deriving (Show, Eq) -- | Return 'True' if the substring matches @string*[*start:end]@ at the -- given tail end (either a 'Prefix' or 'Suffix' match), 'False' otherwise. tailMatch - :: Unicode -- ^ String - -> Unicode -- ^ Substring - -> Integer -- ^ Start - -> Integer -- ^ End - -> MatchDirection - -> IO Bool + :: Unicode -- ^ String + -> Unicode -- ^ Substring + -> Integer -- ^ Start + -> Integer -- ^ End + -> MatchDirection + -> IO Bool tailMatch str substr start end dir = - withObject str $ \strPtr -> - withObject substr $ \substrPtr -> - let start' = fromInteger start in - let end' = fromInteger end in - let dir' = case dir of - Prefix -> -1 - Suffix -> 1 in - {# call hscpython_PyUnicode_Tailmatch #} strPtr substrPtr start' end' dir' - >>= checkBoolReturn + withObject str $ \strPtr -> + withObject substr $ \substrPtr -> + let start' = fromInteger start + end' = fromInteger end + dir' = case dir of Prefix -> -1 + Suffix -> 1 + in {# call hscpython_PyUnicode_Tailmatch #} strPtr substrPtr start' end' dir' + >>= checkBoolReturn data FindDirection = Forwards | Backwards - deriving (Show, Eq) + deriving (Show, Eq) -- | Return the first position of the substring in @string*[*start:end]@ -- using the given direction. The return value is the index of the first -- match; a value of 'Nothing' indicates that no match was found. find - :: Unicode -- ^ String - -> Unicode -- ^ Substring - -> Integer -- ^ Start - -> Integer -- ^ End - -> FindDirection - -> IO (Maybe Integer) + :: Unicode -- ^ String + -> Unicode -- ^ Substring + -> Integer -- ^ Start + -> Integer -- ^ End + -> FindDirection + -> IO (Maybe Integer) find str substr start end dir = - withObject str $ \strPtr -> - withObject substr $ \substrPtr -> do - let start' = fromInteger start - let end' = fromInteger end - let dir' = case dir of - Forwards -> 1 - Backwards -> -1 - cRes <- {# call hscpython_PyUnicode_Find #} strPtr substrPtr start' end' dir' - exceptionIf $ cRes == -2 - case cRes of - -1 -> return Nothing - x | x >= 0 -> return . Just . toInteger $ x - x -> throwIO . ErrorCall $ "Invalid return code: " ++ show x + withObject str $ \strPtr -> + withObject substr $ \substrPtr -> + let start' = fromInteger start + end' = fromInteger end + dir' = case dir of Forwards -> 1 + Backwards -> -1 + in do + cRes <- {# call hscpython_PyUnicode_Find #} strPtr substrPtr start' end' dir' + exceptionIf $ cRes == -2 + case cRes of + -1 -> return Nothing + x | x >= 0 -> return . Just . toInteger $ x + x -> throwIO . ErrorCall $ "Invalid return code: " ++ show x -- | Return the number of non-overlapping occurrences of the substring in -- @string[start:end]@. count - :: Unicode -- ^ String - -> Unicode -- ^ Substring - -> Integer -- ^ Start - -> Integer -- ^ End - -> IO Integer + :: Unicode -- ^ String + -> Unicode -- ^ Substring + -> Integer -- ^ Start + -> Integer -- ^ End + -> IO Integer count str substr start end = - withObject str $ \str' -> - withObject substr $ \substr' -> - let start' = fromInteger start in - let end' = fromInteger end in - {# call hscpython_PyUnicode_Count #} str' substr' start' end' - >>= checkIntReturn + withObject str $ \str' -> + withObject substr $ \substr' -> + let start' = fromInteger start in + let end' = fromInteger end in + {# call hscpython_PyUnicode_Count #} str' substr' start' end' + >>= checkIntReturn -- | Replace occurrences of the substring with a given replacement. If the -- maximum count is 'Nothing', replace all occurences. replace - :: Unicode -- ^ String - -> Unicode -- ^ Substring - -> Unicode -- ^ Replacement - -> Maybe Integer -- ^ Maximum count - -> IO Unicode + :: Unicode -- ^ String + -> Unicode -- ^ Substring + -> Unicode -- ^ Replacement + -> Maybe Integer -- ^ Maximum count + -> IO Unicode replace str substr replstr maxcount = - withObject str $ \strPtr -> - withObject substr $ \substrPtr -> - withObject replstr $ \replstrPtr -> - let maxcount' = case maxcount of - Nothing -> -1 - Just x -> fromInteger x in - {# call hscpython_PyUnicode_Replace #} strPtr substrPtr replstrPtr maxcount' - >>= stealObject + withObject str $ \strPtr -> + withObject substr $ \substrPtr -> + withObject replstr $ \replstrPtr -> + let maxcount' = case maxcount of Nothing -> -1 + Just x -> fromInteger x + in {# call hscpython_PyUnicode_Replace #} strPtr substrPtr replstrPtr maxcount' + >>= stealObject -- | Return a new 'Unicode' object from the given format and args; this is -- analogous to @format % args@. {# fun hscpython_PyUnicode_Format as format - { withObject* `Unicode' - , withObject* `Tuple' - } -> `Unicode' stealObject* #} + { withObject* `Unicode' + , withObject* `Tuple' + } -> `Unicode' stealObject* #} -- | Check whether /element/ is contained in a string. -- -- /element/ has to coerce to a one element string. {# fun hscpython_PyUnicode_Contains as contains - `Object element' => - { withObject* `Unicode' - , withObject* `element' - } -> `Bool' checkBoolReturn* #} + `Object element' => + { withObject* `Unicode' + , withObject* `element' + } -> `Bool' checkBoolReturn* #} diff --git a/lib/CPython/Types/WeakReference.chs b/lib/CPython/Types/WeakReference.chs --- a/lib/CPython/Types/WeakReference.chs +++ b/lib/CPython/Types/WeakReference.chs @@ -16,12 +16,12 @@ -- along with this program. If not, see . module CPython.Types.WeakReference - ( Reference - , Proxy - , newReference - , newProxy - , getObject - ) where + ( Reference + , Proxy + , newReference + , newProxy + , getObject + ) where #include @@ -29,13 +29,13 @@ newtype Reference = Reference (ForeignPtr Reference) instance Object Reference where - toObject (Reference x) = SomeObject x - fromForeignPtr = Reference + toObject (Reference x) = SomeObject x + fromForeignPtr = Reference newtype Proxy = Proxy (ForeignPtr Proxy) instance Object Proxy where - toObject (Proxy x) = SomeObject x - fromForeignPtr = Proxy + toObject (Proxy x) = SomeObject x + fromForeignPtr = Proxy -- | Return a weak reference for the object. This will always return a new -- reference, but is not guaranteed to create a new object; an existing @@ -46,10 +46,10 @@ -- /callback/ is not callable, this will throw a @TypeError@. newReference :: (Object obj, Object callback) => obj -> Maybe callback -> IO Reference newReference obj cb = - withObject obj $ \objPtr -> - maybeWith withObject cb $ \cbPtr -> - {# call PyWeakref_NewRef as ^ #} objPtr cbPtr - >>= stealObject + withObject obj $ \objPtr -> + maybeWith withObject cb $ \cbPtr -> + {# call PyWeakref_NewRef as ^ #} objPtr cbPtr + >>= stealObject -- | Return a weak reference proxy for the object. This will always return a -- new reference, but is not guaranteed to create a new object; an existing @@ -60,13 +60,13 @@ -- callable, this will throw a @TypeError@. newProxy :: (Object obj, Object callback) => obj -> Maybe callback -> IO Proxy newProxy obj cb = - withObject obj $ \objPtr -> - maybeWith withObject cb $ \cbPtr -> - {# call PyWeakref_NewProxy as ^ #} objPtr cbPtr - >>= stealObject + withObject obj $ \objPtr -> + maybeWith withObject cb $ \cbPtr -> + {# call PyWeakref_NewProxy as ^ #} objPtr cbPtr + >>= stealObject -- | Return the referenced object from a weak reference. If the referent is -- no longer live, returns @None@. {# fun PyWeakref_GetObject as getObject - { withObject* `Reference' - } -> `SomeObject' peekObject* #} + { withObject* `Reference' + } -> `SomeObject' peekObject* #} diff --git a/tests/Tests.hs b/tests/Tests.hs new file mode 100644 --- /dev/null +++ b/tests/Tests.hs @@ -0,0 +1,75 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} + +-- Copyright (C) 2012 John Millikin +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see . + +module Main + ( main ) where + +import qualified CPython as Py +import qualified CPython.Types.Module as Py +import qualified CPython.Protocols.Object as Py +import qualified CPython.Protocols.Number as Py +import qualified CPython.Types.Dictionary as PyDict +import qualified CPython.Types.List as PyList +import qualified CPython.Types.Tuple as PyTuple +import qualified CPython.Types.Unicode as PyUnicode +import qualified CPython.Types.Integer as PyInt +import qualified CPython.Types.Exception as PyExc +import Data.Text() +import Control.Monad(guard) +import Data.Maybe(fromMaybe) +import Control.Exception(handle, SomeException) + +main :: IO () +main = verboseExc $ handle pyExceptionHandler $ do + Py.initialize + testingSomePythonEvaluation + Py.finalize + where + pyExceptionHandler :: PyExc.Exception -> IO () + pyExceptionHandler exception = handle pyExceptionHandlerWithoutPythonTraceback $ do + tracebackModule <- Py.importModule "traceback" + print_exc <- PyUnicode.toUnicode "print_exception" >>= Py.getAttribute tracebackModule + kwargs <- PyDict.new + args <- case PyExc.exceptionTraceback exception of + Just tb -> PyTuple.toTuple [PyExc.exceptionType exception, PyExc.exceptionValue exception, tb] + _ -> PyTuple.toTuple [PyExc.exceptionType exception, PyExc.exceptionValue exception] + _ <- Py.call print_exc args kwargs + return () + pyExceptionHandlerWithoutPythonTraceback :: PyExc.Exception -> IO () + pyExceptionHandlerWithoutPythonTraceback exception = do + print exception + putStrLn "Unexpected Python exception (Please report a bug)" + + verboseExc ioAction = handleEverything (\exc -> print exc >> error "Unexpected error") ioAction + + handleEverything :: (SomeException -> IO a) -> IO a -> IO a + handleEverything = handle + +testingSomePythonEvaluation :: IO () +testingSomePythonEvaluation = do + testList <- traverse toObj [1, 10, 100, 42] >>= PyList.toList >>= (return . Py.toObject) + builtinsModule <- Py.importModule "builtins" + sumFunc <- PyUnicode.toUnicode "sum" >>= Py.getAttribute builtinsModule + args <- PyTuple.toTuple [testList] + kwargs <- PyDict.new + result <- Py.call sumFunc args kwargs >>= castToNumber >>= Py.toInteger >>= PyInt.fromInteger + guard $ result == 153 + where + castToNumber obj = do x <- Py.castToNumber obj + return $ fromMaybe (error "not a number returned from the sum") x + toObj integer = fmap Py.toObject $ PyInt.toInteger integer