packages feed

cpython 3.1.2.1 → 3.1.3

raw patch · 71 files changed

+4398/−4393 lines, 71 filesdep ~basedep ~bytestring

Dependency ranges changed: base, bytestring

Files

− CPython.chs 
@@ -1,370 +0,0 @@--- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>--- --- 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 <http://www.gnu.org/licenses/>.--- -{-# LANGUAGE ForeignFunctionInterface #-}-module CPython-	( initialize-	, isInitialized-	, finalize-	, newInterpreter-	, endInterpreter-	, getProgramName-	, setProgramName-	, getPrefix-	, getExecPrefix-	, getProgramFullPath-	, getPath-	, getVersion-	, getPlatform-	, getCopyright-	, getCompiler-	, getBuildInfo-	, setArgv-	, getPythonHome-	, setPythonHome-	) where-import Data.Text (Text)-import CPython.Internal--#include <hscpython-shim.h>---- | Initialize the Python interpreter. In an application embedding Python,--- this should be called before using any other Python/C API computations;--- with the exception of 'setProgramName', 'initThreads',--- 'releaseLock', and 'acquireLock'. This initializes the table--- of loaded modules (@sys.modules@), and creates the fundamental modules--- @builtins@, @__main__@ and @sys@. It also initializes the module search--- path (@sys.path@). It does not set @sys.argv@; use 'setArgv' for that. This--- is a no-op when called for a second time (without calling 'finalize'--- first). There is no return value; it is a fatal error if the initialization--- fails.--- -{# fun Py_Initialize as initialize-	{} -> `()' 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' #}---- | Undo all initializations made by 'initialize' and subsequent use of--- Python/C API computations, and destroy all sub-interpreters (see--- 'newInterpreter' below) that were created and not yet destroyed since the--- last call to 'initialize'. Ideally, this frees all memory allocated by the--- Python interpreter. This is a no-op when called for a second time (without--- calling 'initialize' again first). There is no return value; errors during--- finalization are ignored.---- This computation is provided for a number of reasons. An embedding--- application might want to restart Python without having to restart the--- application itself. An application that has loaded the Python interpreter--- from a dynamically loadable library (or DLL) might want to free all memory--- allocated by Python before unloading the DLL. During a hunt for memory--- leaks in an application a developer might want to free all memory--- allocated by Python before exiting from the application.---- /Bugs and caveats/: The destruction of modules and objects in modules is--- done in arbitrary order; this may cause destructors (@__del__()@ methods)--- to fail when they depend on other objects (even functions) or modules.--- Dynamically loaded extension modules loaded by Python are not unloaded.--- Small amounts of memory allocated by the Python interpreter may not be--- freed (if you find a leak, please report it). Memory tied up in circular--- references between objects is not freed. Some memory allocated by extension--- modules may not be freed. Some extensions may not work properly if their--- 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 #}--newtype ThreadState = ThreadState (Ptr ThreadState)---- | Create a new sub-interpreter. This is an (almost) totally separate--- environment for the execution of Python code. In particular, the new--- interpreter has separate, independent versions of all imported modules,--- including the fundamental modules @builtins@, @__main__@ and @sys@. The--- table of loaded modules (@sys.modules@) and the module search path--- (@sys.path@) are also separate. The new environment has no @sys.argv@--- variable. It has new standard I/O stream file objects @sys.stdin@,--- @sys.stdout@ and @sys.stderr@ (however these refer to the same underlying--- @FILE@ structures in the C library).--- --- The return value points to the first thread state created in the new--- sub-interpreter. This thread state is made in the current thread state.--- Note that no actual thread is created; see the discussion of thread states--- below. If creation of the new interpreter is unsuccessful, 'Nothing' is--- returned; no exception is set since the exception state is stored in the--- current thread state and there may not be a current thread state. (Like--- all other Python/C API computations, the global interpreter lock must be--- held before calling this computation and is still held when it returns;--- however, unlike most other Python/C API computations, there--- needn&#x2019;t be a current thread state on entry.)--- --- Extension modules are shared between (sub-)interpreters as follows: the--- first time a particular extension is imported, it is initialized normally,--- and a (shallow) copy of its module&#x2019;s dictionary is squirreled away.--- When the same extension is imported by another (sub-)interpreter, a new--- module is initialized and filled with the contents of this copy; the--- extension&#x2019;s @init@ procedure is not called. Note that this is--- different from what happens when an extension is imported after the--- interpreter has been completely re-initialized by calling 'finalize' and--- 'initialize'; in that case, the extension&#x2019;s @init/module/@--- procedure is called again.--- --- /Bugs and caveats/: Because sub-interpreters (and the main interpreter)--- are part of the same process, the insulation between them isn&#x2019;t--- perfect &#x2014; for example, using low-level file operations like--- @os.close()@ they can (accidentally or maliciously) affect each--- other&#x2019;s open files. Because of the way extensions are shared--- between (sub-)interpreters, some extensions may not work properly; this--- is especially likely when the extension makes use of (static) global--- variables, or when the extension manipulates its module&#x2019;s--- dictionary after its initialization. It is possible to insert objects--- created in one sub-interpreter into a namespace of another--- sub-interpreter; this should be done with great care to avoid sharing--- user-defined functions, methods, instances or classes between--- sub-interpreters, since import operations executed by such objects may--- affect the wrong (sub-)interpreter&#x2019;s dictionary of loaded modules.--- (XXX This is a hard-to-fix bug that will be addressed in a future release.)--- --- Also note that the use of this functionality is incompatible with--- extension modules such as PyObjC and ctypes that use the @PyGILState_*()@--- APIs (and this is inherent in the way the @PyGILState_*()@ procedures--- 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---- | Destroy the (sub-)interpreter represented by the given thread state.--- The given thread state must be the current thread state. See the--- discussion of thread states below. When the call returns, the current--- thread state is @NULL@. All thread states associated with this--- interpreter are destroyed. (The global interpreter lock must be held--- before calling this computation and is still held when it returns.)--- 'finalize' will destroy all sub-interpreters that haven&#x2019;t been--- explicitly destroyed at that point.--- -endInterpreter :: ThreadState -> IO ()-endInterpreter (ThreadState 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---- | 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--- the @argv[0]@ argument to the @main@ procedure of the program. This is--- used by 'getPath' and some other computations below to find the Python--- run-time libraries relative to the interpreter executable. The default--- value is @\"python\"@. No code in the Python interpreter will change the--- program name.--- -setProgramName :: Text -> IO ()-setProgramName name = withTextW name cSetProgramName--foreign import ccall safe "hscpython-shim.h hscpython_SetProgramName"-	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--- with 'setProgramName' and some environment variables; for example, if the--- program name is @\"\/usr\/local\/bin\/python\"@, the prefix is--- @\"\/usr\/local\"@. This corresponds to the @prefix@ variable in the--- top-level Makefile and the /--prefix/ argument to the @configure@ script--- at build time. The value is available to Python code as @sys.prefix@. It--- is only useful on UNIX. See also 'getExecPrefix'.--- -getPrefix :: IO Text-getPrefix = pyGetPrefix >>= peekTextW--foreign import ccall safe "hscpython-shim.h Py_GetPrefix"-	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--- set with setProgramName' and some environment variables; for example, if--- the program name is @\"\/usr\/local\/bin\/python\"@, the exec-prefix is--- @\"\/usr\/local\"@. This corresponds to the @exec_prefix@ variable in the--- top-level Makefile and the /--exec-prefix/ argument to the @configure@--- script at build time. The value is available to Python code as--- @sys.exec_prefix@. It is only useful on UNIX.--- --- Background: The exec-prefix differs from the prefix when platform--- dependent files (such as executables and shared libraries) are installed--- in a different directory tree. In a typical installation, platform--- dependent files may be installed in the @\/usr\/local\/plat@ subtree while--- platform independent may be installed in @\/usr\/local@.--- --- Generally speaking, a platform is a combination of hardware and software--- families, e.g. Sparc machines running the Solaris 2.x operating system--- are considered the same platform, but Intel machines running Solaris--- 2.x are another platform, and Intel machines running Linux are yet--- another platform. Different major revisions of the same operating system--- generally also form different platforms. Non-UNIX operating systems are a--- different story; the installation strategies on those systems are so--- different that the prefix and exec-prefix are meaningless, and set to the--- empty string. Note that compiled Python bytecode files are platform--- independent (but not independent from the Python version by which they--- were compiled!).--- --- System administrators will know how to configure the @mount@ or @automount@--- programs to share @\/usr\/local@ between platforms while having--- @\/usr\/local\/plat@ be a different filesystem for each platform.--- -getExecPrefix :: IO Text-getExecPrefix = pyGetExecPrefix >>= peekTextW--foreign import ccall safe "hscpython-shim.h Py_GetExecPrefix"-	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--- program name (set by 'setProgramName' above). The value is available to--- Python code as @sys.executable@.--- -getProgramFullPath :: IO Text-getProgramFullPath = pyGetProgramFullPath >>= peekTextW--foreign import ccall safe "hscpython-shim.h Py_GetProgramFullPath"-	pyGetProgramFullPath :: IO CWString---- | Return the default module search path; this is computed from the--- program name (set by 'setProgramName' above) and some environment--- variables. The returned string consists of a series of directory names--- separated by a platform dependent delimiter character. The delimiter--- character is @\':\'@ on Unix and Mac OS X, @\';\'@ on Windows. The value--- is available to Python code as the list @sys.path@, which may be modified--- to change the future search path for loaded modules.--- -getPath :: IO Text-getPath = pyGetPath >>= peekTextW--foreign import ccall safe "hscpython-shim.h Py_GetPath"-	pyGetPath :: IO CWString---- | Return the version of this Python interpreter. This is a string that--- looks something like--- --- @---  \"3.0a5+ (py3k:63103M, May 12 2008, 00:53:55) \\n[GCC 4.2.3]\"--- @--- --- The first word (up to the first space character) is the current Python--- version; the first three characters are the major and minor version--- separated by a period. The value is available to Python code as--- @sys.version@.--- -{# fun Py_GetVersion as getVersion-	{} -> `Text' peekText* #}---- | Return the platform identifier for the current platform. On Unix, this--- is formed from the &#x201c;official&#x201d; name of the operating system,--- converted to lower case, followed by the major revision number; e.g., for--- Solaris 2.x, which is also known as SunOS 5.x, the value is @\"sunos5\"@.--- 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* #}---- | Return the official copyright string for the current Python version,--- for example--- --- @---  \"Copyright 1991-1995 Stichting Mathematisch Centrum, Amsterdam\"--- @--- --- The value is available to Python code as @sys.copyright@.--- -{# fun Py_GetCopyright as getCopyright-	{} -> `Text' peekText* #}---- | Return an indication of the compiler used to build the current Python--- version, in square brackets, for example:--- --- @---  \"[GCC 2.7.2.2]\"--- @--- --- The value is available to Python code as part of the variable--- @sys.version@.--- -{# fun Py_GetCompiler as getCompiler-	{} -> `Text' peekText* #}---- | Return information about the sequence number and build date and time of--- the current Python interpreter instance, for example--- --- @---  \"#67, Aug  1 1997, 22:34:28\"--- @--- --- The value is available to Python code as part of the variable--- @sys.version@.--- -{# fun Py_GetBuildInfo as getBuildInfo-	{} -> `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--- file to be executed rather than the executable hosting the Python--- interpreter. If there isn&#x2019;t a script that will be run, the first--- parameter can be an empty string. If this function fails to initialize--- @sys.argv@, a fatal condition is signalled using @Py_FatalError()@.--- --- This function also prepends the executed script&#x2019;s path to--- @sys.path@. If no script is executed (in the case of calling @python -c@--- 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--foreign import ccall safe "hscpython-shim.h PySys_SetArgv"-	pySetArgv :: CInt -> Ptr CWString -> IO ()---- | Return the default &#x201c;home&#x201d;, that is, the value set by a--- previous call to 'setPythonHome', or the value of the @PYTHONHOME@--- environment variable if it is set.--- -getPythonHome :: IO Text-getPythonHome = pyGetPythonHome >>= peekTextW--foreign import ccall safe "hscpython-shim.h Py_GetPythonHome"-	pyGetPythonHome :: IO CWString---- | Set the default &#x201c;home&#x201d; directory, that is, the location--- of the standard Python libraries. The libraries are searched in--- @/home/\/lib\//python version/@ and @/home/\/lib\//python version/@. No--- code in the Python interpreter will change the Python home.--- -setPythonHome :: Text -> IO ()-setPythonHome name = withTextW name cSetPythonHome--foreign import ccall safe "hscpython-shim.h hscpython_SetPythonHome"-	cSetPythonHome :: CWString -> IO ()
− CPython/Constants.chs 
@@ -1,60 +0,0 @@--- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>--- --- 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 <http://www.gnu.org/licenses/>.--- -{-# LANGUAGE ForeignFunctionInterface #-}-module CPython.Constants-	( none-	, true-	, false-	, isNone-	, isTrue-	, isFalse-	) where-import CPython.Internal--#include <hscpython-shim.h>---- | The Python @None@ object, denoting lack of value.--- -{# fun hscpython_Py_None as none-	{} -> `SomeObject' peekObject* #}---- | The Python @True@ object.--- -{# fun hscpython_Py_True as true-	{} -> `SomeObject' peekObject* #}---- | The Python @False@ object.--- -{# fun hscpython_Py_False as false-	{} -> `SomeObject' peekObject* #}--{# fun pure hscpython_Py_None as rawNone-	{} -> `Ptr ()' id #}--{# fun pure hscpython_Py_True as rawTrue-	{} -> `Ptr ()' id #}--{# fun pure hscpython_Py_False as rawFalse-	{} -> `Ptr ()' id #}--isNone :: SomeObject -> IO Bool-isNone obj = withObject obj $ \ptr -> return $ ptr == rawNone--isTrue :: SomeObject -> IO Bool-isTrue obj = withObject obj $ \ptr -> return $ ptr == rawTrue--isFalse :: SomeObject -> IO Bool-isFalse obj = withObject obj $ \ptr -> return $ ptr == rawFalse
− CPython/Internal.chs 
@@ -1,268 +0,0 @@--- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>--- --- 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 <http://www.gnu.org/licenses/>.--- -{-# LANGUAGE ForeignFunctionInterface #-}-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE DeriveDataTypeable #-}-module CPython.Internal-	(-	-- * FFI support-	  module Foreign-	, module Foreign.C-	, cToBool-	, cFromBool-	, peekText-	, peekTextW-	, withText-	, withTextW-	, mapWith-	-	-- * 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-import Control.Applicative ((<$>))-import qualified Control.Exception as E-import qualified Data.Text as T-import Data.Typeable (Typeable)-import Foreign-import Foreign.C--#include <hscpython-shim.h>--cToBool :: CInt -> Bool-cToBool = (/= 0)--cFromBool :: Bool -> CInt-cFromBool x = if x then 1 else 0--peekText :: CString -> IO T.Text-peekText = fmap T.pack . peekCString--peekTextW :: CWString -> IO T.Text-peekTextW = fmap T.pack . peekCWString--withText :: T.Text -> (CString -> IO a) -> IO a-withText = withCString . T.unpack--withTextW :: T.Text -> (CWString -> IO a) -> IO a-withTextW = withCWString . T.unpack--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--data SomeObject = forall a. (Object a) => SomeObject (ForeignPtr a)--class Object a where-	toObject :: a -> SomeObject-	fromForeignPtr :: ForeignPtr a -> a--class Object a => Concrete a where-	concreteType :: a -> Type--instance Object SomeObject where-	toObject = id-	fromForeignPtr = SomeObject--newtype Type = Type (ForeignPtr Type)-instance Object Type where-	toObject (Type x) = SomeObject x-	fromForeignPtr = Type--newtype Dictionary = Dictionary (ForeignPtr Dictionary)-instance Object Dictionary where-	toObject (Dictionary x) = SomeObject x-	fromForeignPtr = Dictionary--newtype List = List (ForeignPtr List)-instance Object List where-	toObject (List x) = SomeObject x-	fromForeignPtr = List--newtype Tuple = Tuple (ForeignPtr Tuple)-instance Object Tuple where-	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)--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)--peekStaticObject :: Object obj => Ptr a -> IO obj-peekStaticObject ptr = fromForeignPtr <$> newForeignPtr_ (castPtr ptr)--unsafeStealObject :: Object obj => Ptr a -> IO obj-unsafeStealObject ptr = fromForeignPtr <$> newForeignPtr staticDecref (castPtr 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 #}--{# fun hscpython_Py_DECREF as decref-	{ castPtr `Ptr a'-	} -> `()' id #}--foreign import ccall "hscpython-shim.h &hscpython_Py_DECREF"-	staticDecref :: FunPtr (Ptr a -> IO ())--{# fun PyObject_CallObject as callObjectRaw-	`(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)--data Exception = Exception-	{ exceptionType      :: SomeObject-	, exceptionValue     :: SomeObject-	, exceptionTraceback :: Maybe SomeObject-	}-	deriving (Typeable)--instance Show Exception where-	show _ = "<CPython exception>"--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--checkStatusCode :: CInt -> IO ()-checkStatusCode = exceptionIf . (== -1)--checkBoolReturn :: CInt -> IO Bool-checkBoolReturn x = do-	exceptionIf $ x == -1-	return $ x /= 0--checkIntReturn :: Integral a => a -> IO Integer-checkIntReturn x = do-	exceptionIf $ x == -1-	return $ toInteger x--data SomeMapping = forall a. (Mapping a) => SomeMapping (ForeignPtr a)--class Object a => Mapping a where-	toMapping :: a -> SomeMapping--instance Object SomeMapping where-	toObject (SomeMapping x) = SomeObject x-	fromForeignPtr = SomeMapping--instance Mapping SomeMapping where-	toMapping = id--unsafeCastToMapping :: Object a => a -> SomeMapping-unsafeCastToMapping x = case toObject x of-	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--instance Object SomeSequence where-	toObject (SomeSequence x) = SomeObject x-	fromForeignPtr = SomeSequence--instance Sequence SomeSequence where-	toSequence = id--unsafeCastToSequence :: Object a => a -> SomeSequence-unsafeCastToSequence x = case toObject x of-	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--instance Object SomeIterator where-	toObject (SomeIterator x) = SomeObject x-	fromForeignPtr = SomeIterator--instance Iterator SomeIterator where-	toIterator = id--unsafeCastToIterator :: Object a => a -> SomeIterator-unsafeCastToIterator x = case toObject x of-	SomeObject ptr -> let-		ptr' = castForeignPtr ptr :: ForeignPtr SomeIterator-		in SomeIterator ptr'
− CPython/Protocols/Iterator.chs 
@@ -1,50 +0,0 @@--- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>--- --- 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 <http://www.gnu.org/licenses/>.--- -{-# LANGUAGE ForeignFunctionInterface #-}-module CPython.Protocols.Iterator-	( Iterator (..)-	, SomeIterator-	, castToIterator-	, next-	) where-import CPython.Internal--#include <hscpython-shim.h>---- | Attempt to convert an object to a generic 'Iterator'. If the object does--- 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---- | 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
− CPython/Protocols/Mapping.chs 
@@ -1,88 +0,0 @@--- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>--- --- 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 <http://www.gnu.org/licenses/>.--- -{-# LANGUAGE ForeignFunctionInterface #-}-module CPython.Protocols.Mapping-	( Mapping (..)-	, SomeMapping-	, castToMapping-	, getItem-	, setItem-	, deleteItem-	, size-	, hasKey-	, keys-	, values-	, items-	) where-import CPython.Internal--#include <hscpython-shim.h>--instance Mapping Dictionary where-	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--{# fun PyObject_GetItem as getItem-	`(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* #}--{# fun PyObject_DelItem as deleteItem-	`(Mapping self, Object key)' =>-	{ withObject* `self'-	, withObject* `key'-	} -> `()' checkStatusCode* #}--{# fun PyMapping_Size as size-	`Mapping self' =>-	{ withObject* `self'-	} -> `Integer' checkIntReturn* #}--{# fun PyMapping_HasKey as hasKey-	`(Mapping self, Object key)' =>-	{ withObject* `self'-	, withObject* `key'-	} -> `Bool' #}--{# fun PyMapping_Keys as keys-	`Mapping self' =>-	{ withObject* `self'-	} -> `List' stealObject* #}--{# fun PyMapping_Values as values-	`Mapping self' =>-	{ withObject* `self'-	} -> `List' stealObject* #}--{# fun PyMapping_Items as items-	`Mapping self' =>-	{ withObject* `self'-	} -> `List' stealObject* #}
− CPython/Protocols/Number.chs 
@@ -1,299 +0,0 @@--- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>--- --- 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 <http://www.gnu.org/licenses/>.--- -{-# LANGUAGE ForeignFunctionInterface #-}-{-# LANGUAGE ExistentialQuantification #-}-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-import Prelude hiding (Integer, Float, subtract, and, or, toInteger)-import qualified Prelude as Prelude-import CPython.Internal hiding (xor, shiftR, shiftL)-import CPython.Constants (none)-import CPython.Types.Complex (Complex)-import CPython.Types.Float (Float)-import CPython.Types.Integer (Integer)-import CPython.Types.Unicode (Unicode)-import CPython.Types.Set (Set, FrozenSet)--#include <hscpython-shim.h>--data SomeNumber = forall a. (Number a) => SomeNumber (ForeignPtr a)--class Object a => Number a where-	toNumber :: a -> SomeNumber--instance Object SomeNumber where-	toObject (SomeNumber x) = SomeObject x-	fromForeignPtr = SomeNumber--instance Number SomeNumber where-	toNumber = id--instance Number Integer where-	toNumber = unsafeCastToNumber--instance Number Float where-	toNumber = unsafeCastToNumber--instance Number Complex where-	toNumber = unsafeCastToNumber---- lol wut-instance Number Set where-	toNumber = unsafeCastToNumber--instance Number FrozenSet where-	toNumber = unsafeCastToNumber--unsafeCastToNumber :: Object a => a -> SomeNumber-unsafeCastToNumber x = case toObject x of-	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--{# fun PyNumber_Add as add-	`(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* #}--{# fun PyNumber_Multiply as multiply-	`(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* #}--{# fun PyNumber_TrueDivide as trueDivide-	`(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* #}--{# fun PyNumber_Divmod as divmod-	`(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--{# fun PyNumber_Negative as negative-	`Number a' =>-	{ withObject* `a'-	} -> `SomeNumber' stealObject* #}--{# fun PyNumber_Positive as positive-	`Number a' =>-	{ withObject* `a'-	} -> `SomeNumber' stealObject* #}--{# fun PyNumber_Absolute as absolute-	`Number a' =>-	{ withObject* `a'-	} -> `SomeNumber' stealObject* #}--{# fun PyNumber_Invert as invert-	`Number a' =>-	{ withObject* `a'-	} -> `SomeNumber' stealObject* #}--{# fun PyNumber_Lshift as shiftL-	`(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* #}--{# fun PyNumber_And as and-	`(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* #}--{# fun PyNumber_Or as or-	`(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* #}--{# fun PyNumber_InPlaceSubtract as inPlaceSubtract-	`(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* #}--{# fun PyNumber_InPlaceFloorDivide as inPlaceFloorDivide-	`(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* #}--{# fun PyNumber_InPlaceRemainder as inPlaceRemainder-	`(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--{# fun PyNumber_InPlaceLshift as inPlaceShiftL-	`(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* #}--{# fun PyNumber_InPlaceAnd as inPlaceAnd-	`(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* #}--{# fun PyNumber_InPlaceOr as inPlaceOr-	`(Number a, Number b)' =>-	{ withObject* `a'-	, withObject* `b'-	} -> `SomeNumber' stealObject* #}--{# fun PyNumber_Long as toInteger-	`Number a' =>-	{ withObject* `a'-	} -> `Integer' stealObject* #}--{# fun PyNumber_Float as toFloat-	`Number a' =>-	{ withObject* `a'-	} -> `Float' stealObject* #}--{# fun PyNumber_ToBase as toBase-	`Number a' =>-	{ withObject* `a'-	, fromIntegral `Prelude.Integer'-	} -> `Unicode' stealObject* #}
− CPython/Protocols/Object.chs 
@@ -1,317 +0,0 @@--- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>--- --- 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 <http://www.gnu.org/licenses/>.--- -{-# LANGUAGE ForeignFunctionInterface #-}-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-import Prelude hiding (Ordering (..), print)-import qualified Data.Text as T-import System.IO (Handle, hPutStrLn)-import CPython.Internal hiding (toBool)-import qualified CPython.Types.Bytes as B-import qualified CPython.Types.Dictionary as D-import qualified CPython.Types.Tuple as Tuple-import qualified CPython.Types.Unicode as U--#include <hscpython-shim.h>---- | Returns a 'Type' object corresponding to the object type of /self/. On--- failure, throws @SystemError@. This is equivalent to the Python expression--- @type(o)@.--- -{# fun PyObject_Type as getType-	`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.--- If /cls/ is a type object rather than a class object, 'isInstance'--- returns 'True' if /inst/ is of type /cls/. If /cls/ is a tuple, the check--- will be done against every entry in /cls/. The result will be 'True' when--- at least one of the checks returns 'True', otherwise it will be 'False'. If--- /inst/ is not a class instance and /cls/ is neither a type object, nor a--- class object, nor a tuple, /inst/ must have a @__class__@ attribute &#2014;--- the class relationship of the value of that attribute with /cls/ will be--- used to determine the result of this function.--- --- Subclass determination is done in a fairly straightforward way, but--- includes a wrinkle that implementors of extensions to the class system--- may want to be aware of. If A and B are class objects, B is a subclass of--- A if it inherits from A either directly or indirectly. If either is not a--- class object, a more general mechanism is used to determine the class--- relationship of the two objects. When testing if B is a subclass of A, if--- A is B, 'isSubclass' returns 'True'. If A and B are different objects,--- B&#2018;s @__bases__@ attribute is searched in a depth-first fashion for--- A &#2014; 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* #}---- | Returns 'True' if the class /derived/ is identical to or derived from--- the class /cls/, otherwise returns 'False'. In case of an error, throws--- an exception. If /cls/ is a tuple, the check will be done against every--- entry in /cls/. The result will be 'True' when at least one of the checks--- returns 'True', otherwise it will be 'False'. If either /derived/ or /cls/--- 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* #}---- | 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---- | 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' #}---- | 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* #}---- | 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* #}---- | 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* #}---- | Print @repr(self)@ to a handle.--- -print :: Object self => self -> Handle -> IO ()-print obj h = repr obj >>= U.fromUnicode >>= (hPutStrLn h . T.unpack)---- | 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* #}---- \ 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* #}---- | 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* #}---- | 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* #}---- | Determine if the object /self/ is callable.--- -{# fun PyCallable_Check as callable-	`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--- the call on success, or throws an exception on failure. This is the--- 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---- | 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'---- | Call the named method of object /self/, with arguments given by the--- tuple and named arguments given by the dictionary. Returns the result of--- the call on success, or throws an exception on failure. This is the--- 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---- | 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--- on failure. This is the equivalent of the Python expression--- @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'--data Comparison = LT | LE | EQ | NE | GT | GE-	deriving (Show)--{# enum HSCPythonComparisonEnum {} #}--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---- | 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* #}---- | 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* #}---- | 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* #}---- | 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* #}---- | 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* #}
− CPython/Protocols/Sequence.chs 
@@ -1,189 +0,0 @@--- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>--- --- 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 <http://www.gnu.org/licenses/>.--- -{-# LANGUAGE ForeignFunctionInterface #-}-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-import Prelude hiding (repeat, length)-import Data.Text (Text)-import CPython.Internal-import CPython.Types.ByteArray (ByteArray)-import CPython.Types.Bytes (Bytes)-import CPython.Types.Unicode (Unicode)--#include <hscpython-shim.h>--instance Sequence ByteArray where-	toSequence = unsafeCastToSequence--instance Sequence Bytes where-	toSequence = unsafeCastToSequence--instance Sequence List where-	toSequence = unsafeCastToSequence--instance Sequence Tuple where-	toSequence = unsafeCastToSequence--instance Sequence Unicode where-	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--{# fun PySequence_Size as length-	`Sequence self' =>-	{ withObject* `self'-	} -> `Integer' checkIntReturn* #}--{# fun PySequence_Concat as append-	`(Sequence a, Sequence b)' =>-	{ withObject* `a'-	, withObject* `b'-	} -> `SomeSequence' stealObject* #}--{# fun PySequence_Repeat as repeat-	`Sequence a' =>-	{ withObject* `a'-	, fromIntegral `Integer'-	} -> `a' stealObject* #}--{# fun PySequence_InPlaceConcat as inPlaceAppend-	`(Sequence a, Sequence b)' =>-	{ withObject* `a'-	, withObject* `b'-	} -> `SomeSequence' stealObject* #}--{# fun PySequence_InPlaceRepeat as inPlaceRepeat-	`Sequence a' =>-	{ withObject* `a'-	, fromIntegral `Integer'-	} -> `a' stealObject* #}--{# fun PySequence_GetItem as getItem-	`Sequence self' =>-	{ withObject* `self'-	, fromIntegral `Integer'-	} -> `SomeObject' stealObject* #}--{# fun PySequence_SetItem as setItem-	`(Sequence self, Object v)' =>-	{ withObject* `self'-	, fromIntegral `Integer'-	, withObject* `v'-	} -> `()' checkStatusCode* #}--{# fun PySequence_DelItem as deleteItem-	`Sequence self' =>-	{ withObject* `self'-	, fromIntegral `Integer'-	} -> `()' checkStatusCode* #}--{# fun PySequence_GetSlice as getSlice-	`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* #}--{# fun PySequence_DelSlice as deleteSlice-	`Sequence self' =>-	{ withObject* `self'-	, fromIntegral `Integer'-	, fromIntegral `Integer'-	} -> `()' checkStatusCode* #}--{# fun PySequence_Count as count-	`(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* #}---- | 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* #}---- | 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* #}---- | 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* #}---- | 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* #}
− CPython/Reflection.chs 
@@ -1,70 +0,0 @@--- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>--- --- 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 <http://www.gnu.org/licenses/>.--- -{-# LANGUAGE ForeignFunctionInterface #-}-module CPython.Reflection-	( getBuiltins-	, getLocals-	, getGlobals-	, getFrame-	, getFunctionName-	, getFunctionDescription-	) where-import Data.Text (Text)-import CPython.Internal--#include <hscpython-shim.h>---- | 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* #}---- | Return a 'Dictionary' of the local variables in the current execution--- frame, or 'Nothing' if no frame is currently executing.--- -getLocals :: IO (Maybe Dictionary)-getLocals = {# call PyEval_GetLocals as ^#} >>= maybePeek peekObject---- | Return a 'Dictionary' of the global variables in the current execution--- frame, or 'Nothing' if no frame is currently executing.--- -getGlobals :: IO (Maybe Dictionary)-getGlobals = {# call PyEval_GetGlobals as ^#} >>= maybePeek peekObject---- | Return the current thread state's frame, which is 'Nothing' if no frame--- is currently executing.--- -getFrame :: IO (Maybe SomeObject)-getFrame = {# call PyEval_GetFrame as ^#} >>= maybePeek peekObject---- | 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* #}---- | 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* #}
− CPython/System.chs 
@@ -1,79 +0,0 @@--- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>--- --- 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 <http://www.gnu.org/licenses/>.--- -{-# LANGUAGE ForeignFunctionInterface #-}-module CPython.System-	( getObject-	, setObject-	, deleteObject-	, resetWarnOptions-	, addWarnOption-	, setPath-	) where-import Data.Text (Text)-import CPython.Internal--#include <hscpython-shim.h>---- | Return the object /name/ from the @sys@ module, or 'Nothing' if it does--- not exist.--- -getObject :: Text -> IO (Maybe SomeObject)-getObject name =-	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---- | Delete /name/ from the @sys@ module.--- -deleteObject :: Text -> IO ()-deleteObject name =-	withText name $ \cstr ->-	{# call PySys_SetObject as ^ #} cstr nullPtr-	>>= checkStatusCode---- | Reset @sys.warnoptions@ to an empty list.--- -{# fun PySys_ResetWarnOptions as resetWarnOptions-	{} -> `()' 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 ()---- | 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--- delimiter (@\':\'@ on Unix, @\';\'@ on Windows).--- -setPath :: Text -> IO ()-setPath path = withTextW path pySysSetPath--foreign import ccall safe "hscpython-shim.h PySys_SetPath"-	pySysSetPath :: CWString -> IO ()
− CPython/Types.hs 
@@ -1,116 +0,0 @@--- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>--- --- 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 <http://www.gnu.org/licenses/>.--- -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-import CPython.Types.ByteArray-import CPython.Types.Bytes-import CPython.Types.Capsule-import CPython.Types.Cell-import CPython.Types.Code-import CPython.Types.Complex-import CPython.Types.Dictionary-import CPython.Types.Exception-import CPython.Types.Float-import CPython.Types.Function-import CPython.Types.InstanceMethod-import CPython.Types.Integer-import CPython.Types.Iterator-import CPython.Types.List-import CPython.Types.Method-import CPython.Types.Module-import CPython.Types.Set-import CPython.Types.Slice-import CPython.Types.Tuple-import CPython.Types.Type-import CPython.Types.Unicode-import CPython.Types.WeakReference
− CPython/Types/ByteArray.chs 
@@ -1,79 +0,0 @@--- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>--- --- 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 <http://www.gnu.org/licenses/>.--- -{-# LANGUAGE ForeignFunctionInterface #-}-module CPython.Types.ByteArray-	( ByteArray-	, byteArrayType-	, toByteArray-	, fromByteArray-	, fromObject-	, append-	, length-	, resize-	) where-import Prelude hiding (length)-import qualified Data.ByteString as B-import qualified Data.ByteString.Unsafe as B-import CPython.Internal--#include <hscpython-shim.h>--newtype ByteArray = ByteArray (ForeignPtr ByteArray)--instance Object ByteArray where-	toObject (ByteArray x) = SomeObject x-	fromForeignPtr = ByteArray--instance Concrete ByteArray where-	concreteType _ = byteArrayType--{# fun pure hscpython_PyByteArray_Type as byteArrayType-	{} -> `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)--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')---- | Create a new byte array from any object which implements the buffer--- protocol.--- -{# fun PyByteArray_FromObject as fromObject-	`Object self ' =>-	{ withObject* `self'-	} -> `ByteArray' stealObject* #}--{# fun PyByteArray_Concat as append-	{ withObject* `ByteArray'-	, withObject* `ByteArray'-	} -> `ByteArray' stealObject* #}--{# fun PyByteArray_Size as length-	{ withObject* `ByteArray'-	} -> `Integer' checkIntReturn* #}--{# fun PyByteArray_Resize as resize-	{ withObject* `ByteArray'-	, fromIntegral `Integer'-	} -> `()' checkStatusCode* #}
− CPython/Types/Bytes.chs 
@@ -1,84 +0,0 @@--- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>--- --- 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 <http://www.gnu.org/licenses/>.--- -{-# LANGUAGE ForeignFunctionInterface #-}-module CPython.Types.Bytes-	( Bytes-	, bytesType-	, toBytes-	, fromBytes-	, fromObject-	, length-	, append-	) where-import Prelude hiding (length)-import qualified Data.ByteString as B-import qualified Data.ByteString.Unsafe as B-import CPython.Internal--#include <hscpython-shim.h>--newtype Bytes = Bytes (ForeignPtr Bytes)--instance Object Bytes where-	toObject (Bytes x) = SomeObject x-	fromForeignPtr = Bytes--instance Concrete Bytes where-	concreteType _ = bytesType--{# fun pure hscpython_PyBytes_Type as bytesType-	{} -> `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)--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)---- | Create a new byte string from any object which implements the buffer--- protocol.--- -{# fun PyBytes_FromObject as fromObject-	`Object self ' =>-	{ withObject* `self'-	} -> `Bytes' stealObject* #}--{# fun PyBytes_Size as length-	{ 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-
− CPython/Types/Capsule.chs 
@@ -1,155 +0,0 @@--- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>--- --- 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 <http://www.gnu.org/licenses/>.--- -{-# LANGUAGE ForeignFunctionInterface #-}-module CPython.Types.Capsule-	( Capsule-	, capsuleType-	--, new-	, getPointer-	--, getDestructor-	, getContext-	, getName-	, importNamed-	, isValid-	, setPointer-	--, setDestructor-	, setContext-	--, setName-	) where-import Data.Text (Text)-import CPython.Internal hiding (new)--#include <hscpython-shim.h>---- type Destructor = Ptr () -> IO ()-newtype Capsule = Capsule (ForeignPtr Capsule)--instance Object Capsule where-	toObject (Capsule x) = SomeObject x-	fromForeignPtr = Capsule--instance Concrete Capsule where-	concreteType _ = capsuleType--{# fun pure hscpython_PyCapsule_Type as capsuleType-	{} -> `Type' peekStaticObject* #}---- new :: Ptr () -> Maybe Text -> Destructor -> IO Capsule--- new = undefined---- | Retrieve the pointer stored in the capsule. On failure, throws an--- exception.--- --- The name parameter must compare exactly to the name stored in the capsule.--- If the name stored in the capsule is 'Nothing', the name passed in must--- also be 'Nothing'. Python uses the C function strcmp() to compare capsule--- names.--- -getPointer :: Capsule -> Maybe Text -> IO (Ptr ())-getPointer py name =-	withObject py $ \pyPtr ->-	maybeWith withText name $ \namePtr ->-	{# call PyCapsule_GetPointer as ^ #} pyPtr namePtr---- getDestructor :: Capsule -> IO (Maybe Destructor)--- getDestructor = undefined---- | 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---- | 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---- | 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--- @\"module.attribute\"@. The name stored in the capsule must match this--- string exactly. If the second parameter is 'False', import the module--- without blocking (using @PyImport_ImportModuleNoBlock()@). Otherwise,--- imports the module conventionally (using @PyImport_ImportModule()@).--- --- Return the capsule&#x2019;s internal pointer on success. On failure, throw--- an exception. If the module could not be imported, and if importing in--- 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---- | 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--- matches the name parameter. (See 'getPointer' for information on how--- capsule names are compared.)--- --- In other words, if 'isValid' returns 'True', calls to any of the--- 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---- | Set the void pointer inside the capsule. The pointer may not be @NULL@.--- -{# fun PyCapsule_SetPointer as setPointer-	{ 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* #}---- setName :: Capsule -> Maybe Text -> IO ()--- setName = undefined
− CPython/Types/Cell.chs 
@@ -1,64 +0,0 @@--- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>--- --- 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 <http://www.gnu.org/licenses/>.--- -{-# LANGUAGE ForeignFunctionInterface #-}-module CPython.Types.Cell-	( Cell-	, cellType-	, new-	, get-	, set-	) where-import CPython.Internal hiding (new)--#include <hscpython-shim.h>--newtype Cell = Cell (ForeignPtr Cell)--instance Object Cell where-	toObject (Cell x) = SomeObject x-	fromForeignPtr = Cell--instance Concrete Cell where-	concreteType _ = cellType--{# fun pure hscpython_PyCell_Type as cellType-	{} -> `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---- | Return the contents of a cell.--- -get :: Cell -> IO (Maybe SomeObject)-get cell =-	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
− CPython/Types/Code.chs 
@@ -1,35 +0,0 @@--- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>--- --- 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 <http://www.gnu.org/licenses/>.--- -{-# LANGUAGE ForeignFunctionInterface #-}-module CPython.Types.Code-	( Code-	, codeType-	) where-import CPython.Internal--#include <hscpython-shim.h>--newtype Code = Code (ForeignPtr Code)--instance Object Code where-	toObject (Code x) = SomeObject x-	fromForeignPtr = Code--instance Concrete Code where-	concreteType _ = codeType--{# fun pure hscpython_PyCode_Type as codeType-	{} -> `Type' peekStaticObject* #}
− CPython/Types/Complex.chs 
@@ -1,50 +0,0 @@--- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>--- --- 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 <http://www.gnu.org/licenses/>.--- -{-# LANGUAGE ForeignFunctionInterface #-}-module CPython.Types.Complex-	( Complex-	, complexType-	, toComplex-	, fromComplex-	) where-import qualified Data.Complex as C-import CPython.Internal--#include <hscpython-shim.h>--newtype Complex = Complex (ForeignPtr Complex)--instance Object Complex where-	toObject (Complex x) = SomeObject x-	fromForeignPtr = Complex--instance Concrete Complex where-	concreteType _ = complexType--{# fun pure hscpython_PyComplex_Type as complexType-	{} -> `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--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
− CPython/Types/Dictionary.chs 
@@ -1,183 +0,0 @@--- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>--- --- 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 <http://www.gnu.org/licenses/>.--- -{-# LANGUAGE ForeignFunctionInterface #-}-module CPython.Types.Dictionary-	( Dictionary-	, dictionaryType-	, new-	, clear-	, contains-	, copy-	, getItem-	, setItem-	, deleteItem-	, items-	, keys-	, values-	, size-	, merge-	, update-	, mergeFromSeq2-	) where-import CPython.Internal hiding (new)--#include <hscpython-shim.h>--instance Concrete Dictionary where-	concreteType _ = dictionaryType--{# fun pure hscpython_PyDict_Type as dictionaryType-	{} -> `Type' peekStaticObject* #}--{# fun PyDict_New as new-	{} -> `Dictionary' stealObject* #}---- newProxy---- | Empty an existing dictionary of all key-value pairs.--- -{# fun PyDict_Clear as clear-	{ 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* #}---- | Return a new dictionary that contains the same key-value pairs as the--- old dictionary.--- -{# fun PyDict_Copy as copy-	{ 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---- getItemString---- | Inserts /value/ into a dictionary with a key of /key/. /key/ must be--- hashable; if it isn&#x2019;t, throws @TypeError@.--- -{# fun PyDict_SetItem as setItem-	`(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&#x2019;t, throws @TypeError@.--- -{# fun PyDict_DelItem as deleteItem-	`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* #}---- | 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* #}---- | 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* #}---- | Return the number of items in the dictionary. This is equivalent to--- @len(d)@.-{# fun PyDict_Size as size-	{ withObject* `Dictionary'-	} -> `Integer' checkIntReturn* #}---- next---- | Iterate over mapping object /b/ adding key-value pairs to a dictionary.--- /b/ may be a dictionary, or any object supporting 'keys' and 'getItem'.--- If the third parameter is 'True', existing pairs in will be replaced if a--- 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* #}---- | 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* #}---- | 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,--- viewed as key-value pairs. In case of duplicate keys, the last wins if--- the third parameter is 'True', otherwise the first wins. Equivalent--- Python:--- --- @--- def mergeFromSeq2(a, seq2, override):--- 	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* #}
− CPython/Types/Exception.chs 
@@ -1,25 +0,0 @@--- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>--- --- 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 <http://www.gnu.org/licenses/>.--- -{-# LANGUAGE ForeignFunctionInterface #-}-module CPython.Types.Exception-	( Exception-	, exceptionType-	, exceptionValue-	, exceptionTraceback-	) where-import CPython.Internal--#include <hscpython-shim.h>
− CPython/Types/Float.chs 
@@ -1,46 +0,0 @@--- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>--- --- 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 <http://www.gnu.org/licenses/>.--- -{-# LANGUAGE ForeignFunctionInterface #-}-module CPython.Types.Float-	( Float-	, floatType-	, toFloat-	, fromFloat-	) where-import Prelude hiding (Float)-import CPython.Internal--#include <hscpython-shim.h>--newtype Float = Float (ForeignPtr Float)--instance Object Float where-	toObject (Float x) = SomeObject x-	fromForeignPtr = Float--instance Concrete Float where-	concreteType _ = floatType--{# fun pure hscpython_PyFloat_Type as floatType-	{} -> `Type' peekStaticObject* #}--{# fun PyFloat_FromDouble as toFloat-	{ realToFrac `Double'-	} -> `Float' stealObject* #}--{# fun PyFloat_AsDouble as fromFloat-	{ withObject* `Float'-	} -> `Double' realToFrac #}
− CPython/Types/Function.chs 
@@ -1,130 +0,0 @@--- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>--- --- 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 <http://www.gnu.org/licenses/>.--- -{-# LANGUAGE ForeignFunctionInterface #-}-module CPython.Types.Function-	( Function-	, functionType-	, new-	, getCode-	, getGlobals-	, getModule-	, getDefaults-	, setDefaults-	, getClosure-	, setClosure-	, getAnnotations-	, setAnnotations-	) where-import CPython.Internal hiding (new)-import CPython.Types.Code (Code)-import qualified CPython.Constants as Const--#include <hscpython-shim.h>--newtype Function = Function (ForeignPtr Function)--instance Object Function where-	toObject (Function x) = SomeObject x-	fromForeignPtr = Function--instance Concrete Function where-	concreteType _ = functionType--{# fun pure hscpython_PyFunction_Type as functionType-	{} -> `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.--- --- 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* #}---- | Return the code object associated with a function.--- -{# fun PyFunction_GetCode as getCode-	{ withObject* `Function'-	} -> `Code' peekObject* #}---- | Return the globals dictionary associated with a function.--- -{# fun PyFunction_GetGlobals as getGlobals-	{ 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* #}--withNullableObject :: Object obj => Maybe obj -> (Ptr a -> IO b) -> IO b-withNullableObject Nothing io = do-	none <- Const.none-	withObject none io-withNullableObject (Just obj) io = withObject obj io--peekNullableObject :: Object obj => Ptr a -> IO (Maybe obj)-peekNullableObject = maybePeek peekObject---- | 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* #}---- | Set the default values for a function.--- -{# fun PyFunction_SetDefaults as setDefaults-	{ 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* #}---- | Set the closure associated with a function. The tuple should contain--- 'Cell's.--- -{# fun PyFunction_SetClosure as setClosure-	{ 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* #}---- | Set the annotations for a function object.--- -{# fun PyFunction_SetAnnotations as setAnnotations-	{ withObject* `Function'-	, withNullableObject* `Maybe Dictionary'-	} -> `()' checkStatusCode* #}
− CPython/Types/InstanceMethod.chs 
@@ -1,46 +0,0 @@--- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>--- --- 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 <http://www.gnu.org/licenses/>.--- -{-# LANGUAGE ForeignFunctionInterface #-}-module CPython.Types.InstanceMethod-	( InstanceMethod-	, instanceMethodType-	, new-	, function-	) where-import CPython.Internal hiding (new)--#include <hscpython-shim.h>--newtype InstanceMethod = InstanceMethod (ForeignPtr InstanceMethod)--instance Object InstanceMethod where-	toObject (InstanceMethod x) = SomeObject x-	fromForeignPtr = InstanceMethod--instance Concrete InstanceMethod where-	concreteType _ = instanceMethodType--{# fun pure hscpython_PyInstanceMethod_Type as instanceMethodType-	{} -> `Type' peekStaticObject* #}--{# fun PyInstanceMethod_New as new-	`Object func' =>-	{ withObject* `func'-	} -> `InstanceMethod' stealObject* #}--{# fun PyInstanceMethod_Function as function-	{ withObject* `InstanceMethod'-	} -> `SomeObject' peekObject* #}
− CPython/Types/Integer.chs 
@@ -1,63 +0,0 @@--- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>--- --- 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 <http://www.gnu.org/licenses/>.--- -{-# LANGUAGE ForeignFunctionInterface #-}-module CPython.Types.Integer-	( Integer-	, integerType-	, toInteger-	, fromInteger-	) where-import Prelude hiding (Integer, toInteger, fromInteger)-import qualified Prelude as Prelude-import qualified Data.Text as T-import CPython.Internal-import qualified CPython.Types.Unicode as U-import qualified CPython.Protocols.Object as O--#include <hscpython-shim.h>--newtype Integer = Integer (ForeignPtr Integer)--instance Object Integer where-	toObject (Integer x) = SomeObject x-	fromForeignPtr = Integer--instance Concrete Integer where-	concreteType _ = integerType--{# fun pure hscpython_PyLong_Type as integerType-	{} -> `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--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
− CPython/Types/Iterator.chs 
@@ -1,78 +0,0 @@--- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>--- --- 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 <http://www.gnu.org/licenses/>.--- -{-# LANGUAGE ForeignFunctionInterface #-}-module CPython.Types.Iterator-	( SequenceIterator-	, sequenceIteratorType-	, sequenceIteratorNew-	-	, CallableIterator-	, callableIteratorType-	, callableIteratorNew-	) where-import CPython.Internal--#include <hscpython-shim.h>--newtype SequenceIterator = SequenceIterator (ForeignPtr SequenceIterator)--instance Iterator SequenceIterator where-	toIterator = unsafeCastToIterator--instance Object SequenceIterator where-	toObject (SequenceIterator x) = SomeObject x-	fromForeignPtr = SequenceIterator--instance Concrete SequenceIterator where-	concreteType _ = sequenceIteratorType--newtype CallableIterator = CallableIterator (ForeignPtr CallableIterator)--instance Iterator CallableIterator where-	toIterator = unsafeCastToIterator--instance Object CallableIterator where-	toObject (CallableIterator x) = SomeObject x-	fromForeignPtr = CallableIterator--instance Concrete CallableIterator where-	concreteType _ = callableIteratorType--{# fun pure hscpython_PySeqIter_Type as sequenceIteratorType-	{} -> `Type' peekStaticObject* #}--{# fun pure hscpython_PyCallIter_Type as callableIteratorType-	{} -> `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* #}---- | 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* #}
− CPython/Types/List.chs 
@@ -1,160 +0,0 @@--- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>--- --- 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 <http://www.gnu.org/licenses/>.--- -{-# LANGUAGE ForeignFunctionInterface #-}-module CPython.Types.List-	( List-	, listType-	, toList-	, iterableToList-	, fromList-	, length-	, getItem-	, setItem-	, insert-	, append-	, getSlice-	, setSlice-	, sort-	, reverse-	, toTuple-	) where-import Prelude hiding (reverse, length)-import CPython.Internal hiding (new)-import qualified CPython.Types.Tuple as T--#include <hscpython-shim.h>--instance Concrete List where-	concreteType _ = listType--{# fun pure hscpython_PyList_Type as listType-	{} -> `Type' peekStaticObject* #}--toList :: [SomeObject] -> IO List-toList xs =-	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--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--{# fun PyList_Size as length-	{ 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* #}---- | 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---- | 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* #}---- | 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* #}---- | 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* #}---- | Sets the slice of a list between /low/ and /high/ to the contents of--- a replacement list. Analogous to @list[low:high] = replacement@. The--- replacement may be 'Nothing', indicating the assignment of an empty list--- (slice deletion). Negative indices, as when slicing from Python, are not--- supported.--- -setSlice-	:: 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---- | Sort the items of a list in place. This is equivalent to @list.sort()@.--- -{# fun PyList_Sort as sort-	{ 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* #}---- | Return a new 'Tuple' containing the contents of a list; equivalent to--- @tuple(list)@.--- -{# fun PyList_AsTuple as toTuple-	{ withObject* `List'-	} -> `Tuple' stealObject* #}
− CPython/Types/Method.chs 
@@ -1,52 +0,0 @@--- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>--- --- 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 <http://www.gnu.org/licenses/>.--- -{-# LANGUAGE ForeignFunctionInterface #-}-module CPython.Types.Method-	( Method-	, methodType-	, new-	, function-	, self-	) where-import CPython.Internal hiding (new)--#include <hscpython-shim.h>--newtype Method = Method (ForeignPtr Method)--instance Object Method where-	toObject (Method x) = SomeObject x-	fromForeignPtr = Method--instance Concrete Method where-	concreteType _ = methodType--{# fun pure hscpython_PyMethod_Type as methodType-	{} -> `Type' peekStaticObject* #}--{# fun PyMethod_New as new-	`(Object func, Object self)' =>-	{ withObject* `func'-	, withObject* `self'-	} -> `Method' stealObject* #}--{# fun PyMethod_Function as function-	{ withObject* `Method'-	} -> `SomeObject' peekObject* #}--{# fun PyMethod_Self as self-	{ withObject* `Method'-	} -> `SomeObject' peekObject* #}
− CPython/Types/Module.chs 
@@ -1,133 +0,0 @@--- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>--- --- 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 <http://www.gnu.org/licenses/>.--- -{-# LANGUAGE ForeignFunctionInterface #-}-module CPython.Types.Module-	( Module-	, moduleType-	, new-	, getDictionary-	, getName-	, getFilename-	, addObject-	, addIntegerConstant-	, addTextConstant-	, importModule-	, reload-	) where-import Prelude hiding (toInteger)-import Data.Text (Text)-import CPython.Internal hiding (new)-import CPython.Types.Integer (toInteger)-import CPython.Types.Unicode (toUnicode)--#include <hscpython-shim.h>--newtype Module = Module (ForeignPtr Module)--instance Object Module where-	toObject (Module x) = SomeObject x-	fromForeignPtr = Module--instance Concrete Module where-	concreteType _ = moduleType--{# fun pure hscpython_PyModule_Type as moduleType-	{} -> `Type' peekStaticObject* #}---- | Return a new module object with the @__name__@ attribute set. Only the--- module&#x2019;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* #}---- | Return the dictionary object that implements a module&#x2019;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&#x2019;s @__dict__@.--- -{# fun PyModule_GetDict as getDictionary-	{ withObject* `Module'-	} -> `Dictionary' peekObject* #}---- | Returns a module&#x2019;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---- | Returns the name of the file from which a module was loaded using the--- module&#x2019;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---- | Add an object to a module with the given name. This is a convenience--- computation which can be used from the module&#x2019;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---- | Add an integer constant to a module. This convenience computation can be--- used from the module&#x2019;s initialization computation.--- -addIntegerConstant :: Module -> Text -> Integer -> IO ()-addIntegerConstant m name value = toInteger value >>= addObject m name---- | Add a string constant to a module. This convenience computation can be--- used from the module&#x2019;s initialization computation.--- -addTextConstant :: Module -> Text -> Text -> IO ()-addTextConstant m name value = toUnicode value >>= addObject m name---- | This is a higher-level interface that calls the current &#x201c;import--- hook&#x201d; (with an explicit level of @0@, meaning absolute import). It--- invokes the @__import__()@ computation from the @__builtins__@ of the--- current globals. This means that the import is done using whatever import--- hooks are installed in the current environment.--- --- 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---- | 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* #}
− CPython/Types/Set.chs 
@@ -1,156 +0,0 @@--- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>--- --- 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 <http://www.gnu.org/licenses/>.--- -{-# LANGUAGE ForeignFunctionInterface #-}---- | Any functionality not listed below is best accessed using the either--- the 'Object' protocol (including 'callMethod', 'richCompare', 'hash',--- 'repr', 'isTrue', and 'getIter') or the 'Number' protocol (including 'and',--- '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-import CPython.Internal-import CPython.Types.Tuple (toTuple, iterableToTuple, fromTuple)--#include <hscpython-shim.h>--class Object a => AnySet a--newtype Set = Set (ForeignPtr Set)--instance Object Set where-	toObject (Set x) = SomeObject x-	fromForeignPtr = Set--instance Concrete Set where-	concreteType _ = setType--newtype FrozenSet = FrozenSet (ForeignPtr FrozenSet)--instance Object FrozenSet where-	toObject (FrozenSet x) = SomeObject x-	fromForeignPtr = FrozenSet--instance Concrete FrozenSet where-	concreteType _ = frozenSetType--instance AnySet Set-instance AnySet FrozenSet--{# fun pure hscpython_PySet_Type as setType-	{} -> `Type' peekStaticObject* #}--{# fun pure hscpython_PyFrozenSet_Type as frozenSetType-	{} -> `Type' peekStaticObject* #}--toSet :: [SomeObject] -> IO Set-toSet xs = toTuple xs >>= iterableToSet--toFrozenSet :: [SomeObject] -> IO FrozenSet-toFrozenSet xs = toTuple xs >>= iterableToFrozenSet---- | Return a new 'Set' from the contents of an iterable 'Object'. The object--- 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* #}---- | 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* #}--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* #}---- | 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* #}---- | Add /key/ to a 'Set'. Also works with 'FrozenSet' (like--- 'CPython.Types.Tuple.setItem' it can be used to fill-in the values of--- brand new 'FrozenSet's before they are exposed to other code). Throws a--- @TypeError@ if the key is unhashable. Throws a @MemoryError@ if there is--- no room to grow.--- -{# fun PySet_Add as add-	`(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@--- if /key/ is unhashable. Unlike the Python @discard()@ method, this--- computation does not automatically convert unhashable sets into temporary--- 'FrozenSet's.--- -{# fun PySet_Discard as discard-	`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* #}---- | Remove all elements from a set.--- -{# fun PySet_Clear as clear-	{ withObject* `Set'-	} -> `()' checkStatusCode* #}
− CPython/Types/Slice.chs 
@@ -1,73 +0,0 @@--- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>--- --- 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 <http://www.gnu.org/licenses/>.--- -{-# LANGUAGE ForeignFunctionInterface #-}-module CPython.Types.Slice-	( Slice-	, sliceType-	, new-	, getIndices-	) where-import Prelude hiding (length)-import CPython.Internal hiding (new)--#include <hscpython-shim.h>--newtype Slice = Slice (ForeignPtr Slice)--instance Object Slice where-	toObject (Slice x) = SomeObject x-	fromForeignPtr = Slice--instance Concrete Slice where-	concreteType _ = sliceType--{# fun pure hscpython_PySlice_Type as sliceType-	{} -> `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--- attributes of the same names. Any of the values may be 'Nothing', in which--- 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---- | Retrieve the start, stop, step, and slice length from a 'Slice',--- assuming a sequence of the given length.--- -getIndices :: Slice-           -> 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)
− CPython/Types/Tuple.chs 
@@ -1,89 +0,0 @@--- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>--- --- 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 <http://www.gnu.org/licenses/>.--- -{-# LANGUAGE ForeignFunctionInterface #-}-module CPython.Types.Tuple-	( Tuple-	, tupleType-	, toTuple-	, iterableToTuple-	, fromTuple-	, length-	, getItem-	, getSlice-	, setItem-	) where-import Prelude hiding (length)-import CPython.Internal hiding (new)--#include <hscpython-shim.h>--instance Concrete Tuple where-	concreteType _ = tupleType--{# fun pure hscpython_PyTuple_Type as tupleType-	{} -> `Type' peekStaticObject* #}--toTuple :: [SomeObject] -> IO Tuple-toTuple xs =-	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--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--{# fun PyTuple_Size as length-	{ 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* #}---- | 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* #}--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
− CPython/Types/Type.chs 
@@ -1,38 +0,0 @@--- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>--- --- 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 <http://www.gnu.org/licenses/>.--- -{-# LANGUAGE ForeignFunctionInterface #-}-module CPython.Types.Type-	( Type-	, typeType-	, isSubtype-	) where-import CPython.Internal--#include <hscpython-shim.h>--instance Concrete Type where-	concreteType _ = typeType--{# fun pure hscpython_PyType_Type as typeType-	{} -> `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' #}
− CPython/Types/Unicode.chs 
@@ -1,326 +0,0 @@--- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>--- --- 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 <http://www.gnu.org/licenses/>.--- -{-# LANGUAGE ForeignFunctionInterface #-}-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-#include <hscpython-shim.h>--import Prelude hiding (length)-import Control.Exception (ErrorCall (..), throwIO)-import qualified Data.Text as T-#ifdef Py_UNICODE_WIDE-import Data.Char (chr, ord)-#else-import qualified Data.Text.Foreign as TF-#endif-import CPython.Internal-import CPython.Types.Bytes (Bytes)--newtype Unicode = Unicode (ForeignPtr Unicode)--instance Object Unicode where-	toObject (Unicode x) = SomeObject x-	fromForeignPtr = Unicode--instance Concrete Unicode where-	concreteType _ = unicodeType--type Encoding = T.Text-data ErrorHandling-	= 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"--{# fun pure hscpython_PyUnicode_Type as unicodeType-	{} -> `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'-#ifdef Py_UNICODE_WIDE-	ords = map (fromIntegral . ord) (T.unpack str) :: [CUInt]-	withBuffer = withArrayLen ords . flip-#else-	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-#ifdef Py_UNICODE_WIDE-	raw <- peekArray (fromIntegral size) buffer-	return . T.pack $ map (chr . fromIntegral) raw-#else-	TF.fromPtr (castPtr buffer) (fromIntegral size)-#endif--{# fun hscpython_PyUnicode_GetSize as length-	{ withObject* `Unicode'-	} -> `Integer' checkIntReturn* #}---- | Coerce an encoded object /obj/ to an Unicode object.--- --- 'Bytes' and other char buffer compatible objects are decoded according to--- the given encoding and error handling mode.--- --- 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* #}---- | Shortcut for @'fromEncodedObject' \"utf-8\" 'Strict'@--- -fromObject :: Object obj => obj -> IO Unicode-fromObject obj = fromEncodedObject obj (T.pack "utf-8") Strict---- | Encode a 'Unicode' object and return the result as 'Bytes' object.--- The encoding and error mode have the same meaning as the parameters of--- 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* #}---- | Create a 'Unicode' object by decoding a 'Bytes' object. The encoding and--- error mode have the same meaning as the parameters of the the--- @str.encode()@ method. The codec to be used is looked up using the Python--- 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--{# fun hscpython_PyUnicode_Concat as append-	{ 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-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---- | 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* #}---- | Translate a string by applying a character mapping table to it.--- --- The mapping table must map Unicode ordinal integers to Unicode ordinal--- integers or @None@ (causing deletion of the character).--- --- Mapping tables need only provide the @__getitem__()@ interface;--- dictionaries and sequences work well. Unmapped character ordinals (ones--- which cause a @LookupError@) are left untouched and are copied as-is.--- --- 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* #}---- | Join a sequence of strings using the given separator.--- -{# fun hscpython_PyUnicode_Join as join-	`Sequence seq' =>-	{ withObject* `Unicode'-	, withObject* `seq'-	} -> `Unicode' stealObject* #}--data MatchDirection = Prefix | Suffix-	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-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--data FindDirection = Forwards | Backwards-	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)-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---- | 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-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---- | 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-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---- | 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* #}---- | 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* #}
− CPython/Types/WeakReference.chs 
@@ -1,73 +0,0 @@--- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>--- --- 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 <http://www.gnu.org/licenses/>.--- -{-# LANGUAGE ForeignFunctionInterface #-}-module CPython.Types.WeakReference-	( Reference-	, Proxy-	, newReference-	, newProxy-	, getObject-	) where-import CPython.Internal--#include <hscpython-shim.h>--newtype Reference = Reference (ForeignPtr Reference)-instance Object Reference where-	toObject (Reference x) = SomeObject x-	fromForeignPtr = Reference--newtype Proxy = Proxy (ForeignPtr Proxy)-instance Object Proxy where-	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--- reference object may be returned. The second parameter, /callback/, can--- be a callable object that receives notification when /obj/ is garbage--- collected; it should accept a single parameter, which will be the weak--- reference object itself. If ob is not a weakly-referencable object, or if--- /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---- | 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--- proxy may be returned. The second parameter, /callback/, can be a callable--- object that receives notification when /obj/ is garbage collected; it--- should accept a single parameter, which will be the weak reference object--- itself. If ob is not a weakly-referencable object, or if /callback/ is not--- 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---- | 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* #}
+ cbits/hscpython-shim.c view
@@ -0,0 +1,247 @@+/**+ * Copyright (C) 2009 John Millikin <jmillikin@gmail.com>+ * + * 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 <http://www.gnu.org/licenses/>.+**/++#include <hscpython-shim.h>++/* Initialization helpers */+static wchar_t *program_name = NULL;+static wchar_t *python_home = NULL;++static wchar_t *strdupw (wchar_t *s)+{+	size_t len = 0;+	wchar_t *orig = s, *new, *new0;+	if (!s) { return s; }+	+	while (*(s++)) { len++; }+	new = new0 = malloc (sizeof (wchar_t) * len);+	s = orig;+	while (*(new++) = *(s++)) {}+	return new0;+}++void hscpython_SetProgramName (wchar_t *name)+{+	free (program_name);+	program_name = strdupw (name);+}++void hscpython_SetPythonHome (wchar_t *home)+{+	free (python_home);+	python_home = strdupw (home);+}++/* Object */+void hscpython_Py_INCREF (PyObject *o)+{ Py_INCREF (o); }++void hscpython_Py_DECREF (PyObject *o)+{ Py_DECREF (o); }++int hscpython_PyObject_DelAttr(PyObject *o, PyObject *name)+{ return PyObject_DelAttr (o, name); }++int hscpython_PyObject_TypeCheck (PyObject *o, PyTypeObject *type)+{ return PyObject_TypeCheck (o, type); }++int hscpython_PyIter_Check(PyObject *o)+{ return PyIter_Check(o); }++/* Types */+PyTypeObject *hscpython_PyType_Type ()+{ return &PyType_Type; }++PyTypeObject *hscpython_PyTuple_Type ()+{ return &PyTuple_Type; }++PyTypeObject *hscpython_PyList_Type ()+{ return &PyList_Type; }++PyTypeObject *hscpython_PyDict_Type ()+{ return &PyDict_Type; }++PyTypeObject *hscpython_PyLong_Type ()+{ return &PyLong_Type; }++PyTypeObject *hscpython_PyFloat_Type ()+{ return &PyFloat_Type; }++PyTypeObject *hscpython_PyComplex_Type ()+{ return &PyComplex_Type; }++PyTypeObject *hscpython_PyUnicode_Type ()+{ return &PyUnicode_Type; }++PyTypeObject *hscpython_PyBytes_Type ()+{ return &PyBytes_Type; }++PyTypeObject *hscpython_PyByteArray_Type ()+{ return &PyByteArray_Type; }++PyTypeObject *hscpython_PyCell_Type ()+{ return &PyCell_Type; }++PyTypeObject *hscpython_PyCode_Type ()+{ return &PyCode_Type; }++PyTypeObject *hscpython_PyFunction_Type ()+{ return &PyFunction_Type; }++PyTypeObject *hscpython_PyInstanceMethod_Type ()+{ return &PyInstanceMethod_Type; }++PyTypeObject *hscpython_PyMethod_Type ()+{ return &PyMethod_Type; }++PyTypeObject *hscpython_PySet_Type ()+{ return &PySet_Type; }++PyTypeObject *hscpython_PyFrozenSet_Type ()+{ return &PyFrozenSet_Type; }++PyTypeObject *hscpython_PySeqIter_Type ()+{ return &PySeqIter_Type; }++PyTypeObject *hscpython_PyCallIter_Type ()+{ return &PyCallIter_Type; }++PyTypeObject *hscpython_PySlice_Type ()+{ return &PySlice_Type; }++PyTypeObject *hscpython_PyModule_Type ()+{ return &PyModule_Type; }++PyTypeObject *hscpython_PyCapsule_Type ()+{ return &PyCapsule_Type; }++/* Constants */+PyObject *hscpython_Py_None ()+{ return Py_None; }++PyObject *hscpython_Py_True ()+{ return Py_True; }++PyObject *hscpython_Py_False ()+{ return Py_False; }++/* Unicode */+Py_ssize_t hscpython_PyUnicode_GetSize (PyObject *o)+{ return PyUnicode_GetSize (o); }++Py_UNICODE *hscpython_PyUnicode_AsUnicode (PyObject *o)+{ return PyUnicode_AsUnicode (o); }++PyObject *hscpython_PyUnicode_FromUnicode (Py_UNICODE *u, Py_ssize_t size)+{ return PyUnicode_FromUnicode (u, size); }++PyObject *hscpython_PyUnicode_FromEncodedObject (PyObject *o, const char *enc, const char *err)+{ return PyUnicode_FromEncodedObject (o, enc, err); }++PyObject *hscpython_PyUnicode_AsEncodedString (PyObject *o, const char *enc, const char *err)+{ return PyUnicode_AsEncodedString (o, enc, err); }++PyObject *hscpython_PyUnicode_FromObject (PyObject *o)+{ return PyUnicode_FromObject (o); }++PyObject *hscpython_PyUnicode_Decode (const char *s, Py_ssize_t len, const char *enc, const char *err)+{ return PyUnicode_Decode (s, len, enc, err); }++PyObject *hscpython_PyUnicode_Concat (PyObject *l, PyObject *r)+{ return PyUnicode_Concat (l, r); }++PyObject *hscpython_PyUnicode_Split (PyObject *s, PyObject *sep, Py_ssize_t max)+{ return PyUnicode_Split (s, sep, max); }++PyObject *hscpython_PyUnicode_Splitlines (PyObject *s, int keep)+{ return PyUnicode_Splitlines (s, keep); }++PyObject *hscpython_PyUnicode_Translate (PyObject *str, PyObject *table, const char *err)+{ return PyUnicode_Translate (str, table, err); }++PyObject *hscpython_PyUnicode_Join (PyObject *sep, PyObject *seq)+{ return PyUnicode_Join (sep, seq); }++int hscpython_PyUnicode_Tailmatch (PyObject *str, PyObject *substr, Py_ssize_t start, Py_ssize_t end, int dir)+{ return PyUnicode_Tailmatch (str, substr, start, end, dir); }++Py_ssize_t hscpython_PyUnicode_Find (PyObject *str, PyObject *substr, Py_ssize_t start, Py_ssize_t end, int dir)+{ return PyUnicode_Find (str, substr, start, end, dir); }++Py_ssize_t hscpython_PyUnicode_Count (PyObject *str, PyObject *substr, Py_ssize_t start, Py_ssize_t end)+{ return PyUnicode_Count (str, substr, start, end); }++PyObject *hscpython_PyUnicode_Replace (PyObject *str, PyObject *substr, PyObject *replstr, Py_ssize_t max)+{ return PyUnicode_Replace (str, substr, replstr, max); }++PyObject *hscpython_PyUnicode_Format (PyObject *format, PyObject *args)+{ return PyUnicode_Format (format, args); }++int hscpython_PyUnicode_Contains (PyObject *a, PyObject *b)+{ return PyUnicode_Contains (a, b); }++/* Lists */+void hscpython_peek_list (PyObject *list, Py_ssize_t size, PyObject **objs)+{+	Py_ssize_t ii;+	for (ii = 0; ii < size; ii++)+	{+		objs[ii] = PyList_GET_ITEM (list, ii);+	}+}++PyObject *hscpython_poke_list (size_t count, PyObject **objs)+{+	PyObject *list;+	size_t ii;+	+	if (!(list = PyList_New (count)))+	{ return NULL; }+	+	for (ii = 0; ii < count; ii++)+	{+		Py_INCREF (objs[ii]);+		PyList_SET_ITEM (list, ii, objs[ii]);+	}+	return list;+}++/* Tuple */+void hscpython_peek_tuple (PyObject *tuple, Py_ssize_t size, PyObject **objs)+{+	Py_ssize_t ii;+	for (ii = 0; ii < size; ii++)+	{+		objs[ii] = PyTuple_GET_ITEM (tuple, ii);+	}+}++PyObject *hscpython_poke_tuple (size_t count, PyObject **objs)+{+	PyObject *tuple;+	size_t ii;+	+	if (!(tuple = PyTuple_New (count)))+	{ return NULL; }+	+	for (ii = 0; ii < count; ii++)+	{+		Py_INCREF (objs[ii]);+		PyTuple_SET_ITEM (tuple, ii, objs[ii]);+	}+	return tuple;+}
+ cbits/hscpython-shim.h view
@@ -0,0 +1,83 @@+#ifndef HSCPYTHON_SHIM_H+#define HSCPYTHON_SHIM_H++#include <Python.h>++/* Initialization helpers */+void hscpython_SetProgramName (wchar_t *);+void hscpython_SetPythonHome (wchar_t *);++/* Object */+void hscpython_Py_INCREF (PyObject *);+void hscpython_Py_DECREF (PyObject *);+int hscpython_PyObject_DelAttr(PyObject *, PyObject *);+int hscpython_PyObject_TypeCheck (PyObject *, PyTypeObject *);+int hscpython_PyIter_Check(PyObject *);++enum HSCPythonComparisonEnum+{ HSCPYTHON_LT = Py_LT+, HSCPYTHON_LE = Py_LE+, HSCPYTHON_EQ = Py_EQ+, HSCPYTHON_NE = Py_NE+, HSCPYTHON_GT = Py_GT+, HSCPYTHON_GE = Py_GE+};++/* Types */+PyTypeObject *hscpython_PyType_Type ();+PyTypeObject *hscpython_PyTuple_Type ();+PyTypeObject *hscpython_PyList_Type ();+PyTypeObject *hscpython_PyDict_Type ();+PyTypeObject *hscpython_PyLong_Type ();+PyTypeObject *hscpython_PyFloat_Type ();+PyTypeObject *hscpython_PyComplex_Type ();+PyTypeObject *hscpython_PyUnicode_Type ();+PyTypeObject *hscpython_PyBytes_Type ();+PyTypeObject *hscpython_PyByteArray_Type ();+PyTypeObject *hscpython_PyCell_Type ();+PyTypeObject *hscpython_PyCode_Type ();+PyTypeObject *hscpython_PyFunction_Type ();+PyTypeObject *hscpython_PyInstanceMethod_Type ();+PyTypeObject *hscpython_PyMethod_Type ();+PyTypeObject *hscpython_PySet_Type ();+PyTypeObject *hscpython_PyFrozenSet_Type ();+PyTypeObject *hscpython_PySeqIter_Type ();+PyTypeObject *hscpython_PyCallIter_Type ();+PyTypeObject *hscpython_PySlice_Type ();+PyTypeObject *hscpython_PyModule_Type ();+PyTypeObject *hscpython_PyCapsule_Type ();++/* Constants */+PyObject *hscpython_Py_None ();+PyObject *hscpython_Py_True ();+PyObject *hscpython_Py_False ();++/* Unicode */+Py_ssize_t hscpython_PyUnicode_GetSize (PyObject *);+Py_UNICODE *hscpython_PyUnicode_AsUnicode (PyObject *);+PyObject *hscpython_PyUnicode_FromUnicode (Py_UNICODE *, Py_ssize_t);+PyObject *hscpython_PyUnicode_FromEncodedObject (PyObject *, const char *, const char *);+PyObject *hscpython_PyUnicode_AsEncodedString (PyObject *, const char *, const char *);+PyObject *hscpython_PyUnicode_FromObject (PyObject *);+PyObject *hscpython_PyUnicode_Decode (const char *, Py_ssize_t, const char *, const char *);+PyObject *hscpython_PyUnicode_Concat (PyObject *, PyObject *);+PyObject *hscpython_PyUnicode_Split (PyObject *, PyObject *, Py_ssize_t);+PyObject *hscpython_PyUnicode_Splitlines (PyObject *, int);+PyObject *hscpython_PyUnicode_Translate (PyObject *, PyObject *, const char *);+PyObject *hscpython_PyUnicode_Join (PyObject *, PyObject *);+int hscpython_PyUnicode_Tailmatch (PyObject *, PyObject *, Py_ssize_t, Py_ssize_t, int);+Py_ssize_t hscpython_PyUnicode_Find (PyObject *, PyObject *, Py_ssize_t, Py_ssize_t, int);+Py_ssize_t hscpython_PyUnicode_Count (PyObject *, PyObject *, Py_ssize_t, Py_ssize_t);+PyObject *hscpython_PyUnicode_Replace (PyObject *, PyObject *, PyObject *, Py_ssize_t);+PyObject *hscpython_PyUnicode_Format (PyObject *, PyObject *);+int hscpython_PyUnicode_Contains (PyObject *, PyObject *);++/* Lists */+void hscpython_peek_list (PyObject *, Py_ssize_t, PyObject **);+PyObject *hscpython_poke_list (size_t, PyObject **);++/* Tuples */+void hscpython_peek_tuple (PyObject *, Py_ssize_t, PyObject **);+PyObject *hscpython_poke_tuple (size_t, PyObject **);++#endif
cpython.cabal view
@@ -1,19 +1,15 @@ name: cpython-version: 3.1.2.1-synopsis: Bindings for libpython+version: 3.1.3 license: GPL-3 license-file: license.txt-author: John Millikin-maintainer: jmillikin@gmail.com-copyright: Copyright (c) John Millikin 2009-2010,-                     (c) Python Software Foundation 2001-2009.+author: John Millikin <jmillikin@gmail.com>+maintainer: John Millikin <jmillikin@gmail.com> build-type: Simple-cabal-version: >=1.6+cabal-version: >= 1.6 category: Foreign-homepage: http://john-millikin.com/software/bindings/cpython/-tested-with: GHC==6.12.1-extra-source-files: hscpython-shim.h+homepage: https://john-millikin.com/software/haskell-python/ +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@@ -21,19 +17,28 @@   .   Please note that this library uses a somewhat abnormal versioning scheme;   the first two version numbers are the CPython version, the third is the-  package's major version, and the fourth is the package's minor version.-  For example, the package version 3.1.1.0 binds to CPython 3.1, and has-  a package version of (1, 0).+  package's version. For example, the package version 3.1.1 binds to CPython+  3.1, and has a package version of 1. +extra-source-files:+  cbits/hscpython-shim.h+ source-repository head   type: bazaar-  location: http://john-millikin.com/software/bindings/cpython/+  location: https://john-millikin.com/branches/haskell-cpython/3.1/ +source-repository this+  type: bazaar+  location: https://john-millikin.com/branches/haskell-cpython/3.1/+  tag: haskell-cpython_3.1.3+ library-  ghc-options: -Wall -fno-warn-orphans+  ghc-options: -Wall -O2+  hs-source-dirs: lib+   build-depends:-      base >=4 && < 5-    , bytestring >= 0.9 && < 0.10+      base >= 4.0 && < 5.0+    , bytestring >= 0.9     , text >= 0.1 && < 0.12    build-tools:@@ -76,7 +81,7 @@   other-modules:     CPython.Internal -  c-sources: hscpython-shim.c-  include-dirs: .+  c-sources: cbits/hscpython-shim.c+  include-dirs: cbits    pkgconfig-depends: python-3.1
− hscpython-shim.c 
@@ -1,247 +0,0 @@-/**- * Copyright (C) 2009 John Millikin <jmillikin@gmail.com>- * - * 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 <http://www.gnu.org/licenses/>.-**/--#include <hscpython-shim.h>--/* Initialization helpers */-static wchar_t *program_name = NULL;-static wchar_t *python_home = NULL;--static wchar_t *strdupw (wchar_t *s)-{-	size_t len = 0;-	wchar_t *orig = s, *new, *new0;-	if (!s) { return s; }-	-	while (*(s++)) { len++; }-	new = new0 = malloc (sizeof (wchar_t) * len);-	s = orig;-	while (*(new++) = *(s++)) {}-	return new0;-}--void hscpython_SetProgramName (wchar_t *name)-{-	free (program_name);-	program_name = strdupw (name);-}--void hscpython_SetPythonHome (wchar_t *home)-{-	free (python_home);-	python_home = strdupw (home);-}--/* Object */-void hscpython_Py_INCREF (PyObject *o)-{ Py_INCREF (o); }--void hscpython_Py_DECREF (PyObject *o)-{ Py_DECREF (o); }--int hscpython_PyObject_DelAttr(PyObject *o, PyObject *name)-{ return PyObject_DelAttr (o, name); }--int hscpython_PyObject_TypeCheck (PyObject *o, PyTypeObject *type)-{ return PyObject_TypeCheck (o, type); }--int hscpython_PyIter_Check(PyObject *o)-{ return PyIter_Check(o); }--/* Types */-PyTypeObject *hscpython_PyType_Type ()-{ return &PyType_Type; }--PyTypeObject *hscpython_PyTuple_Type ()-{ return &PyTuple_Type; }--PyTypeObject *hscpython_PyList_Type ()-{ return &PyList_Type; }--PyTypeObject *hscpython_PyDict_Type ()-{ return &PyDict_Type; }--PyTypeObject *hscpython_PyLong_Type ()-{ return &PyLong_Type; }--PyTypeObject *hscpython_PyFloat_Type ()-{ return &PyFloat_Type; }--PyTypeObject *hscpython_PyComplex_Type ()-{ return &PyComplex_Type; }--PyTypeObject *hscpython_PyUnicode_Type ()-{ return &PyUnicode_Type; }--PyTypeObject *hscpython_PyBytes_Type ()-{ return &PyBytes_Type; }--PyTypeObject *hscpython_PyByteArray_Type ()-{ return &PyByteArray_Type; }--PyTypeObject *hscpython_PyCell_Type ()-{ return &PyCell_Type; }--PyTypeObject *hscpython_PyCode_Type ()-{ return &PyCode_Type; }--PyTypeObject *hscpython_PyFunction_Type ()-{ return &PyFunction_Type; }--PyTypeObject *hscpython_PyInstanceMethod_Type ()-{ return &PyInstanceMethod_Type; }--PyTypeObject *hscpython_PyMethod_Type ()-{ return &PyMethod_Type; }--PyTypeObject *hscpython_PySet_Type ()-{ return &PySet_Type; }--PyTypeObject *hscpython_PyFrozenSet_Type ()-{ return &PyFrozenSet_Type; }--PyTypeObject *hscpython_PySeqIter_Type ()-{ return &PySeqIter_Type; }--PyTypeObject *hscpython_PyCallIter_Type ()-{ return &PyCallIter_Type; }--PyTypeObject *hscpython_PySlice_Type ()-{ return &PySlice_Type; }--PyTypeObject *hscpython_PyModule_Type ()-{ return &PyModule_Type; }--PyTypeObject *hscpython_PyCapsule_Type ()-{ return &PyCapsule_Type; }--/* Constants */-PyObject *hscpython_Py_None ()-{ return Py_None; }--PyObject *hscpython_Py_True ()-{ return Py_True; }--PyObject *hscpython_Py_False ()-{ return Py_False; }--/* Unicode */-Py_ssize_t hscpython_PyUnicode_GetSize (PyObject *o)-{ return PyUnicode_GetSize (o); }--Py_UNICODE *hscpython_PyUnicode_AsUnicode (PyObject *o)-{ return PyUnicode_AsUnicode (o); }--PyObject *hscpython_PyUnicode_FromUnicode (Py_UNICODE *u, Py_ssize_t size)-{ return PyUnicode_FromUnicode (u, size); }--PyObject *hscpython_PyUnicode_FromEncodedObject (PyObject *o, const char *enc, const char *err)-{ return PyUnicode_FromEncodedObject (o, enc, err); }--PyObject *hscpython_PyUnicode_AsEncodedString (PyObject *o, const char *enc, const char *err)-{ return PyUnicode_AsEncodedString (o, enc, err); }--PyObject *hscpython_PyUnicode_FromObject (PyObject *o)-{ return PyUnicode_FromObject (o); }--PyObject *hscpython_PyUnicode_Decode (const char *s, Py_ssize_t len, const char *enc, const char *err)-{ return PyUnicode_Decode (s, len, enc, err); }--PyObject *hscpython_PyUnicode_Concat (PyObject *l, PyObject *r)-{ return PyUnicode_Concat (l, r); }--PyObject *hscpython_PyUnicode_Split (PyObject *s, PyObject *sep, Py_ssize_t max)-{ return PyUnicode_Split (s, sep, max); }--PyObject *hscpython_PyUnicode_Splitlines (PyObject *s, int keep)-{ return PyUnicode_Splitlines (s, keep); }--PyObject *hscpython_PyUnicode_Translate (PyObject *str, PyObject *table, const char *err)-{ return PyUnicode_Translate (str, table, err); }--PyObject *hscpython_PyUnicode_Join (PyObject *sep, PyObject *seq)-{ return PyUnicode_Join (sep, seq); }--int hscpython_PyUnicode_Tailmatch (PyObject *str, PyObject *substr, Py_ssize_t start, Py_ssize_t end, int dir)-{ return PyUnicode_Tailmatch (str, substr, start, end, dir); }--Py_ssize_t hscpython_PyUnicode_Find (PyObject *str, PyObject *substr, Py_ssize_t start, Py_ssize_t end, int dir)-{ return PyUnicode_Find (str, substr, start, end, dir); }--Py_ssize_t hscpython_PyUnicode_Count (PyObject *str, PyObject *substr, Py_ssize_t start, Py_ssize_t end)-{ return PyUnicode_Count (str, substr, start, end); }--PyObject *hscpython_PyUnicode_Replace (PyObject *str, PyObject *substr, PyObject *replstr, Py_ssize_t max)-{ return PyUnicode_Replace (str, substr, replstr, max); }--PyObject *hscpython_PyUnicode_Format (PyObject *format, PyObject *args)-{ return PyUnicode_Format (format, args); }--int hscpython_PyUnicode_Contains (PyObject *a, PyObject *b)-{ return PyUnicode_Contains (a, b); }--/* Lists */-void hscpython_peek_list (PyObject *list, Py_ssize_t size, PyObject **objs)-{-	Py_ssize_t ii;-	for (ii = 0; ii < size; ii++)-	{-		objs[ii] = PyList_GET_ITEM (list, ii);-	}-}--PyObject *hscpython_poke_list (size_t count, PyObject **objs)-{-	PyObject *list;-	size_t ii;-	-	if (!(list = PyList_New (count)))-	{ return NULL; }-	-	for (ii = 0; ii < count; ii++)-	{-		Py_INCREF (objs[ii]);-		PyList_SET_ITEM (list, ii, objs[ii]);-	}-	return list;-}--/* Tuple */-void hscpython_peek_tuple (PyObject *tuple, Py_ssize_t size, PyObject **objs)-{-	Py_ssize_t ii;-	for (ii = 0; ii < size; ii++)-	{-		objs[ii] = PyTuple_GET_ITEM (tuple, ii);-	}-}--PyObject *hscpython_poke_tuple (size_t count, PyObject **objs)-{-	PyObject *tuple;-	size_t ii;-	-	if (!(tuple = PyTuple_New (count)))-	{ return NULL; }-	-	for (ii = 0; ii < count; ii++)-	{-		Py_INCREF (objs[ii]);-		PyTuple_SET_ITEM (tuple, ii, objs[ii]);-	}-	return tuple;-}
− hscpython-shim.h 
@@ -1,83 +0,0 @@-#ifndef HSCPYTHON_SHIM_H-#define HSCPYTHON_SHIM_H--#include <Python.h>--/* Initialization helpers */-void hscpython_SetProgramName (wchar_t *);-void hscpython_SetPythonHome (wchar_t *);--/* Object */-void hscpython_Py_INCREF (PyObject *);-void hscpython_Py_DECREF (PyObject *);-int hscpython_PyObject_DelAttr(PyObject *, PyObject *);-int hscpython_PyObject_TypeCheck (PyObject *, PyTypeObject *);-int hscpython_PyIter_Check(PyObject *);--enum HSCPythonComparisonEnum-{ HSCPYTHON_LT = Py_LT-, HSCPYTHON_LE = Py_LE-, HSCPYTHON_EQ = Py_EQ-, HSCPYTHON_NE = Py_NE-, HSCPYTHON_GT = Py_GT-, HSCPYTHON_GE = Py_GE-};--/* Types */-PyTypeObject *hscpython_PyType_Type ();-PyTypeObject *hscpython_PyTuple_Type ();-PyTypeObject *hscpython_PyList_Type ();-PyTypeObject *hscpython_PyDict_Type ();-PyTypeObject *hscpython_PyLong_Type ();-PyTypeObject *hscpython_PyFloat_Type ();-PyTypeObject *hscpython_PyComplex_Type ();-PyTypeObject *hscpython_PyUnicode_Type ();-PyTypeObject *hscpython_PyBytes_Type ();-PyTypeObject *hscpython_PyByteArray_Type ();-PyTypeObject *hscpython_PyCell_Type ();-PyTypeObject *hscpython_PyCode_Type ();-PyTypeObject *hscpython_PyFunction_Type ();-PyTypeObject *hscpython_PyInstanceMethod_Type ();-PyTypeObject *hscpython_PyMethod_Type ();-PyTypeObject *hscpython_PySet_Type ();-PyTypeObject *hscpython_PyFrozenSet_Type ();-PyTypeObject *hscpython_PySeqIter_Type ();-PyTypeObject *hscpython_PyCallIter_Type ();-PyTypeObject *hscpython_PySlice_Type ();-PyTypeObject *hscpython_PyModule_Type ();-PyTypeObject *hscpython_PyCapsule_Type ();--/* Constants */-PyObject *hscpython_Py_None ();-PyObject *hscpython_Py_True ();-PyObject *hscpython_Py_False ();--/* Unicode */-Py_ssize_t hscpython_PyUnicode_GetSize (PyObject *);-Py_UNICODE *hscpython_PyUnicode_AsUnicode (PyObject *);-PyObject *hscpython_PyUnicode_FromUnicode (Py_UNICODE *, Py_ssize_t);-PyObject *hscpython_PyUnicode_FromEncodedObject (PyObject *, const char *, const char *);-PyObject *hscpython_PyUnicode_AsEncodedString (PyObject *, const char *, const char *);-PyObject *hscpython_PyUnicode_FromObject (PyObject *);-PyObject *hscpython_PyUnicode_Decode (const char *, Py_ssize_t, const char *, const char *);-PyObject *hscpython_PyUnicode_Concat (PyObject *, PyObject *);-PyObject *hscpython_PyUnicode_Split (PyObject *, PyObject *, Py_ssize_t);-PyObject *hscpython_PyUnicode_Splitlines (PyObject *, int);-PyObject *hscpython_PyUnicode_Translate (PyObject *, PyObject *, const char *);-PyObject *hscpython_PyUnicode_Join (PyObject *, PyObject *);-int hscpython_PyUnicode_Tailmatch (PyObject *, PyObject *, Py_ssize_t, Py_ssize_t, int);-Py_ssize_t hscpython_PyUnicode_Find (PyObject *, PyObject *, Py_ssize_t, Py_ssize_t, int);-Py_ssize_t hscpython_PyUnicode_Count (PyObject *, PyObject *, Py_ssize_t, Py_ssize_t);-PyObject *hscpython_PyUnicode_Replace (PyObject *, PyObject *, PyObject *, Py_ssize_t);-PyObject *hscpython_PyUnicode_Format (PyObject *, PyObject *);-int hscpython_PyUnicode_Contains (PyObject *, PyObject *);--/* Lists */-void hscpython_peek_list (PyObject *, Py_ssize_t, PyObject **);-PyObject *hscpython_poke_list (size_t, PyObject **);--/* Tuples */-void hscpython_peek_tuple (PyObject *, Py_ssize_t, PyObject **);-PyObject *hscpython_poke_tuple (size_t, PyObject **);--#endif
+ lib/CPython.chs view
@@ -0,0 +1,370 @@+-- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>+-- +-- 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 <http://www.gnu.org/licenses/>.+-- +{-# LANGUAGE ForeignFunctionInterface #-}+module CPython+	( initialize+	, isInitialized+	, finalize+	, newInterpreter+	, endInterpreter+	, getProgramName+	, setProgramName+	, getPrefix+	, getExecPrefix+	, getProgramFullPath+	, getPath+	, getVersion+	, getPlatform+	, getCopyright+	, getCompiler+	, getBuildInfo+	, setArgv+	, getPythonHome+	, setPythonHome+	) where+import Data.Text (Text)+import CPython.Internal++#include <hscpython-shim.h>++-- | Initialize the Python interpreter. In an application embedding Python,+-- this should be called before using any other Python/C API computations;+-- with the exception of 'setProgramName', 'initThreads',+-- 'releaseLock', and 'acquireLock'. This initializes the table+-- of loaded modules (@sys.modules@), and creates the fundamental modules+-- @builtins@, @__main__@ and @sys@. It also initializes the module search+-- path (@sys.path@). It does not set @sys.argv@; use 'setArgv' for that. This+-- is a no-op when called for a second time (without calling 'finalize'+-- first). There is no return value; it is a fatal error if the initialization+-- fails.+-- +{# fun Py_Initialize as initialize+	{} -> `()' 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' #}++-- | Undo all initializations made by 'initialize' and subsequent use of+-- Python/C API computations, and destroy all sub-interpreters (see+-- 'newInterpreter' below) that were created and not yet destroyed since the+-- last call to 'initialize'. Ideally, this frees all memory allocated by the+-- Python interpreter. This is a no-op when called for a second time (without+-- calling 'initialize' again first). There is no return value; errors during+-- finalization are ignored.++-- This computation is provided for a number of reasons. An embedding+-- application might want to restart Python without having to restart the+-- application itself. An application that has loaded the Python interpreter+-- from a dynamically loadable library (or DLL) might want to free all memory+-- allocated by Python before unloading the DLL. During a hunt for memory+-- leaks in an application a developer might want to free all memory+-- allocated by Python before exiting from the application.++-- /Bugs and caveats/: The destruction of modules and objects in modules is+-- done in arbitrary order; this may cause destructors (@__del__()@ methods)+-- to fail when they depend on other objects (even functions) or modules.+-- Dynamically loaded extension modules loaded by Python are not unloaded.+-- Small amounts of memory allocated by the Python interpreter may not be+-- freed (if you find a leak, please report it). Memory tied up in circular+-- references between objects is not freed. Some memory allocated by extension+-- modules may not be freed. Some extensions may not work properly if their+-- 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 #}++newtype ThreadState = ThreadState (Ptr ThreadState)++-- | Create a new sub-interpreter. This is an (almost) totally separate+-- environment for the execution of Python code. In particular, the new+-- interpreter has separate, independent versions of all imported modules,+-- including the fundamental modules @builtins@, @__main__@ and @sys@. The+-- table of loaded modules (@sys.modules@) and the module search path+-- (@sys.path@) are also separate. The new environment has no @sys.argv@+-- variable. It has new standard I/O stream file objects @sys.stdin@,+-- @sys.stdout@ and @sys.stderr@ (however these refer to the same underlying+-- @FILE@ structures in the C library).+-- +-- The return value points to the first thread state created in the new+-- sub-interpreter. This thread state is made in the current thread state.+-- Note that no actual thread is created; see the discussion of thread states+-- below. If creation of the new interpreter is unsuccessful, 'Nothing' is+-- returned; no exception is set since the exception state is stored in the+-- current thread state and there may not be a current thread state. (Like+-- all other Python/C API computations, the global interpreter lock must be+-- held before calling this computation and is still held when it returns;+-- however, unlike most other Python/C API computations, there+-- needn&#x2019;t be a current thread state on entry.)+-- +-- Extension modules are shared between (sub-)interpreters as follows: the+-- first time a particular extension is imported, it is initialized normally,+-- and a (shallow) copy of its module&#x2019;s dictionary is squirreled away.+-- When the same extension is imported by another (sub-)interpreter, a new+-- module is initialized and filled with the contents of this copy; the+-- extension&#x2019;s @init@ procedure is not called. Note that this is+-- different from what happens when an extension is imported after the+-- interpreter has been completely re-initialized by calling 'finalize' and+-- 'initialize'; in that case, the extension&#x2019;s @init/module/@+-- procedure is called again.+-- +-- /Bugs and caveats/: Because sub-interpreters (and the main interpreter)+-- are part of the same process, the insulation between them isn&#x2019;t+-- perfect &#x2014; for example, using low-level file operations like+-- @os.close()@ they can (accidentally or maliciously) affect each+-- other&#x2019;s open files. Because of the way extensions are shared+-- between (sub-)interpreters, some extensions may not work properly; this+-- is especially likely when the extension makes use of (static) global+-- variables, or when the extension manipulates its module&#x2019;s+-- dictionary after its initialization. It is possible to insert objects+-- created in one sub-interpreter into a namespace of another+-- sub-interpreter; this should be done with great care to avoid sharing+-- user-defined functions, methods, instances or classes between+-- sub-interpreters, since import operations executed by such objects may+-- affect the wrong (sub-)interpreter&#x2019;s dictionary of loaded modules.+-- (XXX This is a hard-to-fix bug that will be addressed in a future release.)+-- +-- Also note that the use of this functionality is incompatible with+-- extension modules such as PyObjC and ctypes that use the @PyGILState_*()@+-- APIs (and this is inherent in the way the @PyGILState_*()@ procedures+-- 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++-- | Destroy the (sub-)interpreter represented by the given thread state.+-- The given thread state must be the current thread state. See the+-- discussion of thread states below. When the call returns, the current+-- thread state is @NULL@. All thread states associated with this+-- interpreter are destroyed. (The global interpreter lock must be held+-- before calling this computation and is still held when it returns.)+-- 'finalize' will destroy all sub-interpreters that haven&#x2019;t been+-- explicitly destroyed at that point.+-- +endInterpreter :: ThreadState -> IO ()+endInterpreter (ThreadState 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++-- | 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+-- the @argv[0]@ argument to the @main@ procedure of the program. This is+-- used by 'getPath' and some other computations below to find the Python+-- run-time libraries relative to the interpreter executable. The default+-- value is @\"python\"@. No code in the Python interpreter will change the+-- program name.+-- +setProgramName :: Text -> IO ()+setProgramName name = withTextW name cSetProgramName++foreign import ccall safe "hscpython-shim.h hscpython_SetProgramName"+	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+-- with 'setProgramName' and some environment variables; for example, if the+-- program name is @\"\/usr\/local\/bin\/python\"@, the prefix is+-- @\"\/usr\/local\"@. This corresponds to the @prefix@ variable in the+-- top-level Makefile and the /--prefix/ argument to the @configure@ script+-- at build time. The value is available to Python code as @sys.prefix@. It+-- is only useful on UNIX. See also 'getExecPrefix'.+-- +getPrefix :: IO Text+getPrefix = pyGetPrefix >>= peekTextW++foreign import ccall safe "hscpython-shim.h Py_GetPrefix"+	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+-- set with setProgramName' and some environment variables; for example, if+-- the program name is @\"\/usr\/local\/bin\/python\"@, the exec-prefix is+-- @\"\/usr\/local\"@. This corresponds to the @exec_prefix@ variable in the+-- top-level Makefile and the /--exec-prefix/ argument to the @configure@+-- script at build time. The value is available to Python code as+-- @sys.exec_prefix@. It is only useful on UNIX.+-- +-- Background: The exec-prefix differs from the prefix when platform+-- dependent files (such as executables and shared libraries) are installed+-- in a different directory tree. In a typical installation, platform+-- dependent files may be installed in the @\/usr\/local\/plat@ subtree while+-- platform independent may be installed in @\/usr\/local@.+-- +-- Generally speaking, a platform is a combination of hardware and software+-- families, e.g. Sparc machines running the Solaris 2.x operating system+-- are considered the same platform, but Intel machines running Solaris+-- 2.x are another platform, and Intel machines running Linux are yet+-- another platform. Different major revisions of the same operating system+-- generally also form different platforms. Non-UNIX operating systems are a+-- different story; the installation strategies on those systems are so+-- different that the prefix and exec-prefix are meaningless, and set to the+-- empty string. Note that compiled Python bytecode files are platform+-- independent (but not independent from the Python version by which they+-- were compiled!).+-- +-- System administrators will know how to configure the @mount@ or @automount@+-- programs to share @\/usr\/local@ between platforms while having+-- @\/usr\/local\/plat@ be a different filesystem for each platform.+-- +getExecPrefix :: IO Text+getExecPrefix = pyGetExecPrefix >>= peekTextW++foreign import ccall safe "hscpython-shim.h Py_GetExecPrefix"+	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+-- program name (set by 'setProgramName' above). The value is available to+-- Python code as @sys.executable@.+-- +getProgramFullPath :: IO Text+getProgramFullPath = pyGetProgramFullPath >>= peekTextW++foreign import ccall safe "hscpython-shim.h Py_GetProgramFullPath"+	pyGetProgramFullPath :: IO CWString++-- | Return the default module search path; this is computed from the+-- program name (set by 'setProgramName' above) and some environment+-- variables. The returned string consists of a series of directory names+-- separated by a platform dependent delimiter character. The delimiter+-- character is @\':\'@ on Unix and Mac OS X, @\';\'@ on Windows. The value+-- is available to Python code as the list @sys.path@, which may be modified+-- to change the future search path for loaded modules.+-- +getPath :: IO Text+getPath = pyGetPath >>= peekTextW++foreign import ccall safe "hscpython-shim.h Py_GetPath"+	pyGetPath :: IO CWString++-- | Return the version of this Python interpreter. This is a string that+-- looks something like+-- +-- @+--  \"3.0a5+ (py3k:63103M, May 12 2008, 00:53:55) \\n[GCC 4.2.3]\"+-- @+-- +-- The first word (up to the first space character) is the current Python+-- version; the first three characters are the major and minor version+-- separated by a period. The value is available to Python code as+-- @sys.version@.+-- +{# fun Py_GetVersion as getVersion+	{} -> `Text' peekText* #}++-- | Return the platform identifier for the current platform. On Unix, this+-- is formed from the &#x201c;official&#x201d; name of the operating system,+-- converted to lower case, followed by the major revision number; e.g., for+-- Solaris 2.x, which is also known as SunOS 5.x, the value is @\"sunos5\"@.+-- 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* #}++-- | Return the official copyright string for the current Python version,+-- for example+-- +-- @+--  \"Copyright 1991-1995 Stichting Mathematisch Centrum, Amsterdam\"+-- @+-- +-- The value is available to Python code as @sys.copyright@.+-- +{# fun Py_GetCopyright as getCopyright+	{} -> `Text' peekText* #}++-- | Return an indication of the compiler used to build the current Python+-- version, in square brackets, for example:+-- +-- @+--  \"[GCC 2.7.2.2]\"+-- @+-- +-- The value is available to Python code as part of the variable+-- @sys.version@.+-- +{# fun Py_GetCompiler as getCompiler+	{} -> `Text' peekText* #}++-- | Return information about the sequence number and build date and time of+-- the current Python interpreter instance, for example+-- +-- @+--  \"#67, Aug  1 1997, 22:34:28\"+-- @+-- +-- The value is available to Python code as part of the variable+-- @sys.version@.+-- +{# fun Py_GetBuildInfo as getBuildInfo+	{} -> `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+-- file to be executed rather than the executable hosting the Python+-- interpreter. If there isn&#x2019;t a script that will be run, the first+-- parameter can be an empty string. If this function fails to initialize+-- @sys.argv@, a fatal condition is signalled using @Py_FatalError()@.+-- +-- This function also prepends the executed script&#x2019;s path to+-- @sys.path@. If no script is executed (in the case of calling @python -c@+-- 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++foreign import ccall safe "hscpython-shim.h PySys_SetArgv"+	pySetArgv :: CInt -> Ptr CWString -> IO ()++-- | Return the default &#x201c;home&#x201d;, that is, the value set by a+-- previous call to 'setPythonHome', or the value of the @PYTHONHOME@+-- environment variable if it is set.+-- +getPythonHome :: IO Text+getPythonHome = pyGetPythonHome >>= peekTextW++foreign import ccall safe "hscpython-shim.h Py_GetPythonHome"+	pyGetPythonHome :: IO CWString++-- | Set the default &#x201c;home&#x201d; directory, that is, the location+-- of the standard Python libraries. The libraries are searched in+-- @/home/\/lib\//python version/@ and @/home/\/lib\//python version/@. No+-- code in the Python interpreter will change the Python home.+-- +setPythonHome :: Text -> IO ()+setPythonHome name = withTextW name cSetPythonHome++foreign import ccall safe "hscpython-shim.h hscpython_SetPythonHome"+	cSetPythonHome :: CWString -> IO ()
+ lib/CPython/Constants.chs view
@@ -0,0 +1,60 @@+-- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>+-- +-- 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 <http://www.gnu.org/licenses/>.+-- +{-# LANGUAGE ForeignFunctionInterface #-}+module CPython.Constants+	( none+	, true+	, false+	, isNone+	, isTrue+	, isFalse+	) where+import CPython.Internal++#include <hscpython-shim.h>++-- | The Python @None@ object, denoting lack of value.+-- +{# fun hscpython_Py_None as none+	{} -> `SomeObject' peekObject* #}++-- | The Python @True@ object.+-- +{# fun hscpython_Py_True as true+	{} -> `SomeObject' peekObject* #}++-- | The Python @False@ object.+-- +{# fun hscpython_Py_False as false+	{} -> `SomeObject' peekObject* #}++{# fun pure hscpython_Py_None as rawNone+	{} -> `Ptr ()' id #}++{# fun pure hscpython_Py_True as rawTrue+	{} -> `Ptr ()' id #}++{# fun pure hscpython_Py_False as rawFalse+	{} -> `Ptr ()' id #}++isNone :: SomeObject -> IO Bool+isNone obj = withObject obj $ \ptr -> return $ ptr == rawNone++isTrue :: SomeObject -> IO Bool+isTrue obj = withObject obj $ \ptr -> return $ ptr == rawTrue++isFalse :: SomeObject -> IO Bool+isFalse obj = withObject obj $ \ptr -> return $ ptr == rawFalse
+ lib/CPython/Internal.chs view
@@ -0,0 +1,268 @@+-- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>+-- +-- 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 <http://www.gnu.org/licenses/>.+-- +{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE DeriveDataTypeable #-}+module CPython.Internal+	(+	-- * FFI support+	  module Foreign+	, module Foreign.C+	, cToBool+	, cFromBool+	, peekText+	, peekTextW+	, withText+	, withTextW+	, mapWith+	+	-- * 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+import Control.Applicative ((<$>))+import qualified Control.Exception as E+import qualified Data.Text as T+import Data.Typeable (Typeable)+import Foreign+import Foreign.C++#include <hscpython-shim.h>++cToBool :: CInt -> Bool+cToBool = (/= 0)++cFromBool :: Bool -> CInt+cFromBool x = if x then 1 else 0++peekText :: CString -> IO T.Text+peekText = fmap T.pack . peekCString++peekTextW :: CWString -> IO T.Text+peekTextW = fmap T.pack . peekCWString++withText :: T.Text -> (CString -> IO a) -> IO a+withText = withCString . T.unpack++withTextW :: T.Text -> (CWString -> IO a) -> IO a+withTextW = withCWString . T.unpack++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++data SomeObject = forall a. (Object a) => SomeObject (ForeignPtr a)++class Object a where+	toObject :: a -> SomeObject+	fromForeignPtr :: ForeignPtr a -> a++class Object a => Concrete a where+	concreteType :: a -> Type++instance Object SomeObject where+	toObject = id+	fromForeignPtr = SomeObject++newtype Type = Type (ForeignPtr Type)+instance Object Type where+	toObject (Type x) = SomeObject x+	fromForeignPtr = Type++newtype Dictionary = Dictionary (ForeignPtr Dictionary)+instance Object Dictionary where+	toObject (Dictionary x) = SomeObject x+	fromForeignPtr = Dictionary++newtype List = List (ForeignPtr List)+instance Object List where+	toObject (List x) = SomeObject x+	fromForeignPtr = List++newtype Tuple = Tuple (ForeignPtr Tuple)+instance Object Tuple where+	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)++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)++peekStaticObject :: Object obj => Ptr a -> IO obj+peekStaticObject ptr = fromForeignPtr <$> newForeignPtr_ (castPtr ptr)++unsafeStealObject :: Object obj => Ptr a -> IO obj+unsafeStealObject ptr = fromForeignPtr <$> newForeignPtr staticDecref (castPtr 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 #}++{# fun hscpython_Py_DECREF as decref+	{ castPtr `Ptr a'+	} -> `()' id #}++foreign import ccall "hscpython-shim.h &hscpython_Py_DECREF"+	staticDecref :: FunPtr (Ptr a -> IO ())++{# fun PyObject_CallObject as callObjectRaw+	`(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)++data Exception = Exception+	{ exceptionType      :: SomeObject+	, exceptionValue     :: SomeObject+	, exceptionTraceback :: Maybe SomeObject+	}+	deriving (Typeable)++instance Show Exception where+	show _ = "<CPython exception>"++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++checkStatusCode :: CInt -> IO ()+checkStatusCode = exceptionIf . (== -1)++checkBoolReturn :: CInt -> IO Bool+checkBoolReturn x = do+	exceptionIf $ x == -1+	return $ x /= 0++checkIntReturn :: Integral a => a -> IO Integer+checkIntReturn x = do+	exceptionIf $ x == -1+	return $ toInteger x++data SomeMapping = forall a. (Mapping a) => SomeMapping (ForeignPtr a)++class Object a => Mapping a where+	toMapping :: a -> SomeMapping++instance Object SomeMapping where+	toObject (SomeMapping x) = SomeObject x+	fromForeignPtr = SomeMapping++instance Mapping SomeMapping where+	toMapping = id++unsafeCastToMapping :: Object a => a -> SomeMapping+unsafeCastToMapping x = case toObject x of+	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++instance Object SomeSequence where+	toObject (SomeSequence x) = SomeObject x+	fromForeignPtr = SomeSequence++instance Sequence SomeSequence where+	toSequence = id++unsafeCastToSequence :: Object a => a -> SomeSequence+unsafeCastToSequence x = case toObject x of+	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++instance Object SomeIterator where+	toObject (SomeIterator x) = SomeObject x+	fromForeignPtr = SomeIterator++instance Iterator SomeIterator where+	toIterator = id++unsafeCastToIterator :: Object a => a -> SomeIterator+unsafeCastToIterator x = case toObject x of+	SomeObject ptr -> let+		ptr' = castForeignPtr ptr :: ForeignPtr SomeIterator+		in SomeIterator ptr'
+ lib/CPython/Protocols/Iterator.chs view
@@ -0,0 +1,50 @@+-- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>+-- +-- 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 <http://www.gnu.org/licenses/>.+-- +{-# LANGUAGE ForeignFunctionInterface #-}+module CPython.Protocols.Iterator+	( Iterator (..)+	, SomeIterator+	, castToIterator+	, next+	) where+import CPython.Internal++#include <hscpython-shim.h>++-- | Attempt to convert an object to a generic 'Iterator'. If the object does+-- 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++-- | 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
+ lib/CPython/Protocols/Mapping.chs view
@@ -0,0 +1,88 @@+-- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>+-- +-- 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 <http://www.gnu.org/licenses/>.+-- +{-# LANGUAGE ForeignFunctionInterface #-}+module CPython.Protocols.Mapping+	( Mapping (..)+	, SomeMapping+	, castToMapping+	, getItem+	, setItem+	, deleteItem+	, size+	, hasKey+	, keys+	, values+	, items+	) where+import CPython.Internal++#include <hscpython-shim.h>++instance Mapping Dictionary where+	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++{# fun PyObject_GetItem as getItem+	`(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* #}++{# fun PyObject_DelItem as deleteItem+	`(Mapping self, Object key)' =>+	{ withObject* `self'+	, withObject* `key'+	} -> `()' checkStatusCode* #}++{# fun PyMapping_Size as size+	`Mapping self' =>+	{ withObject* `self'+	} -> `Integer' checkIntReturn* #}++{# fun PyMapping_HasKey as hasKey+	`(Mapping self, Object key)' =>+	{ withObject* `self'+	, withObject* `key'+	} -> `Bool' #}++{# fun PyMapping_Keys as keys+	`Mapping self' =>+	{ withObject* `self'+	} -> `List' stealObject* #}++{# fun PyMapping_Values as values+	`Mapping self' =>+	{ withObject* `self'+	} -> `List' stealObject* #}++{# fun PyMapping_Items as items+	`Mapping self' =>+	{ withObject* `self'+	} -> `List' stealObject* #}
+ lib/CPython/Protocols/Number.chs view
@@ -0,0 +1,299 @@+-- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>+-- +-- 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 <http://www.gnu.org/licenses/>.+-- +{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE ExistentialQuantification #-}+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+import Prelude hiding (Integer, Float, subtract, and, or, toInteger)+import qualified Prelude as Prelude+import CPython.Internal hiding (xor, shiftR, shiftL)+import CPython.Constants (none)+import CPython.Types.Complex (Complex)+import CPython.Types.Float (Float)+import CPython.Types.Integer (Integer)+import CPython.Types.Unicode (Unicode)+import CPython.Types.Set (Set, FrozenSet)++#include <hscpython-shim.h>++data SomeNumber = forall a. (Number a) => SomeNumber (ForeignPtr a)++class Object a => Number a where+	toNumber :: a -> SomeNumber++instance Object SomeNumber where+	toObject (SomeNumber x) = SomeObject x+	fromForeignPtr = SomeNumber++instance Number SomeNumber where+	toNumber = id++instance Number Integer where+	toNumber = unsafeCastToNumber++instance Number Float where+	toNumber = unsafeCastToNumber++instance Number Complex where+	toNumber = unsafeCastToNumber++-- lol wut+instance Number Set where+	toNumber = unsafeCastToNumber++instance Number FrozenSet where+	toNumber = unsafeCastToNumber++unsafeCastToNumber :: Object a => a -> SomeNumber+unsafeCastToNumber x = case toObject x of+	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++{# fun PyNumber_Add as add+	`(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* #}++{# fun PyNumber_Multiply as multiply+	`(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* #}++{# fun PyNumber_TrueDivide as trueDivide+	`(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* #}++{# fun PyNumber_Divmod as divmod+	`(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++{# fun PyNumber_Negative as negative+	`Number a' =>+	{ withObject* `a'+	} -> `SomeNumber' stealObject* #}++{# fun PyNumber_Positive as positive+	`Number a' =>+	{ withObject* `a'+	} -> `SomeNumber' stealObject* #}++{# fun PyNumber_Absolute as absolute+	`Number a' =>+	{ withObject* `a'+	} -> `SomeNumber' stealObject* #}++{# fun PyNumber_Invert as invert+	`Number a' =>+	{ withObject* `a'+	} -> `SomeNumber' stealObject* #}++{# fun PyNumber_Lshift as shiftL+	`(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* #}++{# fun PyNumber_And as and+	`(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* #}++{# fun PyNumber_Or as or+	`(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* #}++{# fun PyNumber_InPlaceSubtract as inPlaceSubtract+	`(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* #}++{# fun PyNumber_InPlaceFloorDivide as inPlaceFloorDivide+	`(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* #}++{# fun PyNumber_InPlaceRemainder as inPlaceRemainder+	`(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++{# fun PyNumber_InPlaceLshift as inPlaceShiftL+	`(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* #}++{# fun PyNumber_InPlaceAnd as inPlaceAnd+	`(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* #}++{# fun PyNumber_InPlaceOr as inPlaceOr+	`(Number a, Number b)' =>+	{ withObject* `a'+	, withObject* `b'+	} -> `SomeNumber' stealObject* #}++{# fun PyNumber_Long as toInteger+	`Number a' =>+	{ withObject* `a'+	} -> `Integer' stealObject* #}++{# fun PyNumber_Float as toFloat+	`Number a' =>+	{ withObject* `a'+	} -> `Float' stealObject* #}++{# fun PyNumber_ToBase as toBase+	`Number a' =>+	{ withObject* `a'+	, fromIntegral `Prelude.Integer'+	} -> `Unicode' stealObject* #}
+ lib/CPython/Protocols/Object.chs view
@@ -0,0 +1,317 @@+-- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>+-- +-- 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 <http://www.gnu.org/licenses/>.+-- +{-# LANGUAGE ForeignFunctionInterface #-}+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+import Prelude hiding (Ordering (..), print)+import qualified Data.Text as T+import System.IO (Handle, hPutStrLn)+import CPython.Internal hiding (toBool)+import qualified CPython.Types.Bytes as B+import qualified CPython.Types.Dictionary as D+import qualified CPython.Types.Tuple as Tuple+import qualified CPython.Types.Unicode as U++#include <hscpython-shim.h>++-- | Returns a 'Type' object corresponding to the object type of /self/. On+-- failure, throws @SystemError@. This is equivalent to the Python expression+-- @type(o)@.+-- +{# fun PyObject_Type as getType+	`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.+-- If /cls/ is a type object rather than a class object, 'isInstance'+-- returns 'True' if /inst/ is of type /cls/. If /cls/ is a tuple, the check+-- will be done against every entry in /cls/. The result will be 'True' when+-- at least one of the checks returns 'True', otherwise it will be 'False'. If+-- /inst/ is not a class instance and /cls/ is neither a type object, nor a+-- class object, nor a tuple, /inst/ must have a @__class__@ attribute &#2014;+-- the class relationship of the value of that attribute with /cls/ will be+-- used to determine the result of this function.+-- +-- Subclass determination is done in a fairly straightforward way, but+-- includes a wrinkle that implementors of extensions to the class system+-- may want to be aware of. If A and B are class objects, B is a subclass of+-- A if it inherits from A either directly or indirectly. If either is not a+-- class object, a more general mechanism is used to determine the class+-- relationship of the two objects. When testing if B is a subclass of A, if+-- A is B, 'isSubclass' returns 'True'. If A and B are different objects,+-- B&#2018;s @__bases__@ attribute is searched in a depth-first fashion for+-- A &#2014; 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* #}++-- | Returns 'True' if the class /derived/ is identical to or derived from+-- the class /cls/, otherwise returns 'False'. In case of an error, throws+-- an exception. If /cls/ is a tuple, the check will be done against every+-- entry in /cls/. The result will be 'True' when at least one of the checks+-- returns 'True', otherwise it will be 'False'. If either /derived/ or /cls/+-- 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* #}++-- | 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++-- | 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* #}++-- | 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* #}++-- | 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* #}++-- | 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* #}++-- | Print @repr(self)@ to a handle.+-- +print :: Object self => self -> Handle -> IO ()+print obj h = repr obj >>= U.fromUnicode >>= (hPutStrLn h . T.unpack)++-- | 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* #}++-- \ 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* #}++-- | 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* #}++-- | 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* #}++-- | Determine if the object /self/ is callable.+-- +{# fun PyCallable_Check as callable+	`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+-- the call on success, or throws an exception on failure. This is the+-- 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++-- | 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'++-- | Call the named method of object /self/, with arguments given by the+-- tuple and named arguments given by the dictionary. Returns the result of+-- the call on success, or throws an exception on failure. This is the+-- 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++-- | 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+-- on failure. This is the equivalent of the Python expression+-- @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'++data Comparison = LT | LE | EQ | NE | GT | GE+	deriving (Show)++{# enum HSCPythonComparisonEnum {} #}++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++-- | 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* #}++-- | 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* #}++-- | 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* #}++-- | 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* #}++-- | 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* #}
+ lib/CPython/Protocols/Sequence.chs view
@@ -0,0 +1,189 @@+-- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>+-- +-- 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 <http://www.gnu.org/licenses/>.+-- +{-# LANGUAGE ForeignFunctionInterface #-}+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+import Prelude hiding (repeat, length)+import Data.Text (Text)+import CPython.Internal+import CPython.Types.ByteArray (ByteArray)+import CPython.Types.Bytes (Bytes)+import CPython.Types.Unicode (Unicode)++#include <hscpython-shim.h>++instance Sequence ByteArray where+	toSequence = unsafeCastToSequence++instance Sequence Bytes where+	toSequence = unsafeCastToSequence++instance Sequence List where+	toSequence = unsafeCastToSequence++instance Sequence Tuple where+	toSequence = unsafeCastToSequence++instance Sequence Unicode where+	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++{# fun PySequence_Size as length+	`Sequence self' =>+	{ withObject* `self'+	} -> `Integer' checkIntReturn* #}++{# fun PySequence_Concat as append+	`(Sequence a, Sequence b)' =>+	{ withObject* `a'+	, withObject* `b'+	} -> `SomeSequence' stealObject* #}++{# fun PySequence_Repeat as repeat+	`Sequence a' =>+	{ withObject* `a'+	, fromIntegral `Integer'+	} -> `a' stealObject* #}++{# fun PySequence_InPlaceConcat as inPlaceAppend+	`(Sequence a, Sequence b)' =>+	{ withObject* `a'+	, withObject* `b'+	} -> `SomeSequence' stealObject* #}++{# fun PySequence_InPlaceRepeat as inPlaceRepeat+	`Sequence a' =>+	{ withObject* `a'+	, fromIntegral `Integer'+	} -> `a' stealObject* #}++{# fun PySequence_GetItem as getItem+	`Sequence self' =>+	{ withObject* `self'+	, fromIntegral `Integer'+	} -> `SomeObject' stealObject* #}++{# fun PySequence_SetItem as setItem+	`(Sequence self, Object v)' =>+	{ withObject* `self'+	, fromIntegral `Integer'+	, withObject* `v'+	} -> `()' checkStatusCode* #}++{# fun PySequence_DelItem as deleteItem+	`Sequence self' =>+	{ withObject* `self'+	, fromIntegral `Integer'+	} -> `()' checkStatusCode* #}++{# fun PySequence_GetSlice as getSlice+	`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* #}++{# fun PySequence_DelSlice as deleteSlice+	`Sequence self' =>+	{ withObject* `self'+	, fromIntegral `Integer'+	, fromIntegral `Integer'+	} -> `()' checkStatusCode* #}++{# fun PySequence_Count as count+	`(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* #}++-- | 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* #}++-- | 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* #}++-- | 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* #}++-- | 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* #}
+ lib/CPython/Reflection.chs view
@@ -0,0 +1,70 @@+-- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>+-- +-- 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 <http://www.gnu.org/licenses/>.+-- +{-# LANGUAGE ForeignFunctionInterface #-}+module CPython.Reflection+	( getBuiltins+	, getLocals+	, getGlobals+	, getFrame+	, getFunctionName+	, getFunctionDescription+	) where+import Data.Text (Text)+import CPython.Internal++#include <hscpython-shim.h>++-- | 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* #}++-- | Return a 'Dictionary' of the local variables in the current execution+-- frame, or 'Nothing' if no frame is currently executing.+-- +getLocals :: IO (Maybe Dictionary)+getLocals = {# call PyEval_GetLocals as ^#} >>= maybePeek peekObject++-- | Return a 'Dictionary' of the global variables in the current execution+-- frame, or 'Nothing' if no frame is currently executing.+-- +getGlobals :: IO (Maybe Dictionary)+getGlobals = {# call PyEval_GetGlobals as ^#} >>= maybePeek peekObject++-- | Return the current thread state's frame, which is 'Nothing' if no frame+-- is currently executing.+-- +getFrame :: IO (Maybe SomeObject)+getFrame = {# call PyEval_GetFrame as ^#} >>= maybePeek peekObject++-- | 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* #}++-- | 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* #}
+ lib/CPython/System.chs view
@@ -0,0 +1,79 @@+-- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>+-- +-- 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 <http://www.gnu.org/licenses/>.+-- +{-# LANGUAGE ForeignFunctionInterface #-}+module CPython.System+	( getObject+	, setObject+	, deleteObject+	, resetWarnOptions+	, addWarnOption+	, setPath+	) where+import Data.Text (Text)+import CPython.Internal++#include <hscpython-shim.h>++-- | Return the object /name/ from the @sys@ module, or 'Nothing' if it does+-- not exist.+-- +getObject :: Text -> IO (Maybe SomeObject)+getObject name =+	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++-- | Delete /name/ from the @sys@ module.+-- +deleteObject :: Text -> IO ()+deleteObject name =+	withText name $ \cstr ->+	{# call PySys_SetObject as ^ #} cstr nullPtr+	>>= checkStatusCode++-- | Reset @sys.warnoptions@ to an empty list.+-- +{# fun PySys_ResetWarnOptions as resetWarnOptions+	{} -> `()' 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 ()++-- | 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+-- delimiter (@\':\'@ on Unix, @\';\'@ on Windows).+-- +setPath :: Text -> IO ()+setPath path = withTextW path pySysSetPath++foreign import ccall safe "hscpython-shim.h PySys_SetPath"+	pySysSetPath :: CWString -> IO ()
+ lib/CPython/Types.hs view
@@ -0,0 +1,116 @@+-- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>+-- +-- 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 <http://www.gnu.org/licenses/>.+-- +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+import CPython.Types.ByteArray+import CPython.Types.Bytes+import CPython.Types.Capsule+import CPython.Types.Cell+import CPython.Types.Code+import CPython.Types.Complex+import CPython.Types.Dictionary+import CPython.Types.Exception+import CPython.Types.Float+import CPython.Types.Function+import CPython.Types.InstanceMethod+import CPython.Types.Integer+import CPython.Types.Iterator+import CPython.Types.List+import CPython.Types.Method+import CPython.Types.Module+import CPython.Types.Set+import CPython.Types.Slice+import CPython.Types.Tuple+import CPython.Types.Type+import CPython.Types.Unicode+import CPython.Types.WeakReference
+ lib/CPython/Types/ByteArray.chs view
@@ -0,0 +1,79 @@+-- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>+-- +-- 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 <http://www.gnu.org/licenses/>.+-- +{-# LANGUAGE ForeignFunctionInterface #-}+module CPython.Types.ByteArray+	( ByteArray+	, byteArrayType+	, toByteArray+	, fromByteArray+	, fromObject+	, append+	, length+	, resize+	) where+import Prelude hiding (length)+import qualified Data.ByteString as B+import qualified Data.ByteString.Unsafe as B+import CPython.Internal++#include <hscpython-shim.h>++newtype ByteArray = ByteArray (ForeignPtr ByteArray)++instance Object ByteArray where+	toObject (ByteArray x) = SomeObject x+	fromForeignPtr = ByteArray++instance Concrete ByteArray where+	concreteType _ = byteArrayType++{# fun pure hscpython_PyByteArray_Type as byteArrayType+	{} -> `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)++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')++-- | Create a new byte array from any object which implements the buffer+-- protocol.+-- +{# fun PyByteArray_FromObject as fromObject+	`Object self ' =>+	{ withObject* `self'+	} -> `ByteArray' stealObject* #}++{# fun PyByteArray_Concat as append+	{ withObject* `ByteArray'+	, withObject* `ByteArray'+	} -> `ByteArray' stealObject* #}++{# fun PyByteArray_Size as length+	{ withObject* `ByteArray'+	} -> `Integer' checkIntReturn* #}++{# fun PyByteArray_Resize as resize+	{ withObject* `ByteArray'+	, fromIntegral `Integer'+	} -> `()' checkStatusCode* #}
+ lib/CPython/Types/Bytes.chs view
@@ -0,0 +1,84 @@+-- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>+-- +-- 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 <http://www.gnu.org/licenses/>.+-- +{-# LANGUAGE ForeignFunctionInterface #-}+module CPython.Types.Bytes+	( Bytes+	, bytesType+	, toBytes+	, fromBytes+	, fromObject+	, length+	, append+	) where+import Prelude hiding (length)+import qualified Data.ByteString as B+import qualified Data.ByteString.Unsafe as B+import CPython.Internal++#include <hscpython-shim.h>++newtype Bytes = Bytes (ForeignPtr Bytes)++instance Object Bytes where+	toObject (Bytes x) = SomeObject x+	fromForeignPtr = Bytes++instance Concrete Bytes where+	concreteType _ = bytesType++{# fun pure hscpython_PyBytes_Type as bytesType+	{} -> `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)++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)++-- | Create a new byte string from any object which implements the buffer+-- protocol.+-- +{# fun PyBytes_FromObject as fromObject+	`Object self ' =>+	{ withObject* `self'+	} -> `Bytes' stealObject* #}++{# fun PyBytes_Size as length+	{ 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+
+ lib/CPython/Types/Capsule.chs view
@@ -0,0 +1,155 @@+-- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>+-- +-- 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 <http://www.gnu.org/licenses/>.+-- +{-# LANGUAGE ForeignFunctionInterface #-}+module CPython.Types.Capsule+	( Capsule+	, capsuleType+	--, new+	, getPointer+	--, getDestructor+	, getContext+	, getName+	, importNamed+	, isValid+	, setPointer+	--, setDestructor+	, setContext+	--, setName+	) where+import Data.Text (Text)+import CPython.Internal hiding (new)++#include <hscpython-shim.h>++-- type Destructor = Ptr () -> IO ()+newtype Capsule = Capsule (ForeignPtr Capsule)++instance Object Capsule where+	toObject (Capsule x) = SomeObject x+	fromForeignPtr = Capsule++instance Concrete Capsule where+	concreteType _ = capsuleType++{# fun pure hscpython_PyCapsule_Type as capsuleType+	{} -> `Type' peekStaticObject* #}++-- new :: Ptr () -> Maybe Text -> Destructor -> IO Capsule+-- new = undefined++-- | Retrieve the pointer stored in the capsule. On failure, throws an+-- exception.+-- +-- The name parameter must compare exactly to the name stored in the capsule.+-- If the name stored in the capsule is 'Nothing', the name passed in must+-- also be 'Nothing'. Python uses the C function strcmp() to compare capsule+-- names.+-- +getPointer :: Capsule -> Maybe Text -> IO (Ptr ())+getPointer py name =+	withObject py $ \pyPtr ->+	maybeWith withText name $ \namePtr ->+	{# call PyCapsule_GetPointer as ^ #} pyPtr namePtr++-- getDestructor :: Capsule -> IO (Maybe Destructor)+-- getDestructor = undefined++-- | 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++-- | 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++-- | 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+-- @\"module.attribute\"@. The name stored in the capsule must match this+-- string exactly. If the second parameter is 'False', import the module+-- without blocking (using @PyImport_ImportModuleNoBlock()@). Otherwise,+-- imports the module conventionally (using @PyImport_ImportModule()@).+-- +-- Return the capsule&#x2019;s internal pointer on success. On failure, throw+-- an exception. If the module could not be imported, and if importing in+-- 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++-- | 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+-- matches the name parameter. (See 'getPointer' for information on how+-- capsule names are compared.)+-- +-- In other words, if 'isValid' returns 'True', calls to any of the+-- 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++-- | Set the void pointer inside the capsule. The pointer may not be @NULL@.+-- +{# fun PyCapsule_SetPointer as setPointer+	{ 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* #}++-- setName :: Capsule -> Maybe Text -> IO ()+-- setName = undefined
+ lib/CPython/Types/Cell.chs view
@@ -0,0 +1,64 @@+-- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>+-- +-- 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 <http://www.gnu.org/licenses/>.+-- +{-# LANGUAGE ForeignFunctionInterface #-}+module CPython.Types.Cell+	( Cell+	, cellType+	, new+	, get+	, set+	) where+import CPython.Internal hiding (new)++#include <hscpython-shim.h>++newtype Cell = Cell (ForeignPtr Cell)++instance Object Cell where+	toObject (Cell x) = SomeObject x+	fromForeignPtr = Cell++instance Concrete Cell where+	concreteType _ = cellType++{# fun pure hscpython_PyCell_Type as cellType+	{} -> `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++-- | Return the contents of a cell.+-- +get :: Cell -> IO (Maybe SomeObject)+get cell =+	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
+ lib/CPython/Types/Code.chs view
@@ -0,0 +1,35 @@+-- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>+-- +-- 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 <http://www.gnu.org/licenses/>.+-- +{-# LANGUAGE ForeignFunctionInterface #-}+module CPython.Types.Code+	( Code+	, codeType+	) where+import CPython.Internal++#include <hscpython-shim.h>++newtype Code = Code (ForeignPtr Code)++instance Object Code where+	toObject (Code x) = SomeObject x+	fromForeignPtr = Code++instance Concrete Code where+	concreteType _ = codeType++{# fun pure hscpython_PyCode_Type as codeType+	{} -> `Type' peekStaticObject* #}
+ lib/CPython/Types/Complex.chs view
@@ -0,0 +1,50 @@+-- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>+-- +-- 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 <http://www.gnu.org/licenses/>.+-- +{-# LANGUAGE ForeignFunctionInterface #-}+module CPython.Types.Complex+	( Complex+	, complexType+	, toComplex+	, fromComplex+	) where+import qualified Data.Complex as C+import CPython.Internal++#include <hscpython-shim.h>++newtype Complex = Complex (ForeignPtr Complex)++instance Object Complex where+	toObject (Complex x) = SomeObject x+	fromForeignPtr = Complex++instance Concrete Complex where+	concreteType _ = complexType++{# fun pure hscpython_PyComplex_Type as complexType+	{} -> `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++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
+ lib/CPython/Types/Dictionary.chs view
@@ -0,0 +1,183 @@+-- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>+-- +-- 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 <http://www.gnu.org/licenses/>.+-- +{-# LANGUAGE ForeignFunctionInterface #-}+module CPython.Types.Dictionary+	( Dictionary+	, dictionaryType+	, new+	, clear+	, contains+	, copy+	, getItem+	, setItem+	, deleteItem+	, items+	, keys+	, values+	, size+	, merge+	, update+	, mergeFromSeq2+	) where+import CPython.Internal hiding (new)++#include <hscpython-shim.h>++instance Concrete Dictionary where+	concreteType _ = dictionaryType++{# fun pure hscpython_PyDict_Type as dictionaryType+	{} -> `Type' peekStaticObject* #}++{# fun PyDict_New as new+	{} -> `Dictionary' stealObject* #}++-- newProxy++-- | Empty an existing dictionary of all key-value pairs.+-- +{# fun PyDict_Clear as clear+	{ 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* #}++-- | Return a new dictionary that contains the same key-value pairs as the+-- old dictionary.+-- +{# fun PyDict_Copy as copy+	{ 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++-- getItemString++-- | Inserts /value/ into a dictionary with a key of /key/. /key/ must be+-- hashable; if it isn&#x2019;t, throws @TypeError@.+-- +{# fun PyDict_SetItem as setItem+	`(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&#x2019;t, throws @TypeError@.+-- +{# fun PyDict_DelItem as deleteItem+	`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* #}++-- | 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* #}++-- | 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* #}++-- | Return the number of items in the dictionary. This is equivalent to+-- @len(d)@.+{# fun PyDict_Size as size+	{ withObject* `Dictionary'+	} -> `Integer' checkIntReturn* #}++-- next++-- | Iterate over mapping object /b/ adding key-value pairs to a dictionary.+-- /b/ may be a dictionary, or any object supporting 'keys' and 'getItem'.+-- If the third parameter is 'True', existing pairs in will be replaced if a+-- 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* #}++-- | 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* #}++-- | 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,+-- viewed as key-value pairs. In case of duplicate keys, the last wins if+-- the third parameter is 'True', otherwise the first wins. Equivalent+-- Python:+-- +-- @+-- def mergeFromSeq2(a, seq2, override):+-- 	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* #}
+ lib/CPython/Types/Exception.chs view
@@ -0,0 +1,25 @@+-- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>+-- +-- 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 <http://www.gnu.org/licenses/>.+-- +{-# LANGUAGE ForeignFunctionInterface #-}+module CPython.Types.Exception+	( Exception+	, exceptionType+	, exceptionValue+	, exceptionTraceback+	) where+import CPython.Internal++#include <hscpython-shim.h>
+ lib/CPython/Types/Float.chs view
@@ -0,0 +1,46 @@+-- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>+-- +-- 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 <http://www.gnu.org/licenses/>.+-- +{-# LANGUAGE ForeignFunctionInterface #-}+module CPython.Types.Float+	( Float+	, floatType+	, toFloat+	, fromFloat+	) where+import Prelude hiding (Float)+import CPython.Internal++#include <hscpython-shim.h>++newtype Float = Float (ForeignPtr Float)++instance Object Float where+	toObject (Float x) = SomeObject x+	fromForeignPtr = Float++instance Concrete Float where+	concreteType _ = floatType++{# fun pure hscpython_PyFloat_Type as floatType+	{} -> `Type' peekStaticObject* #}++{# fun PyFloat_FromDouble as toFloat+	{ realToFrac `Double'+	} -> `Float' stealObject* #}++{# fun PyFloat_AsDouble as fromFloat+	{ withObject* `Float'+	} -> `Double' realToFrac #}
+ lib/CPython/Types/Function.chs view
@@ -0,0 +1,130 @@+-- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>+-- +-- 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 <http://www.gnu.org/licenses/>.+-- +{-# LANGUAGE ForeignFunctionInterface #-}+module CPython.Types.Function+	( Function+	, functionType+	, new+	, getCode+	, getGlobals+	, getModule+	, getDefaults+	, setDefaults+	, getClosure+	, setClosure+	, getAnnotations+	, setAnnotations+	) where+import CPython.Internal hiding (new)+import CPython.Types.Code (Code)+import qualified CPython.Constants as Const++#include <hscpython-shim.h>++newtype Function = Function (ForeignPtr Function)++instance Object Function where+	toObject (Function x) = SomeObject x+	fromForeignPtr = Function++instance Concrete Function where+	concreteType _ = functionType++{# fun pure hscpython_PyFunction_Type as functionType+	{} -> `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.+-- +-- 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* #}++-- | Return the code object associated with a function.+-- +{# fun PyFunction_GetCode as getCode+	{ withObject* `Function'+	} -> `Code' peekObject* #}++-- | Return the globals dictionary associated with a function.+-- +{# fun PyFunction_GetGlobals as getGlobals+	{ 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* #}++withNullableObject :: Object obj => Maybe obj -> (Ptr a -> IO b) -> IO b+withNullableObject Nothing io = do+	none <- Const.none+	withObject none io+withNullableObject (Just obj) io = withObject obj io++peekNullableObject :: Object obj => Ptr a -> IO (Maybe obj)+peekNullableObject = maybePeek peekObject++-- | 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* #}++-- | Set the default values for a function.+-- +{# fun PyFunction_SetDefaults as setDefaults+	{ 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* #}++-- | Set the closure associated with a function. The tuple should contain+-- 'Cell's.+-- +{# fun PyFunction_SetClosure as setClosure+	{ 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* #}++-- | Set the annotations for a function object.+-- +{# fun PyFunction_SetAnnotations as setAnnotations+	{ withObject* `Function'+	, withNullableObject* `Maybe Dictionary'+	} -> `()' checkStatusCode* #}
+ lib/CPython/Types/InstanceMethod.chs view
@@ -0,0 +1,46 @@+-- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>+-- +-- 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 <http://www.gnu.org/licenses/>.+-- +{-# LANGUAGE ForeignFunctionInterface #-}+module CPython.Types.InstanceMethod+	( InstanceMethod+	, instanceMethodType+	, new+	, function+	) where+import CPython.Internal hiding (new)++#include <hscpython-shim.h>++newtype InstanceMethod = InstanceMethod (ForeignPtr InstanceMethod)++instance Object InstanceMethod where+	toObject (InstanceMethod x) = SomeObject x+	fromForeignPtr = InstanceMethod++instance Concrete InstanceMethod where+	concreteType _ = instanceMethodType++{# fun pure hscpython_PyInstanceMethod_Type as instanceMethodType+	{} -> `Type' peekStaticObject* #}++{# fun PyInstanceMethod_New as new+	`Object func' =>+	{ withObject* `func'+	} -> `InstanceMethod' stealObject* #}++{# fun PyInstanceMethod_Function as function+	{ withObject* `InstanceMethod'+	} -> `SomeObject' peekObject* #}
+ lib/CPython/Types/Integer.chs view
@@ -0,0 +1,63 @@+-- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>+-- +-- 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 <http://www.gnu.org/licenses/>.+-- +{-# LANGUAGE ForeignFunctionInterface #-}+module CPython.Types.Integer+	( Integer+	, integerType+	, toInteger+	, fromInteger+	) where+import Prelude hiding (Integer, toInteger, fromInteger)+import qualified Prelude as Prelude+import qualified Data.Text as T+import CPython.Internal+import qualified CPython.Types.Unicode as U+import qualified CPython.Protocols.Object as O++#include <hscpython-shim.h>++newtype Integer = Integer (ForeignPtr Integer)++instance Object Integer where+	toObject (Integer x) = SomeObject x+	fromForeignPtr = Integer++instance Concrete Integer where+	concreteType _ = integerType++{# fun pure hscpython_PyLong_Type as integerType+	{} -> `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++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
+ lib/CPython/Types/Iterator.chs view
@@ -0,0 +1,78 @@+-- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>+-- +-- 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 <http://www.gnu.org/licenses/>.+-- +{-# LANGUAGE ForeignFunctionInterface #-}+module CPython.Types.Iterator+	( SequenceIterator+	, sequenceIteratorType+	, sequenceIteratorNew+	+	, CallableIterator+	, callableIteratorType+	, callableIteratorNew+	) where+import CPython.Internal++#include <hscpython-shim.h>++newtype SequenceIterator = SequenceIterator (ForeignPtr SequenceIterator)++instance Iterator SequenceIterator where+	toIterator = unsafeCastToIterator++instance Object SequenceIterator where+	toObject (SequenceIterator x) = SomeObject x+	fromForeignPtr = SequenceIterator++instance Concrete SequenceIterator where+	concreteType _ = sequenceIteratorType++newtype CallableIterator = CallableIterator (ForeignPtr CallableIterator)++instance Iterator CallableIterator where+	toIterator = unsafeCastToIterator++instance Object CallableIterator where+	toObject (CallableIterator x) = SomeObject x+	fromForeignPtr = CallableIterator++instance Concrete CallableIterator where+	concreteType _ = callableIteratorType++{# fun pure hscpython_PySeqIter_Type as sequenceIteratorType+	{} -> `Type' peekStaticObject* #}++{# fun pure hscpython_PyCallIter_Type as callableIteratorType+	{} -> `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* #}++-- | 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* #}
+ lib/CPython/Types/List.chs view
@@ -0,0 +1,160 @@+-- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>+-- +-- 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 <http://www.gnu.org/licenses/>.+-- +{-# LANGUAGE ForeignFunctionInterface #-}+module CPython.Types.List+	( List+	, listType+	, toList+	, iterableToList+	, fromList+	, length+	, getItem+	, setItem+	, insert+	, append+	, getSlice+	, setSlice+	, sort+	, reverse+	, toTuple+	) where+import Prelude hiding (reverse, length)+import CPython.Internal hiding (new)+import qualified CPython.Types.Tuple as T++#include <hscpython-shim.h>++instance Concrete List where+	concreteType _ = listType++{# fun pure hscpython_PyList_Type as listType+	{} -> `Type' peekStaticObject* #}++toList :: [SomeObject] -> IO List+toList xs =+	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++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++{# fun PyList_Size as length+	{ 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* #}++-- | 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++-- | 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* #}++-- | 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* #}++-- | 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* #}++-- | Sets the slice of a list between /low/ and /high/ to the contents of+-- a replacement list. Analogous to @list[low:high] = replacement@. The+-- replacement may be 'Nothing', indicating the assignment of an empty list+-- (slice deletion). Negative indices, as when slicing from Python, are not+-- supported.+-- +setSlice+	:: 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++-- | Sort the items of a list in place. This is equivalent to @list.sort()@.+-- +{# fun PyList_Sort as sort+	{ 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* #}++-- | Return a new 'Tuple' containing the contents of a list; equivalent to+-- @tuple(list)@.+-- +{# fun PyList_AsTuple as toTuple+	{ withObject* `List'+	} -> `Tuple' stealObject* #}
+ lib/CPython/Types/Method.chs view
@@ -0,0 +1,52 @@+-- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>+-- +-- 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 <http://www.gnu.org/licenses/>.+-- +{-# LANGUAGE ForeignFunctionInterface #-}+module CPython.Types.Method+	( Method+	, methodType+	, new+	, function+	, self+	) where+import CPython.Internal hiding (new)++#include <hscpython-shim.h>++newtype Method = Method (ForeignPtr Method)++instance Object Method where+	toObject (Method x) = SomeObject x+	fromForeignPtr = Method++instance Concrete Method where+	concreteType _ = methodType++{# fun pure hscpython_PyMethod_Type as methodType+	{} -> `Type' peekStaticObject* #}++{# fun PyMethod_New as new+	`(Object func, Object self)' =>+	{ withObject* `func'+	, withObject* `self'+	} -> `Method' stealObject* #}++{# fun PyMethod_Function as function+	{ withObject* `Method'+	} -> `SomeObject' peekObject* #}++{# fun PyMethod_Self as self+	{ withObject* `Method'+	} -> `SomeObject' peekObject* #}
+ lib/CPython/Types/Module.chs view
@@ -0,0 +1,133 @@+-- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>+-- +-- 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 <http://www.gnu.org/licenses/>.+-- +{-# LANGUAGE ForeignFunctionInterface #-}+module CPython.Types.Module+	( Module+	, moduleType+	, new+	, getDictionary+	, getName+	, getFilename+	, addObject+	, addIntegerConstant+	, addTextConstant+	, importModule+	, reload+	) where+import Prelude hiding (toInteger)+import Data.Text (Text)+import CPython.Internal hiding (new)+import CPython.Types.Integer (toInteger)+import CPython.Types.Unicode (toUnicode)++#include <hscpython-shim.h>++newtype Module = Module (ForeignPtr Module)++instance Object Module where+	toObject (Module x) = SomeObject x+	fromForeignPtr = Module++instance Concrete Module where+	concreteType _ = moduleType++{# fun pure hscpython_PyModule_Type as moduleType+	{} -> `Type' peekStaticObject* #}++-- | Return a new module object with the @__name__@ attribute set. Only the+-- module&#x2019;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* #}++-- | Return the dictionary object that implements a module&#x2019;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&#x2019;s @__dict__@.+-- +{# fun PyModule_GetDict as getDictionary+	{ withObject* `Module'+	} -> `Dictionary' peekObject* #}++-- | Returns a module&#x2019;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++-- | Returns the name of the file from which a module was loaded using the+-- module&#x2019;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++-- | Add an object to a module with the given name. This is a convenience+-- computation which can be used from the module&#x2019;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++-- | Add an integer constant to a module. This convenience computation can be+-- used from the module&#x2019;s initialization computation.+-- +addIntegerConstant :: Module -> Text -> Integer -> IO ()+addIntegerConstant m name value = toInteger value >>= addObject m name++-- | Add a string constant to a module. This convenience computation can be+-- used from the module&#x2019;s initialization computation.+-- +addTextConstant :: Module -> Text -> Text -> IO ()+addTextConstant m name value = toUnicode value >>= addObject m name++-- | This is a higher-level interface that calls the current &#x201c;import+-- hook&#x201d; (with an explicit level of @0@, meaning absolute import). It+-- invokes the @__import__()@ computation from the @__builtins__@ of the+-- current globals. This means that the import is done using whatever import+-- hooks are installed in the current environment.+-- +-- 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++-- | 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* #}
+ lib/CPython/Types/Set.chs view
@@ -0,0 +1,156 @@+-- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>+-- +-- 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 <http://www.gnu.org/licenses/>.+-- +{-# LANGUAGE ForeignFunctionInterface #-}++-- | Any functionality not listed below is best accessed using the either+-- the 'Object' protocol (including 'callMethod', 'richCompare', 'hash',+-- 'repr', 'isTrue', and 'getIter') or the 'Number' protocol (including 'and',+-- '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+import CPython.Internal+import CPython.Types.Tuple (toTuple, iterableToTuple, fromTuple)++#include <hscpython-shim.h>++class Object a => AnySet a++newtype Set = Set (ForeignPtr Set)++instance Object Set where+	toObject (Set x) = SomeObject x+	fromForeignPtr = Set++instance Concrete Set where+	concreteType _ = setType++newtype FrozenSet = FrozenSet (ForeignPtr FrozenSet)++instance Object FrozenSet where+	toObject (FrozenSet x) = SomeObject x+	fromForeignPtr = FrozenSet++instance Concrete FrozenSet where+	concreteType _ = frozenSetType++instance AnySet Set+instance AnySet FrozenSet++{# fun pure hscpython_PySet_Type as setType+	{} -> `Type' peekStaticObject* #}++{# fun pure hscpython_PyFrozenSet_Type as frozenSetType+	{} -> `Type' peekStaticObject* #}++toSet :: [SomeObject] -> IO Set+toSet xs = toTuple xs >>= iterableToSet++toFrozenSet :: [SomeObject] -> IO FrozenSet+toFrozenSet xs = toTuple xs >>= iterableToFrozenSet++-- | Return a new 'Set' from the contents of an iterable 'Object'. The object+-- 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* #}++-- | 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* #}++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* #}++-- | 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* #}++-- | Add /key/ to a 'Set'. Also works with 'FrozenSet' (like+-- 'CPython.Types.Tuple.setItem' it can be used to fill-in the values of+-- brand new 'FrozenSet's before they are exposed to other code). Throws a+-- @TypeError@ if the key is unhashable. Throws a @MemoryError@ if there is+-- no room to grow.+-- +{# fun PySet_Add as add+	`(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@+-- if /key/ is unhashable. Unlike the Python @discard()@ method, this+-- computation does not automatically convert unhashable sets into temporary+-- 'FrozenSet's.+-- +{# fun PySet_Discard as discard+	`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* #}++-- | Remove all elements from a set.+-- +{# fun PySet_Clear as clear+	{ withObject* `Set'+	} -> `()' checkStatusCode* #}
+ lib/CPython/Types/Slice.chs view
@@ -0,0 +1,73 @@+-- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>+-- +-- 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 <http://www.gnu.org/licenses/>.+-- +{-# LANGUAGE ForeignFunctionInterface #-}+module CPython.Types.Slice+	( Slice+	, sliceType+	, new+	, getIndices+	) where+import Prelude hiding (length)+import CPython.Internal hiding (new)++#include <hscpython-shim.h>++newtype Slice = Slice (ForeignPtr Slice)++instance Object Slice where+	toObject (Slice x) = SomeObject x+	fromForeignPtr = Slice++instance Concrete Slice where+	concreteType _ = sliceType++{# fun pure hscpython_PySlice_Type as sliceType+	{} -> `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+-- attributes of the same names. Any of the values may be 'Nothing', in which+-- 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++-- | Retrieve the start, stop, step, and slice length from a 'Slice',+-- assuming a sequence of the given length.+-- +getIndices :: Slice+           -> 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)
+ lib/CPython/Types/Tuple.chs view
@@ -0,0 +1,89 @@+-- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>+-- +-- 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 <http://www.gnu.org/licenses/>.+-- +{-# LANGUAGE ForeignFunctionInterface #-}+module CPython.Types.Tuple+	( Tuple+	, tupleType+	, toTuple+	, iterableToTuple+	, fromTuple+	, length+	, getItem+	, getSlice+	, setItem+	) where+import Prelude hiding (length)+import CPython.Internal hiding (new)++#include <hscpython-shim.h>++instance Concrete Tuple where+	concreteType _ = tupleType++{# fun pure hscpython_PyTuple_Type as tupleType+	{} -> `Type' peekStaticObject* #}++toTuple :: [SomeObject] -> IO Tuple+toTuple xs =+	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++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++{# fun PyTuple_Size as length+	{ 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* #}++-- | 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* #}++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
+ lib/CPython/Types/Type.chs view
@@ -0,0 +1,38 @@+-- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>+-- +-- 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 <http://www.gnu.org/licenses/>.+-- +{-# LANGUAGE ForeignFunctionInterface #-}+module CPython.Types.Type+	( Type+	, typeType+	, isSubtype+	) where+import CPython.Internal++#include <hscpython-shim.h>++instance Concrete Type where+	concreteType _ = typeType++{# fun pure hscpython_PyType_Type as typeType+	{} -> `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' #}
+ lib/CPython/Types/Unicode.chs view
@@ -0,0 +1,326 @@+-- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>+-- +-- 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 <http://www.gnu.org/licenses/>.+-- +{-# LANGUAGE ForeignFunctionInterface #-}+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+#include <hscpython-shim.h>++import Prelude hiding (length)+import Control.Exception (ErrorCall (..), throwIO)+import qualified Data.Text as T+#ifdef Py_UNICODE_WIDE+import Data.Char (chr, ord)+#else+import qualified Data.Text.Foreign as TF+#endif+import CPython.Internal+import CPython.Types.Bytes (Bytes)++newtype Unicode = Unicode (ForeignPtr Unicode)++instance Object Unicode where+	toObject (Unicode x) = SomeObject x+	fromForeignPtr = Unicode++instance Concrete Unicode where+	concreteType _ = unicodeType++type Encoding = T.Text+data ErrorHandling+	= 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"++{# fun pure hscpython_PyUnicode_Type as unicodeType+	{} -> `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'+#ifdef Py_UNICODE_WIDE+	ords = map (fromIntegral . ord) (T.unpack str) :: [CUInt]+	withBuffer = withArrayLen ords . flip+#else+	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+#ifdef Py_UNICODE_WIDE+	raw <- peekArray (fromIntegral size) buffer+	return . T.pack $ map (chr . fromIntegral) raw+#else+	TF.fromPtr (castPtr buffer) (fromIntegral size)+#endif++{# fun hscpython_PyUnicode_GetSize as length+	{ withObject* `Unicode'+	} -> `Integer' checkIntReturn* #}++-- | Coerce an encoded object /obj/ to an Unicode object.+-- +-- 'Bytes' and other char buffer compatible objects are decoded according to+-- the given encoding and error handling mode.+-- +-- 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* #}++-- | Shortcut for @'fromEncodedObject' \"utf-8\" 'Strict'@+-- +fromObject :: Object obj => obj -> IO Unicode+fromObject obj = fromEncodedObject obj (T.pack "utf-8") Strict++-- | Encode a 'Unicode' object and return the result as 'Bytes' object.+-- The encoding and error mode have the same meaning as the parameters of+-- 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* #}++-- | Create a 'Unicode' object by decoding a 'Bytes' object. The encoding and+-- error mode have the same meaning as the parameters of the the+-- @str.encode()@ method. The codec to be used is looked up using the Python+-- 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++{# fun hscpython_PyUnicode_Concat as append+	{ 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+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++-- | 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* #}++-- | Translate a string by applying a character mapping table to it.+-- +-- The mapping table must map Unicode ordinal integers to Unicode ordinal+-- integers or @None@ (causing deletion of the character).+-- +-- Mapping tables need only provide the @__getitem__()@ interface;+-- dictionaries and sequences work well. Unmapped character ordinals (ones+-- which cause a @LookupError@) are left untouched and are copied as-is.+-- +-- 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* #}++-- | Join a sequence of strings using the given separator.+-- +{# fun hscpython_PyUnicode_Join as join+	`Sequence seq' =>+	{ withObject* `Unicode'+	, withObject* `seq'+	} -> `Unicode' stealObject* #}++data MatchDirection = Prefix | Suffix+	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+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++data FindDirection = Forwards | Backwards+	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)+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++-- | 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+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++-- | 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+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++-- | 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* #}++-- | 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* #}
+ lib/CPython/Types/WeakReference.chs view
@@ -0,0 +1,73 @@+-- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>+-- +-- 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 <http://www.gnu.org/licenses/>.+-- +{-# LANGUAGE ForeignFunctionInterface #-}+module CPython.Types.WeakReference+	( Reference+	, Proxy+	, newReference+	, newProxy+	, getObject+	) where+import CPython.Internal++#include <hscpython-shim.h>++newtype Reference = Reference (ForeignPtr Reference)+instance Object Reference where+	toObject (Reference x) = SomeObject x+	fromForeignPtr = Reference++newtype Proxy = Proxy (ForeignPtr Proxy)+instance Object Proxy where+	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+-- reference object may be returned. The second parameter, /callback/, can+-- be a callable object that receives notification when /obj/ is garbage+-- collected; it should accept a single parameter, which will be the weak+-- reference object itself. If ob is not a weakly-referencable object, or if+-- /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++-- | 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+-- proxy may be returned. The second parameter, /callback/, can be a callable+-- object that receives notification when /obj/ is garbage collected; it+-- should accept a single parameter, which will be the weak reference object+-- itself. If ob is not a weakly-referencable object, or if /callback/ is not+-- 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++-- | 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* #}