├── debian ├── compat ├── pycompat ├── docs ├── missingpy.doc-base.EX ├── copyright ├── control ├── rules └── changelog ├── testsrc ├── gzfiles │ ├── t1.gz │ ├── t2.gz │ ├── empty.gz │ ├── t1bad.gz │ └── zeros.gz ├── bz2files │ ├── t1.bz2 │ ├── t2.bz2 │ ├── empty.bz2 │ └── zeros.bz2 ├── runtests.hs ├── AnyDBMPytest.hs ├── Tests.hs ├── Testutil.hs ├── Exceptionstest.hs ├── Interpretertest.hs ├── BZip2test.hs ├── GZiptest.hs ├── Dicttest.hs ├── AnyDBMtest.hs └── Objectstest.hs ├── utils └── missingh-0.9.0-doc.tar.gz ├── exceptionlist ├── examples ├── PythonThreads.py ├── HaskellThreads.hs └── PythonThreads.hs ├── INSTALL ├── COPYRIGHT ├── glue ├── glue.h ├── glue.c ├── excglue.h └── excglue.c ├── MissingPy.cabal ├── Setup.hs ├── Makefile ├── README ├── MissingPy ├── FileArchive │ ├── GZip.hs │ └── BZip2.hs └── AnyDBM.hs ├── Python ├── Types.hs ├── Exceptions.hs ├── Objects │ ├── Dict.hs │ └── File.hs ├── Utils.hs ├── ForeignImports.hsc ├── Exceptions │ └── ExcTypes.hsc ├── Interpreter.hs └── Objects.hs ├── genexceptions.hs └── COPYING /debian/compat: -------------------------------------------------------------------------------- 1 | 4 2 | -------------------------------------------------------------------------------- /debian/pycompat: -------------------------------------------------------------------------------- 1 | 2 2 | -------------------------------------------------------------------------------- /debian/docs: -------------------------------------------------------------------------------- 1 | README 2 | dist/doc/html/* 3 | -------------------------------------------------------------------------------- /testsrc/gzfiles/t1.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/softmechanics/missingpy/HEAD/testsrc/gzfiles/t1.gz -------------------------------------------------------------------------------- /testsrc/gzfiles/t2.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/softmechanics/missingpy/HEAD/testsrc/gzfiles/t2.gz -------------------------------------------------------------------------------- /testsrc/bz2files/t1.bz2: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/softmechanics/missingpy/HEAD/testsrc/bz2files/t1.bz2 -------------------------------------------------------------------------------- /testsrc/bz2files/t2.bz2: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/softmechanics/missingpy/HEAD/testsrc/bz2files/t2.bz2 -------------------------------------------------------------------------------- /testsrc/gzfiles/empty.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/softmechanics/missingpy/HEAD/testsrc/gzfiles/empty.gz -------------------------------------------------------------------------------- /testsrc/gzfiles/t1bad.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/softmechanics/missingpy/HEAD/testsrc/gzfiles/t1bad.gz -------------------------------------------------------------------------------- /testsrc/gzfiles/zeros.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/softmechanics/missingpy/HEAD/testsrc/gzfiles/zeros.gz -------------------------------------------------------------------------------- /testsrc/bz2files/empty.bz2: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/softmechanics/missingpy/HEAD/testsrc/bz2files/empty.bz2 -------------------------------------------------------------------------------- /testsrc/bz2files/zeros.bz2: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/softmechanics/missingpy/HEAD/testsrc/bz2files/zeros.bz2 -------------------------------------------------------------------------------- /utils/missingh-0.9.0-doc.tar.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/softmechanics/missingpy/HEAD/utils/missingh-0.9.0-doc.tar.gz -------------------------------------------------------------------------------- /exceptionlist: -------------------------------------------------------------------------------- 1 | Exception 2 | StandardError 3 | ArithmeticError 4 | LookupError 5 | AssertionError 6 | AttributeError 7 | EOFError 8 | EnvironmentError 9 | FloatingPointError 10 | IOError 11 | ImportError 12 | IndexError 13 | KeyError 14 | KeyboardInterrupt 15 | MemoryError 16 | NameError 17 | NotImplementedError 18 | OSError 19 | OverflowError 20 | ReferenceError 21 | RuntimeError 22 | SyntaxError 23 | SystemError 24 | SystemExit 25 | TypeError 26 | ValueError 27 | ZeroDivisionError 28 | -------------------------------------------------------------------------------- /examples/PythonThreads.py: -------------------------------------------------------------------------------- 1 | import thread 2 | import time 3 | 4 | # adapted from http://www.tutorialspoint.com/python/python_multithreading.htm 5 | 6 | def print_time(name,delay): 7 | count = 0 8 | while count < 5: 9 | time.sleep(delay) 10 | count += 1 11 | print "%s: count %d" % (name, count) 12 | 13 | # other threads are not affected by exceptions 14 | raise Exception(name) 15 | 16 | def newThread(n): 17 | thread.start_new_thread(print_time, ("Thread-%d" % n,n)) 18 | 19 | -------------------------------------------------------------------------------- /debian/missingpy.doc-base.EX: -------------------------------------------------------------------------------- 1 | Document: missingh 2 | Title: Debian missingh Manual 3 | Author: 4 | Abstract: This manual describes what missingh is 5 | and how it can be used to 6 | manage online manuals on Debian systems. 7 | Section: unknown 8 | 9 | Format: debiandoc-sgml 10 | Files: /usr/share/doc/missingh/missingh.sgml.gz 11 | 12 | Format: postscript 13 | Files: /usr/share/doc/missingh/missingh.ps.gz 14 | 15 | Format: text 16 | Files: /usr/share/doc/missingh/missingh.text.gz 17 | 18 | Format: HTML 19 | Index: /usr/share/doc/missingh/html/index.html 20 | Files: /usr/share/doc/missingh/html/*.html 21 | 22 | 23 | -------------------------------------------------------------------------------- /examples/HaskellThreads.hs: -------------------------------------------------------------------------------- 1 | {- Example demonstrating multiple haskell threads calling into python runtime -} 2 | 3 | import Text.Printf 4 | import Python.Exceptions 5 | import Python.Interpreter 6 | import Control.Exception 7 | import Control.Concurrent 8 | import Control.Concurrent.MVar 9 | import Control.Monad 10 | 11 | pythonFunction :: MVar Int -> Int -> IO () 12 | pythonFunction done n = do 13 | finally (withGIL $ handlePy exc2ioerror $ do pyRun_SimpleString $ printf "print '%d'" n) 14 | (do modifyMVar_ done $ return . (+1)) -- signal that thread is finished 15 | 16 | untilM :: IO Bool -> IO () 17 | untilM pred = do 18 | v <- pred 19 | if v then return () else yield >> untilM pred 20 | 21 | main = do 22 | py_initialize 23 | done <- newMVar 0 24 | let n = 40 25 | mapM_ (forkIO . pythonFunction done) [1..(n :: Int)] 26 | 27 | -- wait for threads to finish 28 | untilM $ do 29 | d <- readMVar done 30 | return $ d == n 31 | 32 | -------------------------------------------------------------------------------- /testsrc/runtests.hs: -------------------------------------------------------------------------------- 1 | {- arch-tag: Test runner 2 | Copyright (C) 2004 John Goerzen 3 | 4 | This program is free software; you can redistribute it and/or modify 5 | it under the terms of the GNU General Public License as published by 6 | the Free Software Foundation; either version 2 of the License, or 7 | (at your option) any later version. 8 | 9 | This program is distributed in the hope that it will be useful, 10 | but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | GNU General Public License for more details. 13 | 14 | You should have received a copy of the GNU General Public License 15 | along with this program; if not, write to the Free Software 16 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 17 | -} 18 | 19 | module Main where 20 | 21 | import Test.HUnit 22 | import Tests 23 | import Python.Interpreter 24 | 25 | main = do py_initialize 26 | runTestTT tests 27 | 28 | -------------------------------------------------------------------------------- /INSTALL: -------------------------------------------------------------------------------- 1 | INSTALLATION INSTRUCTIONS 2 | ------------------------- 3 | 4 | Before you start, you will of course need to have Python installed, 5 | version 2.3 or better. Get it from www.python.org if you don't have 6 | it already. It's very portable and easily built. 7 | 8 | Now, you're ready to build MissingPy. 9 | 10 | You'll need GHC 6.8. 11 | 12 | Next, download and install MissingH, version 1.0.1 or above. Grab it 13 | from http://software.complete.org/missingh. Debian users can 14 | apt-get install libghc6-missingh-dev. 15 | 16 | This will generate the build file MissingPy.cabal. Look at the 17 | declarations near the top and edit them if necessary. 18 | 19 | Now, run "make setup" (you may need to edit the Makefile if you don't 20 | use GHC or if your GHC is at an unusual location). 21 | 22 | Then: 23 | 24 | ./setup configure 25 | ./setup build 26 | ./setup install 27 | 28 | Optionally, to run the unit tests, you'll need to install HUnit. Then: 29 | 30 | make test 31 | 32 | (More to come in this file) 33 | -------------------------------------------------------------------------------- /COPYRIGHT: -------------------------------------------------------------------------------- 1 | MissingPy: Haskell Python Interface libraries 2 | Copyright (C) 2004 - 2008 John Goerzen 3 | 4 | All code is under the following license unless otherwise noted: 5 | This program is free software; you can redistribute it and/or modify 6 | it under the terms of the GNU General Public License as published by 7 | the Free Software Foundation; either version 2 of the License, or 8 | (at your option) any later version. 9 | 10 | This program is distributed in the hope that it will be useful, 11 | but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | GNU General Public License for more details. 14 | 15 | You should have received a copy of the GNU General Public License 16 | along with this program; if not, write to the Free Software 17 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 18 | 19 | The GNU General Public License is available in the file COPYING in the source 20 | distribution. Debian GNU/Linux users may find this in 21 | /usr/share/common-licenses/GPL-2. 22 | 23 | If the GPL is unacceptable for your uses, please e-mail me; alternative 24 | terms can be negotiated for your project. 25 | -------------------------------------------------------------------------------- /glue/glue.h: -------------------------------------------------------------------------------- 1 | /* arch-tag: Python Utility Functions, header file 2 | Copyright (C) 2005 John Goerzen 3 | 4 | This program is free software; you can redistribute it and/or modify 5 | it under the terms of the GNU General Public License as published by 6 | the Free Software Foundation; either version 2 of the License, or 7 | (at your option) any later version. 8 | 9 | This program is distributed in the hope that it will be useful, 10 | but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | GNU General Public License for more details. 13 | 14 | You should have received a copy of the GNU General Public License 15 | along with this program; if not, write to the Free Software 16 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 17 | */ 18 | 19 | #include 20 | extern void hspy_decref(PyObject *o); 21 | extern void hspy_incref(PyObject *o); 22 | extern PyObject ** hspy_getexc(); 23 | extern int hspy_list_check(PyObject *o); 24 | extern int hspy_tuple_check(PyObject *o); 25 | extern PyObject *hspy_none(void); 26 | 27 | /* These are now macros */ 28 | extern PyObject *glue_PyMapping_Keys(PyObject *o); 29 | extern PyObject *glue_PyMapping_Items(PyObject *o); 30 | -------------------------------------------------------------------------------- /debian/copyright: -------------------------------------------------------------------------------- 1 | MissingPy: Haskell Python Interface libraries 2 | Copyright (C) 2004-2008 John Goerzen 3 | 4 | All code is under the following license unless otherwise noted: 5 | This program is free software; you can redistribute it and/or modify 6 | it under the terms of the GNU General Public License as published by 7 | the Free Software Foundation; either version 2 of the License, or 8 | (at your option) any later version. 9 | 10 | This program is distributed in the hope that it will be useful, 11 | but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | GNU General Public License for more details. 14 | 15 | You should have received a copy of the GNU General Public License 16 | along with this program; if not, write to the Free Software 17 | Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. 18 | 19 | The GNU General Public License is available in the file COPYING in the source 20 | distribution. Debian GNU/Linux users may find this in 21 | /usr/share/common-licenses/GPL-2. 22 | 23 | If the GPL is unacceptable for your uses, please e-mail me; alternative 24 | terms can be negotiated for your project. 25 | 26 | arch-tag: copyright statement 27 | -------------------------------------------------------------------------------- /examples/PythonThreads.hs: -------------------------------------------------------------------------------- 1 | import Python.Interpreter 2 | import Python.Exceptions 3 | 4 | import Control.Concurrent 5 | import Control.Monad 6 | import System.IO 7 | import Text.Printf 8 | 9 | {- Example demonstrating a multithreaded python program. 10 | - Python runs on haskell's threads, so we periodically 11 | - acquire the Global Interpreter Lock to make some progress, 12 | - releasing it again so other haskell threads can call into 13 | - python (e.g. to spawn more python threads). 14 | - 15 | - to run, add the examples folder to PYTHONPATH, or else PyMultiThread module 16 | - won't be found. 17 | -} 18 | 19 | 20 | {- This is a hack to get the python runtime to run suspended 21 | - python threads (using GHC's thread). There may be a better 22 | - way to do this. 23 | -} 24 | poller = forever $ do 25 | withGIL $ pyRun_SimpleString "time.sleep(1)" 26 | yield 27 | 28 | pyNewThread :: Int -> IO () 29 | pyNewThread n = do 30 | withGIL $ pyRun_SimpleString $ printf "PythonThreads.newThread(%d)" n 31 | printf "spawned thread %d\n" n 32 | 33 | main = do 34 | py_initializeThreaded 35 | handlePy (\e -> print =<< formatException e) $ do 36 | pyImport "PythonThreads" 37 | pyImport "time" 38 | pyNewThread 1 39 | pyNewThread 2 40 | 41 | -- nothing happens until we start poller 42 | threadDelay 2000000 43 | forkIO $ poller 44 | threadDelay 10000000 45 | 46 | -------------------------------------------------------------------------------- /testsrc/AnyDBMPytest.hs: -------------------------------------------------------------------------------- 1 | {- arch-tag: AnyDBM tests for Python 2 | Copyright (C) 2004-2005 John Goerzen 3 | 4 | This program is free software; you can redistribute it and/or modify 5 | it under the terms of the GNU General Public License as published by 6 | the Free Software Foundation; either version 2 of the License, or 7 | (at your option) any later version. 8 | 9 | This program is distributed in the hope that it will be useful, 10 | but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | GNU General Public License for more details. 13 | 14 | You should have received a copy of the GNU General Public License 15 | along with this program; if not, write to the Free Software 16 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 17 | -} 18 | 19 | module AnyDBMPytest(tests) where 20 | import Test.HUnit 21 | import MissingPy.AnyDBM 22 | import AnyDBMtest hiding (tests) 23 | 24 | testmod m = generic_persist_test (return ()) 25 | (\f -> openSpecificDBM m ("testtmp/" ++ m) DBM_ReadWriteCreate) 26 | ++ 27 | generic_test (return ()) 28 | (\f -> openSpecificDBM m ("testtmp/" ++ m) DBM_ReadWriteCreate) 29 | 30 | tests = TestList [TestLabel "anydbm" (TestList $ testmod "anydbm") 31 | ,TestLabel "dbhash" (TestList $ testmod "dbhash") 32 | -- ,TestLabel "dbm" (TestList $ testmod "dbm") 33 | ,TestLabel "dumbdbm" (TestList $ testmod "dumbdbm") 34 | ,TestLabel "gdbm" (TestList $ testmod "gdbm") 35 | ] 36 | 37 | 38 | 39 | 40 | -------------------------------------------------------------------------------- /testsrc/Tests.hs: -------------------------------------------------------------------------------- 1 | {- arch-tag: Tests main file 2 | Copyright (C) 2004 - 2005 John Goerzen 3 | 4 | This program is free software; you can redistribute it and/or modify 5 | it under the terms of the GNU General Public License as published by 6 | the Free Software Foundation; either version 2 of the License, or 7 | (at your option) any later version. 8 | 9 | This program is distributed in the hope that it will be useful, 10 | but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | GNU General Public License for more details. 13 | 14 | You should have received a copy of the GNU General Public License 15 | along with this program; if not, write to the Free Software 16 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 17 | -} 18 | 19 | module Tests(tests) where 20 | import Test.HUnit 21 | import qualified Interpretertest 22 | import qualified Objectstest 23 | import qualified Exceptionstest 24 | import qualified GZiptest 25 | import qualified BZip2test 26 | import qualified Dicttest 27 | import qualified AnyDBMPytest 28 | 29 | test1 = TestCase ("x" @=? "x") 30 | 31 | tests = TestList [TestLabel "test1" test1, 32 | TestLabel "objects" Objectstest.tests, 33 | TestLabel "interpreter" Interpretertest.tests, 34 | TestLabel "exceptions" Exceptionstest.tests, 35 | TestLabel "AnyDBM/Dict" Dicttest.tests, 36 | TestLabel "AnyDBM/dbm" AnyDBMPytest.tests, 37 | TestLabel "bzip2" BZip2test.tests, 38 | TestLabel "gzip" GZiptest.tests 39 | ] 40 | 41 | 42 | 43 | -------------------------------------------------------------------------------- /debian/control: -------------------------------------------------------------------------------- 1 | Source: missingpy 2 | Priority: optional 3 | Maintainer: John Goerzen 4 | XS-Python-Version: current 5 | Build-Depends: debhelper (>= 5.0.37.2), ghc6 (>= 6.8.2dfsg1), haskell-devscripts (>= 0.6.15), python-dev (>= 2.5), python-gdbm (>= 2.3.3), haddock, libghc6-missingh-dev (>= 1.0.3.2), python-central (>= 0.5), libghc6-anydbm-dev (>= 1.0.5.4), libghc6-regex-compat-dev, libghc6-regex-base-dev, libghc6-regex-posix-dev 6 | #Build-Depends-Indep: debhelper (>= 4.0.0), haddock, hugs, haskell-devscripts (>= 0.6.15), libhugs-hunit 7 | Standards-Version: 3.6.1 8 | Section: devel 9 | VCS-Browser: http://git.complete.org/missingpy 10 | VCS-Git: git://git.complete.org/missingpy 11 | 12 | Package: libghc6-missingpy-dev 13 | Section: devel 14 | Architecture: any 15 | XB-Python-Version: ${python:Versions} 16 | Depends: ${haskell:Depends}, python-dev (>= 2.5), libghc6-missingh-dev (>= 1.0.1), libghc6-anydbm-dev, ${python:Depends}, libghc6-regex-base-dev, libghc6-regex-compat-dev, libghc6-regex-posix-dev 17 | Suggests: python-gdbm (>= 2.3.3) 18 | Description: Python interface and utility library for Haskell 19 | MissingPy is two things: 20 | . 21 | A Haskell binding for many C and Python libraries for tasks such as 22 | data compression, databases, etc. This can be found in the 23 | MissingPy module tree. 24 | . 25 | Also, it's a low-level Haskell binding to the Python interpreter to 26 | enable development of hybrid applications that use both 27 | environments. This can be found in the Python module tree. The 28 | Haskell bindings above use this environment. 29 | . 30 | MissingPy permits you to call Python code from Haskell. It does NOT 31 | permit you to call Haskell code from Python. 32 | . 33 | MissingPy is the companion to my MissingH library, and integrates with 34 | it. 35 | -------------------------------------------------------------------------------- /glue/glue.c: -------------------------------------------------------------------------------- 1 | /* arch-tag: Python Utility Functions 2 | Copyright (C) 2005 John Goerzen 3 | 4 | This program is free software; you can redistribute it and/or modify 5 | it under the terms of the GNU General Public License as published by 6 | the Free Software Foundation; either version 2 of the License, or 7 | (at your option) any later version. 8 | 9 | This program is distributed in the hope that it will be useful, 10 | but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | GNU General Public License for more details. 13 | 14 | You should have received a copy of the GNU General Public License 15 | along with this program; if not, write to the Free Software 16 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 17 | */ 18 | 19 | #include 20 | 21 | void hspy_decref(PyObject *o) { 22 | Py_DECREF(o); 23 | } 24 | 25 | void hspy_incref(PyObject *o) { 26 | Py_INCREF(o); 27 | } 28 | 29 | int hspy_list_check(PyObject *o) { 30 | return PyList_Check(o); 31 | } 32 | 33 | int hspy_tuple_check(PyObject *o) { 34 | return PyTuple_Check(o); 35 | } 36 | 37 | PyObject ** hspy_getexc(void) { 38 | static PyObject *retval [3]; 39 | PyObject *type; 40 | PyObject *val; 41 | PyObject *tb; 42 | 43 | PyErr_Fetch(&type, &val, &tb); 44 | PyErr_NormalizeException(&type, &val, &tb); 45 | retval[0] = type; 46 | retval[1] = val; 47 | retval[2] = tb; 48 | PyErr_Clear(); 49 | return retval; 50 | } 51 | 52 | PyObject *hspy_none(void) { 53 | Py_INCREF(Py_None); 54 | return Py_None; 55 | } 56 | 57 | PyObject *glue_PyMapping_Keys(PyObject *o) { 58 | return PyMapping_Keys(o); 59 | } 60 | 61 | PyObject *glue_PyMapping_Items(PyObject *o) { 62 | return PyMapping_Items(o); 63 | } 64 | -------------------------------------------------------------------------------- /testsrc/Testutil.hs: -------------------------------------------------------------------------------- 1 | {- arch-tag: Test utilities 2 | Copyright (C) 2004 John Goerzen 3 | 4 | This program is free software; you can redistribute it and/or modify 5 | it under the terms of the GNU General Public License as published by 6 | the Free Software Foundation; either version 2 of the License, or 7 | (at your option) any later version. 8 | 9 | This program is distributed in the hope that it will be useful, 10 | but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | GNU General Public License for more details. 13 | 14 | You should have received a copy of the GNU General Public License 15 | along with this program; if not, write to the Free Software 16 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 17 | -} 18 | 19 | module Testutil(assertRaises, mapassertEqual) where 20 | import Test.HUnit 21 | import qualified Control.Exception 22 | 23 | assertRaises :: Show a => String -> Control.Exception.Exception -> IO a -> IO () 24 | assertRaises msg selector action = 25 | let thetest e = if e == selector then return () 26 | else assertFailure $ msg ++ "\nReceived unexpected exception: " 27 | ++ (show e) ++ "\ninstead of exception: " ++ (show selector) 28 | in do 29 | r <- Control.Exception.try action 30 | case r of 31 | Left e -> thetest e 32 | Right x -> assertFailure $ msg ++ "\nReceived no exception, but was expecting exception: " ++ (show selector) 33 | 34 | mapassertEqual :: (Show b, Eq b) => String -> (a -> b) -> [(a, b)] -> [Test] 35 | mapassertEqual descrip func [] = [] 36 | mapassertEqual descrip func ((inp,result):xs) = 37 | (TestCase $ assertEqual descrip result (func inp)) : mapassertEqual descrip func xs 38 | -------------------------------------------------------------------------------- /MissingPy.cabal: -------------------------------------------------------------------------------- 1 | Name: MissingPy 2 | Version: 0.10.6 3 | License: MIT 4 | Maintainer: Matt Brown 5 | Author: John Goerzen 6 | license-file: COPYRIGHT 7 | extra-source-files: COPYING, genexceptions.hs, README, INSTALL, 8 | glue/excglue.h, glue/glue.h 9 | Stability: Alpha 10 | Copyright: Copyright (c) 2005-2008 John Goerzen 11 | Synopsis: Haskell interface to Python 12 | Homepage: http://github.com/softmechanics/missingpy 13 | Bug-reports: http://github.com/softmechanics/missingpy/issues 14 | Description: MissingPy is two things: 15 | . 16 | A Haskell binding for many C and Python libraries for tasks such as 17 | data compression, databases, etc. This can be found in the 18 | MissingPy module tree. 19 | . 20 | Also, it's a low-level Haskell binding to the Python interpreter to 21 | enable development of hybrid applications that use both 22 | environments. This can be found in the Python module tree. The 23 | Haskell bindings above use this environment. 24 | . 25 | MissingPy permits you to call Python code from Haskell. It does NOT 26 | permit you to call Haskell code from Python. 27 | . 28 | MissingPy is the companion to my MissingH library, and integrates with 29 | it. 30 | 31 | Build-Type: Custom 32 | cabal-version: >= 1.6 33 | 34 | Library 35 | Exposed-Modules: Python.Types, 36 | Python.Utils, 37 | Python.Objects, 38 | Python.Interpreter, 39 | Python.Exceptions, 40 | Python.Exceptions.ExcTypes, 41 | Python.Objects.File, 42 | Python.Objects.Dict, 43 | MissingPy.FileArchive.GZip, 44 | MissingPy.FileArchive.BZip2, 45 | MissingPy.AnyDBM 46 | Other-Modules: Python.ForeignImports 47 | Build-Depends: base == 4.*, MissingH>=1.0.1, anydbm>=1.0.5 48 | C-Sources: glue/glue.c glue/excglue.c 49 | Extensions: ForeignFunctionInterface, TypeSynonymInstances, 50 | FlexibleInstances 51 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env runhaskell 2 | 3 | import Distribution.PackageDescription 4 | import Distribution.Simple 5 | import Distribution.Simple.LocalBuildInfo 6 | import Distribution.Simple.Program 7 | import Distribution.PackageDescription.Parse (writeHookedBuildInfo) 8 | import qualified Distribution.Verbosity as Verbosity 9 | import Data.List 10 | 11 | main = defaultMainWithHooks autoconfUserHooks { 12 | hookedPrograms = [pyConfigProgram], 13 | postConf=configure 14 | } 15 | 16 | pyConfigProgram = (simpleProgram "python") 17 | 18 | configure _ _ _ lbi = do 19 | mb_bi <- pyConfigBuildInfo Verbosity.normal lbi 20 | writeHookedBuildInfo "MissingPy.buildinfo" (mb_bi,[]) 21 | 22 | pyVersionDefines = [((<2.5), "PYTHON_PRE_2_5"), 23 | ((<2.3), "PYTHON_PRE_2_3")] 24 | 25 | definesFor v = map (\(_,d) -> "-D" ++ d) $ filter (\(f,_) -> f v) pyVersionDefines 26 | 27 | -- Populate BuildInfo using python tool. 28 | pyConfigBuildInfo verbosity lbi = do 29 | (pyConfigProg, _) <- requireProgram verbosity pyConfigProgram (withPrograms lbi) 30 | let python = rawSystemProgramStdout verbosity pyConfigProg 31 | libDir <- python ["-c", "from distutils.sysconfig import *; print get_python_lib()"] 32 | incDir <- python ["-c", "from distutils.sysconfig import *; print get_python_inc()"] 33 | confLibDir <- python ["-c", "from distutils.sysconfig import *; print get_config_var('LIBDIR')"] 34 | pyVersionStr <- python ["-c", "import sys; sys.stdout.write(\"%d.%d\" % (sys.version_info[0], sys.version_info[1]))"] 35 | let libName = "python" ++ pyVersionStr 36 | pyVersion = read pyVersionStr 37 | 38 | return $ Just emptyBuildInfo { 39 | extraLibDirs = lines confLibDir ++ lines libDir, 40 | includeDirs = lines incDir ++ ["glue"], 41 | extraLibs = lines libName, 42 | cppOptions = definesFor pyVersion 43 | } 44 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | # arch-tag: Main Makefile 2 | # Copyright (C) 2004 - 2005 John Goerzen 3 | # 4 | # This program is free software; you can redistribute it and/or modify 5 | # it under the terms of the GNU General Public License as published by 6 | # the Free Software Foundation; either version 2 of the License, or 7 | # (at your option) any later version. 8 | # 9 | # This program is distributed in the hope that it will be useful, 10 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | # GNU General Public License for more details. 13 | # 14 | # You should have received a copy of the GNU General Public License 15 | # along with this program; if not, write to the Free Software 16 | # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 17 | 18 | .PHONY: all 19 | all: setup 20 | ./setup configure 21 | ./setup build 22 | 23 | PYTHON ?= python 24 | setup: Setup.hs MissingPy.cabal 25 | ghc -package Cabal Setup.hs -o setup 26 | 27 | doc: setup 28 | ./setup haddock 29 | 30 | clean: 31 | -./setup clean 32 | -rm -rf html `find . -name "*.o"` `find . -name "*.hi"` \ 33 | `find . -name "*~"` *.a setup dist testsrc/runtests \ 34 | local-pkg *.buildinfo 35 | -cd doc && $(MAKE) clean 36 | 37 | .PHONY: local-pkg 38 | local-pkg: all 39 | echo "[" > local-pkg 40 | cat .installed-pkg-config >> local-pkg 41 | echo "]" >> local-pkg 42 | 43 | testsrc/runtests: $(shell find . -name "*.hs") \ 44 | $(shell find . -name "*.hsc") 45 | ghc6 -O2 -o testsrc/runtests -Iglue -Ldist/build -odir dist/build \ 46 | -hidir dist/build -package mtl -fffi -idist/build -itestsrc \ 47 | -L/usr/lib -L/usr/lib/python2.5/site-packages \ 48 | -fglasgow-exts \ 49 | -I/usr/include/python2.5 \ 50 | -package HUnit --make testsrc/runtests.hs \ 51 | dist/build/glue/glue.o dist/build/glue/excglue.o -lpython2.5 52 | 53 | # dist/build/libHSMissingPy-* 54 | test-ghc6: testsrc/runtests 55 | testsrc/runtests 56 | 57 | test-hugs: 58 | runhugs -98 +o -P$(PWD)/libsrc:$(PWD)/testsrc: testsrc/runtests.hs 59 | 60 | interact-hugs: 61 | hugs -98 +o -P$(PWD)/libsrc: 62 | 63 | interact-ghci: all 64 | ghci -fallow-overlapping-instances -fallow-undecidable-instances -fglasgow-exts -ilibsrc 65 | 66 | interact: interact-hugs 67 | 68 | test: test-ghc6 69 | 70 | genexceptions: 71 | runhugs genexceptions.hs 72 | 73 | -------------------------------------------------------------------------------- /README: -------------------------------------------------------------------------------- 1 | ------------------------- 2 | What is MissingPy? 3 | ------------------------- 4 | 5 | It's two things: 6 | 7 | 1. A Haskell binding for many C and Python libraries for tasks such as 8 | data compression, databases, etc. This can be found in the 9 | MissingPy module tree. 10 | 11 | 2. A low-level Haskell binding to the Python interpreter to 12 | enable development of hybrid applications that use both 13 | environments. This can be found in the Python module tree. The 14 | Haskell bindings above use this environment. 15 | 16 | MissingPy permits you to call Python code from Haskell. It does NOT 17 | permit you to call Haskell code from Python. 18 | 19 | ------------------------- 20 | Major Features 21 | ------------------------- 22 | 23 | * GZip and BZip2 compression and decompression using the generic 24 | Handle-like HVIO interface 25 | 26 | * *dbm persistent storage using the generic AnyDBM interface 27 | 28 | * Low-level interface to Python for extending your own Haskell code 29 | 30 | * Many unit tests to verify proper functionality 31 | 32 | ** THIS IS CURRENTLY BETA-QUALITY CODE; MAJOR API FLUCTUATIONS MAY YET OCCUR. 33 | 34 | ------------------------- 35 | Quick Start 36 | ------------------------- 37 | 38 | See the file INSTALL. 39 | 40 | ------------------------- 41 | Usage in programs 42 | ------------------------- 43 | 44 | You can simply use -package MissingPy in ghc to enable 45 | this library. 46 | 47 | Note that you'll want to compile most of your programs with 48 | -fallow-overlapping-instances at least. (If you use *only* 49 | MissingPy/*, that may not be necessary.) Also, please note that you 50 | must call Python.Interpreter.py_initialize before doing anything else. 51 | 52 | The API docs can be built with "make doc", or you can find them at: 53 | 54 | http://software.complete.org/missingpy 55 | 56 | ------------------------- 57 | Author & Homepage 58 | ------------------------- 59 | 60 | MissingPy was written by John Goerzen . 61 | 62 | The latest version may be obtained at: 63 | 64 | http://software.complete.org/missingpy 65 | 66 | Documentation is also available on that page. 67 | 68 | This program is copyrighted under the terms of the GNU General Public License. 69 | See the COPYRIGHT and COPYING files for more details. 70 | 71 | If the GPL is unacceptable for your uses, please e-mail me; alternative 72 | terms can be negotiated for your project. 73 | 74 | -------------------------------------------------------------------------------- /MissingPy/FileArchive/GZip.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverlappingInstances#-} 2 | 3 | {- arch-tag: GZip files 4 | Copyright (C) 2005 John Goerzen 5 | 6 | This program is free software; you can redistribute it and/or modify 7 | it under the terms of the GNU General Public License as published by 8 | the Free Software Foundation; either version 2 of the License, or 9 | (at your option) any later version. 10 | 11 | This program is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU General Public License for more details. 15 | 16 | You should have received a copy of the GNU General Public License 17 | along with this program; if not, write to the Free Software 18 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 19 | -} 20 | 21 | {- | 22 | Module : MissingPy.FileArchive.GZip 23 | Copyright : Copyright (C) 2005 John Goerzen 24 | License : GNU GPL, version 2 or above 25 | 26 | Maintainer : John Goerzen, 27 | Maintainer : jgoerzen\@complete.org 28 | Stability : provisional 29 | Portability: portable 30 | 31 | Support for GZip files 32 | 33 | Written by John Goerzen, jgoerzen\@complete.org 34 | -} 35 | 36 | module MissingPy.FileArchive.GZip (openGz 37 | ) 38 | where 39 | 40 | 41 | import Python.Types 42 | import Python.Utils 43 | import Python.Objects 44 | import Python.Interpreter 45 | import System.IO 46 | import System.IO.Error 47 | import Python.Exceptions 48 | import System.IO.HVIO 49 | import Foreign.C.Types 50 | import Python.Objects.File 51 | 52 | {- |Open a GZip file. The compression level should be from 1 53 | (least compression) to 9 (most compression). This is ignored when the 54 | file is opened read-only. 55 | 56 | Once opened, the functions defined in 'System.IO.HVIO' can be used to 57 | work with it. -} 58 | openGz :: FilePath -- ^ File to open 59 | -> IOMode -- ^ Mode to open with 60 | -> Int -- ^ Compression Level 61 | -> IO PyFile -- ^ Resulting handle 62 | openGz fp mode level = 63 | do ofp <- toPyObject fp 64 | omode <- toPyObject (openModeConv mode) 65 | ocl <- toPyObject ((fromIntegral level)::CLong) 66 | pyImport "gzip" 67 | obj <- callByName "gzip.open" [ofp, omode, ocl] [] 68 | return $ mkPyFile obj 69 | -------------------------------------------------------------------------------- /testsrc/Exceptionstest.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS -fallow-overlapping-instances #-} 2 | {- arch-tag: Exceptions tests main file 3 | Copyright (C) 2005 John Goerzen 4 | 5 | This program is free software; you can redistribute it and/or modify 6 | it under the terms of the GNU General Public License as published by 7 | the Free Software Foundation; either version 2 of the License, or 8 | (at your option) any later version. 9 | 10 | This program is distributed in the hope that it will be useful, 11 | but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | GNU General Public License for more details. 14 | 15 | You should have received a copy of the GNU General Public License 16 | along with this program; if not, write to the Free Software 17 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 18 | -} 19 | 20 | module Exceptionstest(tests) where 21 | import Test.HUnit 22 | import Python.Objects 23 | import Python.Exceptions 24 | import Python.Exceptions.ExcTypes 25 | import Python.Interpreter 26 | import Foreign.C.Types 27 | import qualified Control.Exception 28 | 29 | f msg inp code exp = TestLabel msg $ TestCase $ do pyo <- toPyObject inp 30 | r <- code pyo 31 | exp @=? r 32 | 33 | test_base = 34 | let handler e = return () 35 | in 36 | [ 37 | TestCase $ catchPy ( 38 | do r <- pyRun_StringHs " 2 + None" Py_eval_input noKwParms 39 | r @=? "no exception raised" 40 | ) handler 41 | ,TestCase $ catchSpecificPy typeError ( 42 | do r <- pyRun_StringHs "2 + None" Py_eval_input noKwParms 43 | r @=? "no exception raised" 44 | ) handler 45 | ,TestCase $ catchSpecificPy valueError ( 46 | do Control.Exception.catch 47 | (do r <- pyRun_StringHs "2 + None" Py_eval_input noKwParms 48 | r @=? "no exception raised" 49 | ) 50 | (\e -> return () ) 51 | ) 52 | (\e -> fail "Incorrectly caught exception") 53 | ] 54 | 55 | tests = TestList [TestLabel "base" (TestList test_base) 56 | ] 57 | -------------------------------------------------------------------------------- /glue/excglue.h: -------------------------------------------------------------------------------- 1 | /* NOTICE -- THIS FILE IS AUTO-GENERATED -- DO NOT EDIT 2 | MissingPy: Haskell Python Interface libraries 3 | Copyright (C) 2004 - 2005 John Goerzen 4 | 5 | All code is under the following license unless otherwise noted: 6 | This program is free software; you can redistribute it and/or modify 7 | it under the terms of the GNU General Public License as published by 8 | the Free Software Foundation; either version 2 of the License, or 9 | (at your option) any later version. 10 | 11 | This program is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU General Public License for more details. 15 | 16 | You should have received a copy of the GNU General Public License 17 | along with this program; if not, write to the Free Software 18 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 19 | 20 | The GNU General Public License is available in the file COPYING in the source 21 | distribution. Debian GNU/Linux users may find this in 22 | /usr/share/common-licenses/GPL-2. 23 | 24 | If the GPL is unacceptable for your uses, please e-mail me; alternative 25 | terms can be negotiated for your project. 26 | */ 27 | #include 28 | extern PyObject *hspy_ArithmeticError(void); 29 | extern PyObject *hspy_AssertionError(void); 30 | extern PyObject *hspy_AttributeError(void); 31 | extern PyObject *hspy_EOFError(void); 32 | extern PyObject *hspy_EnvironmentError(void); 33 | extern PyObject *hspy_Exception(void); 34 | extern PyObject *hspy_FloatingPointError(void); 35 | extern PyObject *hspy_IOError(void); 36 | extern PyObject *hspy_ImportError(void); 37 | extern PyObject *hspy_IndexError(void); 38 | extern PyObject *hspy_KeyError(void); 39 | extern PyObject *hspy_KeyboardInterrupt(void); 40 | extern PyObject *hspy_LookupError(void); 41 | extern PyObject *hspy_MemoryError(void); 42 | extern PyObject *hspy_NameError(void); 43 | extern PyObject *hspy_NotImplementedError(void); 44 | extern PyObject *hspy_OSError(void); 45 | extern PyObject *hspy_OverflowError(void); 46 | extern PyObject *hspy_ReferenceError(void); 47 | extern PyObject *hspy_RuntimeError(void); 48 | extern PyObject *hspy_StandardError(void); 49 | extern PyObject *hspy_SyntaxError(void); 50 | extern PyObject *hspy_SystemError(void); 51 | extern PyObject *hspy_SystemExit(void); 52 | extern PyObject *hspy_TypeError(void); 53 | extern PyObject *hspy_ValueError(void); 54 | extern PyObject *hspy_ZeroDivisionError(void); 55 | 56 | #ifdef MS_WINDOWS 57 | extern PyObject *hspy_WindowsError(void); 58 | #endif 59 | 60 | -------------------------------------------------------------------------------- /MissingPy/FileArchive/BZip2.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverlappingInstances#-} 2 | 3 | {- arch-tag: BZip2 files 4 | Copyright (C) 2005 John Goerzen 5 | 6 | This program is free software; you can redistribute it and/or modify 7 | it under the terms of the GNU General Public License as published by 8 | the Free Software Foundation; either version 2 of the License, or 9 | (at your option) any later version. 10 | 11 | This program is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU General Public License for more details. 15 | 16 | You should have received a copy of the GNU General Public License 17 | along with this program; if not, write to the Free Software 18 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 19 | -} 20 | 21 | {- | 22 | Module : MissingPy.FileArchive.BZip2 23 | Copyright : Copyright (C) 2005 John Goerzen 24 | License : GNU GPL, version 2 or above 25 | 26 | Maintainer : John Goerzen, 27 | Maintainer : jgoerzen\@complete.org 28 | Stability : provisional 29 | Portability: portable 30 | 31 | Support for BZip2 files 32 | 33 | Written by John Goerzen, jgoerzen\@complete.org 34 | -} 35 | 36 | module MissingPy.FileArchive.BZip2 (openBz2) 37 | where 38 | 39 | import Python.Types 40 | import Python.Utils 41 | import Python.Objects 42 | import Python.Interpreter 43 | import System.IO 44 | import System.IO.Error 45 | import Python.Exceptions 46 | import System.IO.HVIO 47 | import Foreign.C.Types 48 | import Python.Objects.File 49 | 50 | {- |Open a BZip2 file. The compression level should be from 1 51 | (least compression) to 9 (most compression). This is ignored when the file 52 | is opened read-only. 53 | 54 | Once opened, the functions defined in "System.IO.HVIO" can be used 55 | to work with it. 56 | 57 | BZip2 supports only ReadMode and WriteMode for the IOMode. -} 58 | openBz2 :: FilePath -- ^ File to open 59 | -> IOMode -- ^ Mode to open with 60 | -> Int -- ^ Compression Level 61 | -> IO PyFile -- ^ Resulting handle 62 | openBz2 _ ReadWriteMode _ = fail "BZip2 doesn't support ReadWriteMode" 63 | openBz2 _ AppendMode _ = fail "BZip2 doesn't support AppendMode" 64 | openBz2 fp mode level = 65 | do ofp <- toPyObject fp 66 | omode <- toPyObject (openModeConv mode) 67 | obuffering <- toPyObject (0::CLong) 68 | ocl <- toPyObject ((fromIntegral level)::CLong) 69 | pyImport "bz2" 70 | obj <- callByName "bz2.BZ2File" [ofp, omode, obuffering, ocl] [] 71 | return $ mkPyFile obj 72 | -------------------------------------------------------------------------------- /testsrc/Interpretertest.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS -fallow-overlapping-instances #-} 2 | {- arch-tag: Interpreter tests main file 3 | Copyright (C) 2005 John Goerzen 4 | 5 | This program is free software; you can redistribute it and/or modify 6 | it under the terms of the GNU General Public License as published by 7 | the Free Software Foundation; either version 2 of the License, or 8 | (at your option) any later version. 9 | 10 | This program is distributed in the hope that it will be useful, 11 | but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | GNU General Public License for more details. 14 | 15 | You should have received a copy of the GNU General Public License 16 | along with this program; if not, write to the Free Software 17 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 18 | -} 19 | 20 | module Interpretertest(tests) where 21 | import Test.HUnit 22 | import Python.Interpreter 23 | import Foreign.C.Types 24 | import Python.Objects 25 | import Python.Utils 26 | 27 | test_base = 28 | let f msg t = TestLabel msg $ TestCase t in 29 | [ 30 | -- f "print" $ pyRun_SimpleString "print \"Hi from Python\\n\"" 31 | f "longs" $ do pyo <- toPyObject (10::CLong) 32 | newl <- fromPyObject pyo 33 | (10::CLong) @=? newl 34 | ] 35 | 36 | test_callbyname = 37 | let f msg func inp exp = TestLabel msg $ TestCase $ 38 | do r <-callByNameHs func inp noKwParms 39 | exp @=? r 40 | in 41 | [ 42 | f "repr" "repr" [5::Integer] "5L" 43 | ,f "repr2" "repr" [5::CLong] "5" 44 | ,f "pow" "pow" [2::CInt, 32::CInt] ((2 ^ 32)::Integer) 45 | 46 | ,TestLabel "import" $ TestCase $ 47 | do pyImport "base64" 48 | r <- callByNameHs "base64.encodestring" ["hi"] noKwParms 49 | "aGk=\n" @=? r 50 | ] 51 | 52 | test_args = 53 | let f msg code inp exp = TestLabel msg $ TestCase $ 54 | do let testhdict = [("testval", inp)] 55 | retobj <- pyRun_StringHs code Py_eval_input testhdict 56 | exp @=? retobj 57 | in 58 | [ 59 | f "addition" "testval + 3" (2::CLong) (5::CLong) 60 | {- 61 | TestLabel "m1" $ TestCase $ 62 | do testpydict <- toPyObject [(5::CInt, 2::CInt)] 63 | retobj <- pyRun_String "testval + 3" 0 Nothing (Just testpydict) 64 | retval <- fromPyObject retobj 65 | 5 @=? retval 66 | -} 67 | ] 68 | 69 | 70 | tests = TestList [TestLabel "base" (TestList test_base), 71 | TestLabel "args" (TestList test_args), 72 | TestLabel "callByName" (TestList test_callbyname)] 73 | -------------------------------------------------------------------------------- /Python/Types.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {- arch-tag: Python types 3 | Copyright (C) 2005 John Goerzen 4 | 5 | This program is free software; you can redistribute it and/or modify 6 | it under the terms of the GNU General Public License as published by 7 | the Free Software Foundation; either version 2 of the License, or 8 | (at your option) any later version. 9 | 10 | This program is distributed in the hope that it will be useful, 11 | but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | GNU General Public License for more details. 14 | 15 | You should have received a copy of the GNU General Public License 16 | along with this program; if not, write to the Free Software 17 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 18 | -} 19 | 20 | {- | 21 | Module : Python.Types 22 | Copyright : Copyright (C) 2005 John Goerzen 23 | License : GNU GPL, version 2 or above 24 | 25 | Maintainer : John Goerzen, 26 | Maintainer : jgoerzen\@complete.org 27 | Stability : provisional 28 | Portability: portable 29 | 30 | Interfaces to low-level Python types. You should probably not use this module 31 | directly. You probably want "Python.Objects" instead. 32 | 33 | You'll only need this module directly if you are importing new functions 34 | from the Python C API. 35 | 36 | Written by John Goerzen, jgoerzen\@complete.org 37 | -} 38 | 39 | module Python.Types ( 40 | PyObject(..), 41 | CPyObject, 42 | PyException(..), 43 | StartFrom(..) 44 | #ifndef PYTHON_PRE_2_3 45 | ,PyGILState(..) 46 | ,CPyGILState 47 | #endif 48 | ) 49 | where 50 | 51 | import Foreign (ForeignPtr) 52 | import Data.Typeable ( 53 | TyCon 54 | , mkTyConApp 55 | , mkTyCon 56 | , Typeable(..) 57 | ) 58 | 59 | type CPyObject = () 60 | 61 | -- | The type of Python objects. 62 | newtype PyObject = PyObject (ForeignPtr CPyObject) 63 | deriving (Eq, Show) 64 | 65 | #ifndef PYTHON_PRE_2_3 66 | type CPyGILState = () 67 | newtype PyGILState = PyGILState (ForeignPtr CPyGILState) 68 | deriving (Eq, Show) 69 | #endif 70 | 71 | -- | The type of Python exceptions. 72 | data PyException = PyException {excType :: PyObject, -- ^ Exception type 73 | excValue :: PyObject, -- ^ Exception value 74 | excTraceBack :: PyObject, -- ^ Traceback 75 | excFormatted :: String -- ^ Formatted for display 76 | } 77 | instance Show PyException where 78 | show x = excFormatted x 79 | 80 | pyExceptionTc :: TyCon 81 | pyExceptionTc = mkTyCon "MissingPy.Python.Types.PyException" 82 | 83 | instance Typeable PyException where 84 | typeOf _ = mkTyConApp pyExceptionTc [] 85 | 86 | {- | How to interpret a snippet of Python code. -} 87 | data StartFrom = Py_eval_input 88 | | Py_file_input 89 | | Py_single_input 90 | 91 | -------------------------------------------------------------------------------- /glue/excglue.c: -------------------------------------------------------------------------------- 1 | /* NOTICE -- THIS FILE IS AUTO-GENERATED -- DO NOT EDIT 2 | MissingPy: Haskell Python Interface libraries 3 | Copyright (C) 2004 - 2005 John Goerzen 4 | 5 | All code is under the following license unless otherwise noted: 6 | This program is free software; you can redistribute it and/or modify 7 | it under the terms of the GNU General Public License as published by 8 | the Free Software Foundation; either version 2 of the License, or 9 | (at your option) any later version. 10 | 11 | This program is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU General Public License for more details. 15 | 16 | You should have received a copy of the GNU General Public License 17 | along with this program; if not, write to the Free Software 18 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 19 | 20 | The GNU General Public License is available in the file COPYING in the source 21 | distribution. Debian GNU/Linux users may find this in 22 | /usr/share/common-licenses/GPL-2. 23 | 24 | If the GPL is unacceptable for your uses, please e-mail me; alternative 25 | terms can be negotiated for your project. 26 | */ 27 | #include 28 | PyObject *hspy_ArithmeticError(void) { return PyExc_ArithmeticError; } 29 | PyObject *hspy_AssertionError(void) { return PyExc_AssertionError; } 30 | PyObject *hspy_AttributeError(void) { return PyExc_AttributeError; } 31 | PyObject *hspy_EOFError(void) { return PyExc_EOFError; } 32 | PyObject *hspy_EnvironmentError(void) { return PyExc_EnvironmentError; } 33 | PyObject *hspy_Exception(void) { return PyExc_Exception; } 34 | PyObject *hspy_FloatingPointError(void) { return PyExc_FloatingPointError; } 35 | PyObject *hspy_IOError(void) { return PyExc_IOError; } 36 | PyObject *hspy_ImportError(void) { return PyExc_ImportError; } 37 | PyObject *hspy_IndexError(void) { return PyExc_IndexError; } 38 | PyObject *hspy_KeyError(void) { return PyExc_KeyError; } 39 | PyObject *hspy_KeyboardInterrupt(void) { return PyExc_KeyboardInterrupt; } 40 | PyObject *hspy_LookupError(void) { return PyExc_LookupError; } 41 | PyObject *hspy_MemoryError(void) { return PyExc_MemoryError; } 42 | PyObject *hspy_NameError(void) { return PyExc_NameError; } 43 | PyObject *hspy_NotImplementedError(void) { return PyExc_NotImplementedError; } 44 | PyObject *hspy_OSError(void) { return PyExc_OSError; } 45 | PyObject *hspy_OverflowError(void) { return PyExc_OverflowError; } 46 | PyObject *hspy_ReferenceError(void) { return PyExc_ReferenceError; } 47 | PyObject *hspy_RuntimeError(void) { return PyExc_RuntimeError; } 48 | PyObject *hspy_StandardError(void) { return PyExc_StandardError; } 49 | PyObject *hspy_SyntaxError(void) { return PyExc_SyntaxError; } 50 | PyObject *hspy_SystemError(void) { return PyExc_SystemError; } 51 | PyObject *hspy_SystemExit(void) { return PyExc_SystemExit; } 52 | PyObject *hspy_TypeError(void) { return PyExc_TypeError; } 53 | PyObject *hspy_ValueError(void) { return PyExc_ValueError; } 54 | PyObject *hspy_ZeroDivisionError(void) { return PyExc_ZeroDivisionError; } 55 | 56 | #ifdef MS_WINDOWS 57 | PyObject *hspy_WindowsError(void) { return PyExc_WindowsError; } 58 | #endif 59 | 60 | -------------------------------------------------------------------------------- /testsrc/BZip2test.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS -fallow-overlapping-instances #-} 2 | {- arch-tag: BZip2 tests main file 3 | Copyright (C) 2005 John Goerzen 4 | 5 | This program is free software; you can redistribute it and/or modify 6 | it under the terms of the GNU General Public License as published by 7 | the Free Software Foundation; either version 2 of the License, or 8 | (at your option) any later version. 9 | 10 | This program is distributed in the hope that it will be useful, 11 | but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | GNU General Public License for more details. 14 | 15 | You should have received a copy of the GNU General Public License 16 | along with this program; if not, write to the Free Software 17 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 18 | -} 19 | 20 | module BZip2test(tests) where 21 | import Test.HUnit 22 | import Python.Exceptions 23 | import MissingPy.FileArchive.BZip2 24 | import Data.List 25 | import System.IO.HVIO 26 | import System.IO 27 | import System.IO.Error 28 | import Testutil 29 | import System.Directory 30 | import qualified Control.Exception 31 | 32 | finally = Control.Exception.finally 33 | 34 | f' mf fn exp = TestLabel fn $ TestCase $ handlePy exc2ioerror $ 35 | do bzf <- openBz2 ("testsrc/bz2files/" ++ fn) ReadMode 9 36 | c <- vGetContents bzf 37 | mf exp c 38 | vClose bzf 39 | 40 | f fn exp = f' (@=?) fn exp 41 | f2 fn exp = f' nodisptest fn exp 42 | 43 | -- @=? loads the whole thing into memory. ick. This is much better. 44 | nodisptest a b = 45 | if a == b 46 | then return () 47 | else assertFailure "Data mismatch" 48 | 49 | test_bunzip2 = 50 | [ 51 | f "t1.bz2" "Test 1" 52 | ,f "t2.bz2" "Test 1Test 2" 53 | ,f "empty.bz2" "" 54 | ,TestCase $ do bzf <- openBz2 "testsrc/bz2files/zeros.bz2" ReadMode 1 55 | c <- vGetContents bzf 56 | 10485760 @=? length c 57 | vClose bzf 58 | ,f2 "zeros.bz2" (replicate 10485760 '\0') 59 | ] 60 | 61 | test_bzip2 = TestCase $ 62 | handlePy exc2ioerror $ 63 | do bzf <- openBz2 "testsrc/bz2files/deleteme.bz2" WriteMode 9 64 | finally (do vPutStr bzf "Test 2\n" 65 | vFlush bzf 66 | vPutStr bzf "Test 3\n" 67 | vPutStr bzf (replicate 1048576 't') 68 | vPutChar bzf '\n' 69 | vClose bzf 70 | bzf2 <- openBz2 "testsrc/bz2files/deleteme.bz2" ReadMode 9 71 | vGetLine bzf2 >>= (@=? "Test 2") 72 | vGetLine bzf2 >>= (@=? "Test 3") 73 | vGetLine bzf2 74 | assertRaises "eof" (Control.Exception.IOException $ mkIOError eofErrorType "" Nothing Nothing) (vGetLine bzf2) 75 | 76 | vRewind bzf2 77 | c <- vGetContents bzf2 78 | ("Test 2\nTest 3\n" ++ (replicate 1048576 't') ++ "\n") 79 | @=? c 80 | assertRaises "closed" (Control.Exception.IOException $ mkIOError illegalOperationErrorType "" Nothing Nothing) (vGetLine bzf2) 81 | vClose bzf2 82 | ) (removeFile "testsrc/bz2files/deleteme.bz2") 83 | 84 | 85 | tests = TestList [TestLabel "bzip2" test_bzip2, 86 | TestLabel "bunzip2" (TestList test_bunzip2) 87 | 88 | ] 89 | -------------------------------------------------------------------------------- /testsrc/GZiptest.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS -fallow-overlapping-instances #-} 2 | {- arch-tag: GZip tests main file 3 | Copyright (C) 2005-2008 John Goerzen 4 | 5 | This program is free software; you can redistribute it and/or modify 6 | it under the terms of the GNU General Public License as published by 7 | the Free Software Foundation; either version 2 of the License, or 8 | (at your option) any later version. 9 | 10 | This program is distributed in the hope that it will be useful, 11 | but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | GNU General Public License for more details. 14 | 15 | You should have received a copy of the GNU General Public License 16 | along with this program; if not, write to the Free Software 17 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 18 | -} 19 | 20 | module GZiptest(tests) where 21 | import Test.HUnit 22 | import Python.Exceptions 23 | import MissingPy.FileArchive.GZip 24 | import Data.List 25 | import System.IO.HVIO 26 | import System.IO 27 | import System.IO.Error 28 | import Testutil 29 | import System.Directory 30 | import qualified Control.Exception 31 | 32 | finally = Control.Exception.finally 33 | 34 | f fn exp = TestCase $ do gzf <- openGz ("testsrc/gzfiles/" ++ fn) ReadMode 9 35 | c <- vGetContents gzf 36 | exp @=? c 37 | vClose gzf 38 | 39 | 40 | test_gunzip = 41 | [ 42 | f "t1.gz" "Test 1" 43 | ,f "empty.gz" "" 44 | -- , "t1bad has errors 45 | ,f "t2.gz" "Test 1Test 2" 46 | ,TestCase $ handlePy exc2ioerror $ 47 | do gzf <- openGz "testsrc/gzfiles/t1bad.gz" ReadMode 1 48 | assertRaises "crc" (Control.Exception.IOException $ userError "Python : CRC check failed") 49 | (handlePy exc2ioerror $ do c <- vGetContents gzf 50 | "nonexistant bad data" @=? c 51 | ) 52 | vClose gzf 53 | ,TestCase $ do gzf <- openGz "testsrc/gzfiles/zeros.gz" ReadMode 1 54 | c <- vGetContents gzf 55 | 10485760 @=? length c 56 | vClose gzf 57 | --,f "zeros.gz" (replicate 10485760 '\0') 58 | ] 59 | 60 | test_gzip = TestCase $ 61 | handlePy exc2ioerror $ 62 | do gzf <- openGz "testsrc/gzfiles/deleteme.gz" ReadWriteMode 9 63 | finally (do vPutStr gzf "Test 2\n" 64 | vSeek gzf AbsoluteSeek 7 65 | vFlush gzf 66 | vPutStr gzf "Test 3\n" 67 | vPutStr gzf (replicate 1048576 't') 68 | vPutChar gzf '\n' 69 | vClose gzf 70 | gzf2 <- openGz "testsrc/gzfiles/deleteme.gz" ReadMode 9 71 | vGetLine gzf2 >>= (@=? "Test 2") 72 | vGetLine gzf2 >>= (@=? "Test 3") 73 | vRewind gzf2 74 | c <- vGetContents gzf2 75 | ("Test 2\nTest 3\n" ++ (replicate 1048576 't') ++ "\n") 76 | @=? c 77 | assertRaises "eof" (Control.Exception.IOException $ mkIOError eofErrorType "" Nothing Nothing) (vGetLine gzf2) 78 | vClose gzf2 79 | ) (removeFile "testsrc/gzfiles/deleteme.gz") 80 | 81 | 82 | tests = TestList [TestLabel "gzip" test_gzip, 83 | TestLabel "gunzip" (TestList test_gunzip) 84 | 85 | ] 86 | -------------------------------------------------------------------------------- /MissingPy/AnyDBM.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverlappingInstances#-} 2 | 3 | {- arch-tag: Interface to anydbm.py 4 | Copyright (C) 2005 John Goerzen 5 | 6 | This program is free software; you can redistribute it and/or modify 7 | it under the terms of the GNU General Public License as published by 8 | the Free Software Foundation; either version 2 of the License, or 9 | (at your option) any later version. 10 | 11 | This program is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU General Public License for more details. 15 | 16 | You should have received a copy of the GNU General Public License 17 | along with this program; if not, write to the Free Software 18 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 19 | -} 20 | 21 | {- | 22 | Module : MissingPy.AnyDBM 23 | Copyright : Copyright (C) 2005 John Goerzen 24 | License : GNU GPL, version 2 or above 25 | 26 | Maintainer : John Goerzen, 27 | Maintainer : jgoerzen\@complete.org 28 | Stability : provisional 29 | Portability: portable 30 | 31 | This module interfaces "Database.AnyDBM" to Python's anydbm.py. 32 | Implementations for specific Python *dbm modules are also available. 33 | 34 | See and import "Database.AnyDBM" to use these features. 35 | 36 | Written by John Goerzen, jgoerzen\@complete.org 37 | -} 38 | 39 | module MissingPy.AnyDBM(PyDBMOpenFlags(..), 40 | openAnyDBM, 41 | openSpecificDBM 42 | ) 43 | where 44 | 45 | 46 | import Python.Objects.Dict 47 | import Python.Interpreter 48 | import Python.Utils 49 | import Python.Exceptions 50 | import Python.Objects 51 | import Database.AnyDBM 52 | 53 | {- | Flags used to open a dbm-type database -} 54 | data PyDBMOpenFlags = 55 | DBM_ReadOnly -- ^ Open an /existing/ database for read only 56 | | DBM_ReadWrite -- ^ Open an /existing/ database for reading and writing 57 | | DBM_ReadWriteCreate -- ^ Open a database for reading and writing, creating if it doesn't exist 58 | | DBM_ReadWriteNew -- ^ Open a database, creating it anew each time (deleting any existing data) 59 | flag2str :: PyDBMOpenFlags -> String 60 | flag2str DBM_ReadOnly = "r" 61 | flag2str DBM_ReadWrite = "w" 62 | flag2str DBM_ReadWriteCreate = "c" 63 | flag2str DBM_ReadWriteNew = "n" 64 | 65 | {- | Opens a persistent storage database using the \"best\" storage mechanism 66 | available to Python on this system. This will usually be one of the *dbm 67 | services, though in rare circumstances, could be \"dumbdbm\", which is 68 | only marginally better than "Database.AnyDBM.StringDBM". 69 | -} 70 | openAnyDBM :: FilePath -> PyDBMOpenFlags -> IO PyDict 71 | openAnyDBM = openSpecificDBM "anydbm" 72 | 73 | {- | Open a database using a specific module given by the first parameter. The 74 | module supported are: 75 | 76 | * dbhash 77 | 78 | * dbm 79 | 80 | * dumbdbm 81 | 82 | * gdbm 83 | 84 | SECURITY NOTE: the string is not validated before being passed to Python. 85 | Do not pass an arbitrary value to this function. 86 | -} 87 | openSpecificDBM :: String -- ^ Python module name to use 88 | -> FilePath -- ^ Path to database files 89 | -> PyDBMOpenFlags -- ^ Flags to use when opening 90 | -> IO PyDict -- ^ Result 91 | openSpecificDBM mod fp flag = 92 | let flagstr = flag2str flag 93 | in handlePy exc2ioerror $ 94 | do pyImport mod 95 | fileobj <- toPyObject fp 96 | flagobj <- toPyObject flagstr 97 | obj <- callByName (mod ++ ".open") [fileobj, flagobj] [] 98 | return $ mkPyDict obj 99 | -------------------------------------------------------------------------------- /debian/rules: -------------------------------------------------------------------------------- 1 | #!/usr/bin/make -f 2 | # -*- makefile -*- 3 | # Sample debian/rules that uses debhelper. 4 | # This file was originally written by Joey Hess and Craig Small. 5 | # As a special exception, when this file is copied by dh-make into a 6 | # dh-make output file, you may use that output file without restriction. 7 | # This special exception was added by Craig Small in version 0.37 of dh-make. 8 | 9 | # Uncomment this to turn on verbose mode. 10 | export DH_VERBOSE=1 11 | 12 | CFLAGS = -Wall -g 13 | 14 | ifneq (,$(findstring noopt,$(DEB_BUILD_OPTIONS))) 15 | CFLAGS += -O0 16 | else 17 | CFLAGS += -O2 18 | endif 19 | ifeq (,$(findstring nostrip,$(DEB_BUILD_OPTIONS))) 20 | INSTALL_PROGRAM += -s 21 | endif 22 | 23 | # shared library versions, option 1 24 | version=2.0.5 25 | major=2 26 | # option 2, assuming the library is created as src/.libs/libfoo.so.2.0.5 or so 27 | #version=`ls src/.libs/lib*.so.* | \ 28 | # awk '{if (match($$0,/[0-9]+\.[0-9]+\.[0-9]+$$/)) print substr($$0,RSTART)}'` 29 | #major=`ls src/.libs/lib*.so.* | \ 30 | # awk '{if (match($$0,/\.so\.[0-9]+$$/)) print substr($$0,RSTART+4)}'` 31 | 32 | configure: configure-stamp 33 | configure-stamp: 34 | dh_testdir 35 | # Add here commands to configure the package. 36 | make setup 37 | ./setup configure --prefix=$(LIBPATH) --ghc 38 | 39 | touch configure-stamp 40 | 41 | 42 | build: build-stamp 43 | build-stamp: configure-stamp 44 | dh_testdir 45 | 46 | #make test-ghc6 47 | # Add here commands to compile the package. 48 | touch build-stamp 49 | 50 | clean: 51 | dh_testdir 52 | dh_testroot 53 | rm -f build-stamp configure-stamp 54 | 55 | # Add here commands to clean up after the build process. 56 | -./setup clean 57 | -make clean 58 | -rm -rf setup Setup.hi Setup.ho Setup.o .*config* dist html 59 | 60 | dh_clean 61 | 62 | install: build builddocs 63 | dh_testdir 64 | dh_testroot 65 | dh_clean -k 66 | dh_installdirs -a 67 | 68 | # Add here commands to install the package into debian/tmp 69 | dh_haskell -a 70 | dh_haskell_depends -a 71 | cd debian/tmp/build/libghc6-missingpy-dev && make test 72 | 73 | builddocs: builddocs-stamp 74 | builddocs-stamp: 75 | dh_testdir 76 | 77 | make doc 78 | #make test-hugs 79 | 80 | installdocs: builddocs 81 | dh_testdir 82 | dh_testroot 83 | dh_clean -k 84 | dh_installdirs -i 85 | 86 | dh_haskell -i 87 | make test-hugs 88 | 89 | # Build architecture-independent files here. 90 | binary-indep-DISABLED: builddocs installdocs 91 | dh_testdir 92 | dh_testroot 93 | dh_installchangelogs -i 94 | dh_installdocs -i 95 | dh_installexamples -i 96 | # dh_install 97 | # dh_installmenu 98 | # dh_installdebconf 99 | # dh_installlogrotate 100 | # dh_installemacsen 101 | # dh_installpam 102 | # dh_installmime 103 | # dh_installinit 104 | # dh_installcron 105 | # dh_installinfo 106 | dh_installman -i 107 | dh_link -i 108 | dh_strip -i 109 | dh_compress -i 110 | dh_fixperms -i 111 | # dh_perl 112 | dh_pycentral -i 113 | dh_python -i 114 | # dh_makeshlibs 115 | dh_installdeb -i 116 | dh_shlibdeps -i 117 | dh_gencontrol -i 118 | dh_md5sums -i 119 | dh_builddeb -i 120 | 121 | # Build architecture-dependent files here. 122 | binary-arch: build install 123 | dh_testdir 124 | dh_testroot 125 | dh_installchangelogs -a 126 | dh_installdocs -a 127 | dh_installexamples -a 128 | # dh_install 129 | # dh_installmenu 130 | # dh_installdebconf 131 | # dh_installlogrotate 132 | # dh_installemacsen 133 | # dh_installpam 134 | # dh_installmime 135 | # dh_installinit 136 | # dh_installcron 137 | # dh_installinfo 138 | dh_installman -a 139 | dh_link -a 140 | dh_strip -a 141 | dh_compress -a 142 | dh_fixperms -a 143 | # dh_perl 144 | dh_pycentral -a 145 | dh_python -a 146 | # dh_makeshlibs 147 | dh_installdeb -a 148 | dh_shlibdeps -a 149 | dh_gencontrol -a 150 | dh_md5sums -a 151 | dh_builddeb -a 152 | 153 | binary-indep: 154 | 155 | binary: binary-indep binary-arch 156 | .PHONY: build clean binary-indep binary-arch binary install configure 157 | -------------------------------------------------------------------------------- /debian/changelog: -------------------------------------------------------------------------------- 1 | missingpy (0.10.0.2) unstable; urgency=high 2 | 3 | * Rebuild for newer GHC. 4 | 5 | -- John Goerzen Mon, 19 Jan 2009 16:00:37 -0600 6 | 7 | missingpy (0.10.0.1) unstable; urgency=low 8 | 9 | * Rebuild for newer MissingH, anydbm. 10 | * Added dh_haskell_depends. 11 | 12 | -- John Goerzen Fri, 05 Dec 2008 15:36:30 -0600 13 | 14 | missingpy (0.10.0.0) unstable; urgency=low 15 | 16 | * Updated for newer Cabal infrastructure. 17 | * No more need for gencabal.py 18 | * Updated for newer MissingH, anydbm. 19 | * Updated for Python 2.5. 20 | 21 | -- John Goerzen Fri, 09 May 2008 10:58:04 -0500 22 | 23 | missingpy (0.9.1.0) unstable; urgency=low 24 | 25 | * Updated for newer ghc6 and MissingH. Closes: #428939. 26 | * Updated deps for anydbm. Closes: #429709. 27 | 28 | -- John Goerzen Wed, 30 Jan 2008 01:04:46 -0600 29 | 30 | missingpy (0.9.0) unstable; urgency=low 31 | 32 | * Updated for newer MissingH. Closes: #406816, #409689. 33 | * Ack NMU. Closes: #400391. 34 | 35 | -- John Goerzen Fri, 04 May 2007 02:02:54 -0500 36 | 37 | missingpy (0.8.9.1) unstable; urgency=high 38 | 39 | * Non-maintainer upload. 40 | * Rebuild against fixed python-central to fix ghc-pkg registration 41 | during installation. 42 | * debian/copyright: update FSF address. 43 | * debian/rules: add binary-indep target which is required by policy. 44 | 45 | -- Arjan Oosting Sat, 25 Nov 2006 22:46:14 +0100 46 | 47 | missingpy (0.8.9) unstable; urgency=low 48 | 49 | * Rebuild for GHC 6.6. 50 | 51 | -- John Goerzen Fri, 20 Oct 2006 10:01:14 -0500 52 | 53 | missingpy (0.8.8) unstable; urgency=high 54 | 55 | * Compile tests against python 2.4. Closes: #385993. 56 | * Escaped email addresses in Haddock comments. 57 | 58 | -- John Goerzen Tue, 5 Sep 2006 05:14:15 -0500 59 | 60 | missingpy (0.8.7) unstable; urgency=high 61 | 62 | * Update to new Python policy. 63 | 64 | -- John Goerzen Mon, 4 Sep 2006 09:38:38 -0500 65 | 66 | missingpy (0.8.6) unstable; urgency=low 67 | 68 | * Rebuild against MissingH 0.14.5. Closes: #382364. 69 | 70 | -- John Goerzen Sat, 12 Aug 2006 09:19:19 -0500 71 | 72 | missingpy (0.8.5) unstable; urgency=low 73 | 74 | * Rebuild for GHC 6.4.2. 75 | 76 | -- John Goerzen Mon, 3 Jul 2006 05:57:09 -0500 77 | 78 | missingpy (0.8.4) unstable; urgency=low 79 | 80 | * Rebuild against MissingH 0.14.2. 81 | 82 | -- John Goerzen Thu, 13 Apr 2006 00:46:40 -0500 83 | 84 | missingpy (0.8.3) unstable; urgency=low 85 | 86 | * Rebuild against MissingH 0.14.0. 87 | 88 | -- John Goerzen Thu, 6 Apr 2006 02:45:18 -0500 89 | 90 | missingpy (0.8.2) unstable; urgency=low 91 | 92 | * Bump depends on MissingH. Closes: #357412. 93 | 94 | -- John Goerzen Mon, 20 Mar 2006 20:36:41 -0600 95 | 96 | missingpy (0.8.1) unstable; urgency=low 97 | 98 | * Rebuilt against GHC 6.4.1. 99 | 100 | -- John Goerzen Tue, 18 Oct 2005 12:38:37 -0500 101 | 102 | missingpy (0.8.0) unstable; urgency=low 103 | 104 | * Updated control file to have a more liberal dependency on MissingH. 105 | Closes: #332893. 106 | * Sync Debian package version with version listed in MissingPy.cabal. 107 | 108 | -- John Goerzen Sun, 9 Oct 2005 08:25:19 -0500 109 | 110 | missingpy (0.2.1) unstable; urgency=low 111 | 112 | * Rebuilt for missingh 0.11.2. Closes: #315706. 113 | 114 | -- John Goerzen Fri, 8 Jul 2005 06:15:37 -0500 115 | 116 | missingpy (0.2.0) unstable; urgency=low 117 | 118 | * Now compatible with GHC 6.4. 119 | * Requires MissingH 0.11.0 or above. 120 | 121 | -- John Goerzen Fri, 13 May 2005 04:15:22 -0500 122 | 123 | missingpy (0.1.1) unstable; urgency=low 124 | 125 | * Update for the latest Cabal. 126 | 127 | -- John Goerzen Tue, 5 Apr 2005 14:56:54 -0500 128 | 129 | missingpy (0.1.0) unstable; urgency=low 130 | 131 | * Initial release. Closes: #293510. 132 | 133 | -- John Goerzen Wed, 26 Jan 2005 10:34:22 -0600 134 | 135 | -------------------------------------------------------------------------------- /testsrc/Dicttest.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS -fallow-overlapping-instances #-} 2 | {- arch-tag: AnyDBM/Dict Python Tests Main File 3 | Copyright (C) 2004-2005 John Goerzen 4 | 5 | This program is free software; you can redistribute it and/or modify 6 | it under the terms of the GNU General Public License as published by 7 | the Free Software Foundation; either version 2 of the License, or 8 | (at your option) any later version. 9 | 10 | This program is distributed in the hope that it will be useful, 11 | but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | GNU General Public License for more details. 14 | 15 | You should have received a copy of the GNU General Public License 16 | along with this program; if not, write to the Free Software 17 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 18 | -} 19 | 20 | module Dicttest(mf, generic_test, tests) where 21 | import Test.HUnit 22 | import Data.List.Utils 23 | import System.IO.HVFS 24 | import System.IO.HVFS.InstanceHelpers 25 | import Database.AnyDBM 26 | import Database.AnyDBM.StringDBM 27 | import Database.AnyDBM.MapDBM 28 | import Data.HashTable 29 | import Data.List(sort) 30 | import Control.Exception(finally) 31 | import Python.Objects 32 | import Python.Objects.Dict 33 | 34 | mf :: AnyDBM a => IO b -> (b -> IO a) -> String -> (a -> Assertion) -> Test 35 | mf initfunc openfunc msg code = 36 | TestLabel msg $ TestCase $ do i <- initfunc 37 | h <- openfunc i 38 | finally (code h) (closeA h) 39 | 40 | infix 1 @>=? 41 | (@>=?) :: (Eq a, Show a) => a -> IO a -> Assertion 42 | (@>=?) exp res = do r <- res 43 | exp @=? r 44 | 45 | deleteall h = do k <- keysA h 46 | mapM_ (deleteA h) k 47 | [] @>=? keysA h 48 | 49 | weirdl = sort $ [("", "empty"), 50 | ("foo\nbar", "v1\0v2"), 51 | ("v3,v4", ""), 52 | ("k\0ey", "\xFF")] 53 | 54 | generic_test initfunc openfunc = 55 | let f = mf initfunc openfunc in 56 | [ 57 | f "empty" $ \h -> do [] @>=? keysA h 58 | [] @>=? valuesA h 59 | [] @>=? toListA h 60 | Nothing @>=? lookupA h "foo" 61 | 62 | ,f "basic" $ \h -> do insertA h "key" "value" 63 | (Just "value") @>=? lookupA h "key" 64 | [("key", "value")] @>=? toListA h 65 | insertA h "key" "v2" 66 | [("key", "v2")] @>=? toListA h 67 | deleteA h "key" 68 | [] @>=? toListA h 69 | ,f "mult" $ \h -> do insertListA h [("1", "2"), ("3", "4"), ("5", "6")] 70 | [("1", "2"), ("3", "4"), ("5", "6")] @>=? 71 | (toListA h >>= return . sort) 72 | ["1", "3", "5"] @>=? (keysA h >>= return . sort) 73 | ["2", "4", "6"] @>=? (valuesA h >>= return . sort) 74 | deleteall h 75 | ,f "weirdchars" $ \h -> do insertListA h weirdl 76 | weirdl @>=? (toListA h >>= return . sort) 77 | deleteall h 78 | ] 79 | 80 | generic_persist_test initfunc openfunc = 81 | let f = mf initfunc openfunc in 82 | [ 83 | f "empty" deleteall 84 | ,f "weirdpop" $ \h -> insertListA h weirdl 85 | ,f "weirdcheck" $ \h -> do weirdl @>=? (toListA h >>= return . sort) 86 | deleteall h 87 | insertA h "key" "value" 88 | ,f "step3" $ \h -> do [("key", "value")] @>=? (toListA h >>= return . sort) 89 | insertA h "key" "v2" 90 | insertA h "z" "y" 91 | ,f "step4" $ \h -> do [("key", "v2"), ("z", "y")] @>=? 92 | (toListA h >>= return . sort) 93 | ,f "cleanup" deleteall 94 | ] 95 | 96 | test_dict = generic_test (return ()) 97 | (\_ -> toPyObject ([]::[(String, String)]) >>= return . mkPyDict) 98 | 99 | 100 | 101 | tests = TestList [TestLabel "Basic Dict" (TestList test_dict) 102 | ] 103 | 104 | 105 | 106 | -------------------------------------------------------------------------------- /genexceptions.hs: -------------------------------------------------------------------------------- 1 | import MissingH.Str 2 | import Data.List 3 | import System.IO 4 | import Data.Char 5 | 6 | notice = " NOTICE -- THIS FILE IS AUTO-GENERATED -- DO NOT EDIT" 7 | 8 | ifdefcode str = 9 | "#ifdef MS_WINDOWS\n" ++ str ++ "\n#endif\n" 10 | 11 | windowsexc = "WindowsError" 12 | 13 | genGlue copyright excs = 14 | do h <- openFile "glue/excglue.h" WriteMode 15 | c <- openFile "glue/excglue.c" WriteMode 16 | let heads = "/* " ++ notice ++ "\n" ++ copyright ++ 17 | "*/\n#include " 18 | hPutStrLn h heads 19 | hPutStrLn c heads 20 | hPutStrLn h $ unlines . map excfunch $ excs 21 | hPutStrLn h $ ifdefcode $ excfunch windowsexc 22 | hPutStrLn c $ unlines . map excfuncc $ excs 23 | hPutStrLn c $ ifdefcode $ excfuncc windowsexc 24 | hClose h 25 | hClose c 26 | where excfunch e = 27 | "extern PyObject *hspy_" ++ e ++ "(void);" 28 | excfuncc e = 29 | "PyObject *hspy_" ++ e ++ "(void) { return PyExc_" ++ e 30 | ++ "; }" 31 | 32 | genExcTypes copyright excs = 33 | do h <- openFile "Python/Exceptions/ExcTypes.hsc" WriteMode 34 | hPutStrLn h $ "{- " ++ notice ++ "\n" ++ copyright ++ 35 | "-}" 36 | hPutStrLn h $ unlines $ 37 | ["{- |", 38 | " Module : Python.Exceptions.ExcTypes", 39 | " Copyright : Copyright (C) 2005 John Goerzen", 40 | " License : GNU GPL, version 2 or above", 41 | "", 42 | " Maintainer : John Goerzen,", 43 | " Maintainer : jgoerzen\@complete.org", 44 | " Stability : provisional", 45 | " Portability: portable", 46 | "", 47 | "Python low-level exception definitions", 48 | "", 49 | "These are definitions of the built-in Python exception objects. You can", 50 | "use them with 'MissingPy.Python.Exceptions.doesExceptionMatch' and", 51 | "'MissingPy.Python.Exceptions.catchSpecificPy'.", 52 | "", 53 | "The meanings of these exceptions can be found at", 54 | ".", 55 | "", 56 | "Please note that windowsError is available only on Microsoft platforms.", 57 | "", 58 | "Written by John Goerzen, jgoerzen\\@complete.org", 59 | "-}", 60 | "#include ", 61 | "module Python.Exceptions.ExcTypes", 62 | "("] 63 | hPutStrLn h $ concat $ intersperse ",\n" . map hsname $ excs 64 | hPutStrLn h $ ifdefcode $ "," ++ (hsname windowsexc) 65 | hPutStrLn h ")\nwhere" 66 | hPutStrLn h $ unlines $ 67 | ["import Python.Types", 68 | "import Python.Objects", 69 | "import System.IO.Unsafe", 70 | "import Python.Utils", 71 | "import Foreign", 72 | "exctypes_internal_e :: IO (Ptr CPyObject) -> IO PyObject", 73 | "exctypes_internal_e f = do p <- f", 74 | " fp <- newForeignPtr_ p", 75 | " return $ PyObject fp" 76 | ] 77 | hPutStrLn h $ unlines . map hsfunc $ excs 78 | hPutStrLn h $ ifdefcode $ hsfunc windowsexc 79 | hPutStrLn h $ unlines . map cfunc $ excs 80 | hPutStrLn h $ ifdefcode $ cfunc windowsexc 81 | hClose h 82 | where hsname "Exception" = "pyMainException" 83 | hsname "EOFError" = "pyEOFError" 84 | hsname "IOError" = "pyIOError" 85 | hsname "OSError" = "pyOSError" 86 | hsname (x:xs) = toLower x : xs 87 | hscomment "Exception" = "-- | This is Exception in Python; renamed to avoid naming conflicts here.\n" 88 | hscomment _ = "" 89 | hsfunc exc = 90 | hscomment exc ++ 91 | "{-# NOINLINE " ++ hsname exc ++ " #-}\n" ++ 92 | hsname exc ++ " = unsafePerformIO $ exctypes_internal_e " ++ 93 | "c" ++ exc ++ "\n" 94 | cfunc exc = 95 | "foreign import ccall unsafe \"excglue.h hspy_" ++ exc ++ "\"\n" ++ 96 | " c" ++ exc ++ " :: IO (Ptr CPyObject)\n" 97 | 98 | 99 | main = do c <- readFile "exceptionlist" 100 | copyright <- readFile "COPYRIGHT" 101 | let excs = sort . map strip . filter (/= "") . lines $ c 102 | genGlue copyright excs 103 | genExcTypes copyright excs 104 | -------------------------------------------------------------------------------- /Python/Exceptions.hs: -------------------------------------------------------------------------------- 1 | {- arch-tag: Python low-level exception handling 2 | Copyright (C) 2005 John Goerzen 3 | 4 | This program is free software; you can redistribute it and/or modify 5 | it under the terms of the GNU General Public License as published by 6 | the Free Software Foundation; either version 2 of the License, or 7 | (at your option) any later version. 8 | 9 | This program is distributed in the hope that it will be useful, 10 | but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | GNU General Public License for more details. 13 | 14 | You should have received a copy of the GNU General Public License 15 | along with this program; if not, write to the Free Software 16 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 17 | -} 18 | 19 | {- | 20 | Module : Python.Exceptions 21 | Copyright : Copyright (C) 2005 John Goerzen 22 | License : GNU GPL, version 2 or above 23 | 24 | Maintainer : John Goerzen, 25 | Maintainer : jgoerzen\@complete.org 26 | Stability : provisional 27 | Portability: portable 28 | 29 | Python low-level exception handling 30 | 31 | Written by John Goerzen, jgoerzen\@complete.org 32 | -} 33 | 34 | module Python.Exceptions (-- * Types 35 | PyException(..), 36 | -- * General Catching 37 | catchPy, 38 | handlePy, 39 | pyExceptions, 40 | -- * Catching of specific Python exceptions 41 | catchSpecificPy, 42 | -- * Exception Object Operations 43 | formatException, 44 | doesExceptionMatch, 45 | -- * Re-Raising Exceptions 46 | exc2ioerror 47 | ) 48 | where 49 | 50 | import Python.Utils (withPyObject, checkCInt) 51 | import Python.Objects (strOf) 52 | import Python.Types ( 53 | excType 54 | , excValue 55 | , excFormatted 56 | , PyObject 57 | , PyException 58 | ) 59 | import Data.Dynamic (fromDynamic) 60 | import Python.ForeignImports (pyErr_GivenExceptionMatches) 61 | import Control.OldException (throwDyn, catchDyn, dynExceptions, Exception) 62 | 63 | {- | Execute the given IO action. 64 | 65 | If it raises a 'PyException', then execute the supplied handler and return 66 | its return value. Otherwise, process as normal. -} 67 | catchPy :: IO a -> (PyException -> IO a) -> IO a 68 | catchPy = catchDyn 69 | 70 | {- | Like 'catchPy', with the order of arguments reversed. -} 71 | handlePy :: (PyException -> IO a) -> IO a -> IO a 72 | handlePy = flip catchPy 73 | 74 | {- | Like catchPy, but catches only instances of the Python class given 75 | (see 'doesExceptionMatch'). -} 76 | catchSpecificPy :: PyObject -> IO a -> (PyException -> IO a) -> IO a 77 | catchSpecificPy pyo action handlerfunc = 78 | let handler e = do d <- doesExceptionMatch e pyo 79 | if d 80 | then handlerfunc e 81 | else throwDyn e 82 | in catchPy action handler 83 | 84 | {- | Useful as the first argument to catchJust, tryJust, or handleJust. 85 | Return Nothing if the given exception is not a 'PyException', or 86 | the exception otherwise. -} 87 | pyExceptions :: Exception -> Maybe PyException 88 | pyExceptions exc = dynExceptions exc >>= fromDynamic 89 | 90 | {- | When an exception is thrown, it is not immediately formatted. 91 | 92 | This call will format it. -} 93 | formatException :: PyException -> IO PyException 94 | formatException e = 95 | {- 96 | do fmt <- callByName "traceback.format_exception" 97 | [excType e, excValue e, excTraceBack e] [] >>= fromPyObject 98 | -} 99 | do ename <- strOf (excType e) 100 | evalue <- strOf (excValue e) 101 | let fmt = ename ++ ": " ++ evalue 102 | return $ e {excFormatted = fmt} 103 | 104 | {- | Returns true if the passed 'PyException' matches the given Python 105 | exception class or one of its subclasses. Standard Python exception classes 106 | are given in 'Python.Exceptions.ExcTypes'. -} 107 | doesExceptionMatch :: PyException -> PyObject -> IO Bool 108 | doesExceptionMatch e pyo = 109 | withPyObject (excType e) (\ctyp -> 110 | withPyObject pyo (\cpo -> 111 | do r <- pyErr_GivenExceptionMatches ctyp cpo >>= checkCInt 112 | if r == 0 113 | then return False 114 | else return True 115 | )) 116 | 117 | {- | A handler for use in 'catchPy' or 'handlePy'. Grabs the Python exception, 118 | describes it, and raises the description in the IO monad with 'fail'. -} 119 | exc2ioerror :: PyException -> IO a 120 | exc2ioerror e = do e2 <- formatException e 121 | fail $ "Python " ++ show e2 122 | 123 | -------------------------------------------------------------------------------- /testsrc/AnyDBMtest.hs: -------------------------------------------------------------------------------- 1 | {- arch-tag: AnyDBM tests main file 2 | Copyright (C) 2004-2005 John Goerzen 3 | 4 | This program is free software; you can redistribute it and/or modify 5 | it under the terms of the GNU General Public License as published by 6 | the Free Software Foundation; either version 2 of the License, or 7 | (at your option) any later version. 8 | 9 | This program is distributed in the hope that it will be useful, 10 | but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | GNU General Public License for more details. 13 | 14 | You should have received a copy of the GNU General Public License 15 | along with this program; if not, write to the Free Software 16 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 17 | -} 18 | 19 | module AnyDBMtest(mf, generic_persist_test, generic_test, tests) where 20 | import Test.HUnit 21 | import Data.List.Utils 22 | import System.IO.HVFS 23 | import System.IO.HVFS.InstanceHelpers 24 | import Database.AnyDBM 25 | import Database.AnyDBM.StringDBM 26 | import Database.AnyDBM.MapDBM 27 | import System.Directory 28 | import System.IO.HVFS.Utils 29 | import Data.HashTable 30 | import Data.List(sort) 31 | import Control.Exception(finally) 32 | 33 | mf :: AnyDBM a => IO b -> (b -> IO a) -> String -> (a -> Assertion) -> Test 34 | mf initfunc openfunc msg code = 35 | TestLabel msg $ TestCase $ do i <- initfunc 36 | h <- openfunc i 37 | finally (code h) (closeA h) 38 | 39 | infix 1 @>=? 40 | (@>=?) :: (Eq a, Show a) => a -> IO a -> Assertion 41 | (@>=?) exp res = do r <- res 42 | exp @=? r 43 | 44 | deleteall h = do k <- keysA h 45 | mapM_ (deleteA h) k 46 | [] @>=? keysA h 47 | 48 | weirdl = sort $ [("", "empty"), 49 | ("foo\nbar", "v1\0v2"), 50 | ("v3,v4", ""), 51 | ("k\0ey", "\xFF")] 52 | 53 | createdir = TestCase $ createDirectory "testtmp" 54 | removedir = TestCase $ recursiveRemove SystemFS "testtmp" 55 | 56 | generic_test initfunc openfunc = 57 | let f = mf initfunc openfunc in 58 | [ 59 | createdir 60 | ,f "empty" $ \h -> do [] @>=? keysA h 61 | [] @>=? valuesA h 62 | [] @>=? toListA h 63 | Nothing @>=? lookupA h "foo" 64 | 65 | ,f "basic" $ \h -> do insertA h "key" "value" 66 | (Just "value") @>=? lookupA h "key" 67 | [("key", "value")] @>=? toListA h 68 | insertA h "key" "v2" 69 | [("key", "v2")] @>=? toListA h 70 | deleteA h "key" 71 | [] @>=? toListA h 72 | ,f "mult" $ \h -> do insertListA h [("1", "2"), ("3", "4"), ("5", "6")] 73 | [("1", "2"), ("3", "4"), ("5", "6")] @>=? 74 | (toListA h >>= return . sort) 75 | ["1", "3", "5"] @>=? (keysA h >>= return . sort) 76 | ["2", "4", "6"] @>=? (valuesA h >>= return . sort) 77 | deleteall h 78 | ,f "weirdchars" $ \h -> do insertListA h weirdl 79 | weirdl @>=? (toListA h >>= return . sort) 80 | deleteall h 81 | ,removedir 82 | ] 83 | 84 | generic_persist_test initfunc openfunc = 85 | let f = mf initfunc openfunc in 86 | [ 87 | createdir 88 | ,f "empty" deleteall 89 | ,f "weirdpop" $ \h -> insertListA h weirdl 90 | ,f "weirdcheck" $ \h -> do weirdl @>=? (toListA h >>= return . sort) 91 | deleteall h 92 | insertA h "key" "value" 93 | ,f "step3" $ \h -> do [("key", "value")] @>=? (toListA h >>= return . sort) 94 | insertA h "key" "v2" 95 | insertA h "z" "y" 96 | ,f "step4" $ \h -> do [("key", "v2"), ("z", "y")] @>=? 97 | (toListA h >>= return . sort) 98 | ,f "cleanupdb" deleteall 99 | ,removedir 100 | ] 101 | 102 | test_hashtable = generic_test (return ()) 103 | (\_ -> ((new (==) hashString)::IO (HashTable String String))) 104 | 105 | test_map = generic_test (return ()) 106 | (\_ -> newMapDBM) 107 | test_stringdbm = generic_persist_test (return SystemFS) 108 | (\f -> openStringVDBM f "testtmp/StringDBM" ReadWriteMode) 109 | ++ 110 | generic_test (return SystemFS) 111 | (\f -> openStringVDBM f "testtmp/StringDBM" ReadWriteMode) 112 | 113 | tests = TestList [TestLabel "HashTable" (TestList test_hashtable), 114 | TestLabel "StringDBM" (TestList test_stringdbm), 115 | TestLabel "Map" (TestList test_map) 116 | ] 117 | 118 | 119 | 120 | -------------------------------------------------------------------------------- /Python/Objects/Dict.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverlappingInstances#-} 2 | 3 | {- arch-tag: Python dict-like objects 4 | Copyright (C) 2005 John Goerzen 5 | 6 | This program is free software; you can redistribute it and/or modify 7 | it under the terms of the GNU General Public License as published by 8 | the Free Software Foundation; either version 2 of the License, or 9 | (at your option) any later version. 10 | 11 | This program is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU General Public License for more details. 15 | 16 | You should have received a copy of the GNU General Public License 17 | along with this program; if not, write to the Free Software 18 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 19 | -} 20 | 21 | {- | 22 | Module : Python.Objects.Dict 23 | Copyright : Copyright (C) 2005 John Goerzen 24 | License : GNU GPL, version 2 or above 25 | 26 | Maintainer : John Goerzen, 27 | Maintainer : jgoerzen\@complete.org 28 | Stability : provisional 29 | Portability: portable 30 | 31 | Python dict-like objects 32 | 33 | Written by John Goerzen, jgoerzen\@complete.org 34 | 35 | This module can be used to access Python dicts and dict-like objects such as 36 | dbm databases. For a higher-level interface to creating and working with these 37 | dbm interfaces, please see the functions in "MissingPy.AnyDBM". Also, 38 | for functions that use this, please see "Database.AnyDBM". 39 | 40 | -} 41 | 42 | module Python.Objects.Dict (PyDict, 43 | mkPyDict, 44 | fromPyDict) 45 | where 46 | import Python.ForeignImports (pyObject_SetItem, pyObject_DelItem, pyObject_GetItem, pyErr_Clear, pyMapping_Keys) 47 | import Python.Objects( 48 | toPyObject 49 | , fromPyObject 50 | , hasattr 51 | , noKwParms 52 | , noParms 53 | , runMethodHs 54 | , toPyObject 55 | ) 56 | import Python.Utils (withPyObject, checkCInt, fromCPyObject) 57 | import Foreign (Ptr, nullPtr) 58 | import Python.Exceptions (catchPy, exc2ioerror) 59 | import Database.AnyDBM (AnyDBM (..)) 60 | import Python.Types (PyObject, CPyObject) 61 | 62 | {- | The basic type for a Python dict or dict-like object. -} 63 | newtype PyDict = PyDict 64 | PyObject -- Main dict object 65 | 66 | {- | Takes a 'PyObject' representing a Python dict or dict-like objext 67 | and makes it into a 'PyDict'. -} 68 | mkPyDict :: PyObject -> PyDict 69 | mkPyDict o = PyDict o 70 | 71 | {- | Takes a 'PyDict' and returns its internal 'PyObject'. -} 72 | fromPyDict :: PyDict -> PyObject 73 | fromPyDict (PyDict o) = o 74 | 75 | {- | Wrap an operation, raising exceptions in the IO monad as appropriate. -} 76 | pydwrap :: PyDict -> (PyObject -> IO a) -> IO a 77 | pydwrap (PyDict pyobj) func = catchPy (func pyobj) exc2ioerror 78 | 79 | {- | Give it a CPyObject instead. -} 80 | cpydwrap :: PyDict -> (Ptr CPyObject -> IO a) -> IO a 81 | cpydwrap x func = pydwrap x (\y -> withPyObject y func) 82 | 83 | instance AnyDBM PyDict where 84 | insertA h k v = 85 | do ko <- toPyObject k 86 | kv <- toPyObject v 87 | withPyObject ko (\ck -> 88 | withPyObject kv (\cv -> 89 | cpydwrap h (\cdict -> 90 | pyObject_SetItem cdict ck cv >>= checkCInt >> return() 91 | ) 92 | ) 93 | ) 94 | deleteA h k = 95 | do ko <- toPyObject k 96 | withPyObject ko (\ck -> 97 | cpydwrap h (\cdict -> 98 | pyObject_DelItem cdict ck >>= checkCInt >> return ())) 99 | lookupA h k = 100 | do ko <- toPyObject k 101 | withPyObject ko (\ck -> 102 | cpydwrap h (\cdict -> 103 | do r <- pyObject_GetItem cdict ck 104 | if r == nullPtr 105 | then do pyErr_Clear -- Ignore this exception 106 | return Nothing 107 | else do retval <- fromCPyObject r >>= fromPyObject 108 | return $ Just retval 109 | )) 110 | {- 111 | toListA h = 112 | This used to be: 113 | pydwrap h fromPyObject 114 | but some *dbm's are incompatible with that. Sigh. -} 115 | 116 | keysA h = 117 | cpydwrap h (\ch -> 118 | do keysobj <- pyMapping_Keys ch >>= fromCPyObject 119 | keys <- (fromPyObject keysobj)::IO [String] 120 | return keys 121 | ) 122 | 123 | flushA h = pydwrap h (\pyo -> do h <- hasattr pyo "sync" 124 | if h 125 | then runMethodHs pyo "sync" noParms noKwParms 126 | else return () 127 | ) 128 | 129 | closeA h = pydwrap h (\pyo -> do h <- hasattr pyo "close" 130 | if h 131 | then runMethodHs pyo "close" noParms noKwParms 132 | else return () 133 | ) 134 | 135 | 136 | 137 | 138 | -------------------------------------------------------------------------------- /Python/Utils.hs: -------------------------------------------------------------------------------- 1 | {- arch-tag: Python low-level utilities 2 | Copyright (C) 2005 John Goerzen 3 | 4 | This program is free software; you can redistribute it and/or modify 5 | it under the terms of the GNU General Public License as published by 6 | the Free Software Foundation; either version 2 of the License, or 7 | (at your option) any later version. 8 | 9 | This program is distributed in the hope that it will be useful, 10 | but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | GNU General Public License for more details. 13 | 14 | You should have received a copy of the GNU General Public License 15 | along with this program; if not, write to the Free Software 16 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 17 | -} 18 | 19 | {- | 20 | Module : Python.Utils 21 | Copyright : Copyright (C) 2005 John Goerzen 22 | License : GNU GPL, version 2 or above 23 | 24 | Maintainer : John Goerzen, 25 | Maintainer : jgoerzen\@complete.org 26 | Stability : provisional 27 | Portability: portable 28 | 29 | Python low-level utilities 30 | 31 | Written by John Goerzen, jgoerzen\@complete.org 32 | 33 | Please use sparingly and with caution. The documentation for their behavior 34 | should be considered to be the source code. 35 | -} 36 | 37 | module Python.Utils (-- * Objects 38 | fromCPyObject, 39 | withPyObject, 40 | maybeWithPyObject, 41 | -- * Exceptions 42 | raisePyException, 43 | checkCInt, 44 | -- * Environment 45 | getDefaultGlobals, 46 | pyImport_AddModule, 47 | pyModule_GetDict, 48 | py_incref 49 | ) 50 | where 51 | import Python.Types ( 52 | CPyObject(..) 53 | , PyObject(..) 54 | , PyException(excType, excValue, excTraceBack, excFormatted, PyException) 55 | ) 56 | import Python.ForeignImports ( 57 | cNone 58 | , cpyImport_AddModule 59 | , cpyModule_GetDict 60 | , pyErr_Clear 61 | , pyErr_Fetch 62 | , pyErr_NormalizeException 63 | , py_decref 64 | , py_incref 65 | , py_incref 66 | ) 67 | 68 | import Foreign.C.Types (CInt) 69 | import Foreign.C (withCString) 70 | import Foreign (peek, Ptr, newForeignPtr, nullPtr, alloca, withForeignPtr) 71 | import Control.OldException (throwDyn) 72 | 73 | {- | Convert a Ptr 'CPyObject' to a 'PyObject'. -} 74 | fromCPyObject :: Ptr CPyObject -> IO PyObject 75 | fromCPyObject po = 76 | if po == nullPtr 77 | then raisePyException 78 | else do fp <- newForeignPtr py_decref po 79 | return $ PyObject fp 80 | 81 | {- | Called to make sure the passed CInt isn't -1. Raise an exception if 82 | it is. -} 83 | checkCInt :: CInt -> IO CInt 84 | checkCInt x = 85 | if x == (-1) 86 | then raisePyException 87 | else return x 88 | 89 | {- | Called when a Python exception has been detected. It will raise 90 | the exception in Haskell. -} 91 | raisePyException :: IO a 92 | raisePyException = 93 | let noneorptr cval = if cval == nullPtr 94 | then do p <- cNone 95 | fromCPyObject p 96 | else fromCPyObject cval 97 | in alloca (\typeptr -> alloca (\valptr -> alloca (\tbptr -> 98 | do pyErr_Fetch typeptr valptr tbptr 99 | pyErr_NormalizeException typeptr valptr tbptr 100 | ctype <- peek typeptr 101 | cval <- peek valptr 102 | ctb <- peek tbptr 103 | otype <- noneorptr ctype 104 | oval <- noneorptr cval 105 | otb <- noneorptr ctb 106 | --seq otype $ return () 107 | --seq oval $ return () 108 | --seq otb $ return () 109 | let exc = PyException {excType = otype, excValue = oval, 110 | excTraceBack = otb, 111 | excFormatted = ""} 112 | pyErr_Clear 113 | throwDyn exc 114 | ))) 115 | {- 116 | do cpy <- getexc 117 | let (exc, val, tb) = cpy 118 | --pyErr_Print 119 | fail "Python Error!" 120 | where getexc = do cexc <- hspy_getexc 121 | exc <- peekArray 3 cexc 122 | exc2 <- mapM fromCPyObject exc 123 | case exc2 of 124 | [x, y, z] -> return (x, y, z) 125 | _ -> fail "Got unexpected number of elements" 126 | -} 127 | 128 | {- | Uses a 'PyObject' in a function that needs Ptr 'CPyObject'. -} 129 | withPyObject :: PyObject -> (Ptr CPyObject -> IO b) -> IO b 130 | withPyObject (PyObject x) = withForeignPtr x 131 | 132 | {- | Same as 'withPyObject', but uses nullPtr if the input is Nothing. -} 133 | maybeWithPyObject :: Maybe PyObject -> (Ptr CPyObject -> IO b) -> IO b 134 | maybeWithPyObject Nothing func = func nullPtr 135 | maybeWithPyObject (Just x) y = withPyObject x y 136 | 137 | {- | Returns the default globals environment. -} 138 | getDefaultGlobals :: IO PyObject 139 | getDefaultGlobals = 140 | do m <- pyImport_AddModule "__main__" 141 | pyModule_GetDict m 142 | 143 | {- | Wrapper around C PyImport_AddModule, which looks up an existing module -} 144 | pyImport_AddModule :: String -> IO PyObject 145 | pyImport_AddModule x = 146 | withCString x (\cstr -> 147 | do r <- cpyImport_AddModule cstr 148 | py_incref r 149 | fromCPyObject r 150 | ) 151 | 152 | {- | Gets the dict associated with a module. -} 153 | pyModule_GetDict :: PyObject -> IO PyObject 154 | pyModule_GetDict x = 155 | withPyObject x (\cpyo -> 156 | do r <- cpyModule_GetDict cpyo 157 | py_incref r 158 | fromCPyObject r) 159 | 160 | -------------------------------------------------------------------------------- /testsrc/Objectstest.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS -fallow-overlapping-instances #-} 2 | {- arch-tag: Object tests main file 3 | Copyright (C) 2005 John Goerzen 4 | 5 | This program is free software; you can redistribute it and/or modify 6 | it under the terms of the GNU General Public License as published by 7 | the Free Software Foundation; either version 2 of the License, or 8 | (at your option) any later version. 9 | 10 | This program is distributed in the hope that it will be useful, 11 | but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | GNU General Public License for more details. 14 | 15 | You should have received a copy of the GNU General Public License 16 | along with this program; if not, write to the Free Software 17 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 18 | -} 19 | 20 | module Objectstest(tests) where 21 | import Test.HUnit 22 | import Python.Objects 23 | import Foreign.C.Types 24 | import Python.Types 25 | import Data.List 26 | import Python.Interpreter 27 | 28 | f msg inp code exp = TestLabel msg $ TestCase $ do pyo <- toPyObject inp 29 | r <- code pyo 30 | exp @=? r 31 | 32 | test_base = 33 | [ 34 | f "showPyObject" (5::CInt) showPyObject ": 5" 35 | ] 36 | 37 | test_lists = 38 | [ 39 | f "empty" ([]::[CInt]) fromPyObject ([]::[CInt]) 40 | ,f "repr empty" ([]::[CInt]) reprOf "[]" 41 | ,f "some cints" [1::CInt, 2, 3] fromPyObject [1::CInt, 2, 3] 42 | ,f "some cints repr" [1::CInt, 2, 3] reprOf "[1, 2, 3]" 43 | ,f "strings" ["foo", "bar"] fromPyObject ["foo", "bar"] 44 | ,f "strings repr" ["foo", "bar"] reprOf "['foo', 'bar']" 45 | ] 46 | 47 | test_al = 48 | [ 49 | f "emptypyo" ([]::[(PyObject, PyObject)]) fromPyObject 50 | ([]::[(PyObject, PyObject)]) 51 | ,f "cint to cint" [(1::CInt, 2::CInt), (3, 4)] 52 | (\x -> fromPyObject x >>= return . sort) 53 | [(1::CInt, 2::CInt), (3, 4)] 54 | ] 55 | 56 | test_functions = 57 | [ 58 | f "typestr" (5::CInt) (\x -> typeOf x >>= strOf) "" 59 | ,f "repr" ["foo", "bar"] reprOf "['foo', 'bar']" 60 | ] 61 | 62 | test_strings = 63 | [ 64 | f "empty" ([]::String) fromPyObject ([]::String) 65 | ,f "basic" "foo" fromPyObject "foo" 66 | ,f "dquotes" "foo\"" fromPyObject "foo\"" 67 | ,f "squotes" "foo'" fromPyObject "foo'" 68 | ,f "embedded null" "foo\0bar" fromPyObject "foo\0bar" 69 | ,f "null only" "\0" fromPyObject "\0" 70 | ,f "quotes" "\"'\"" fromPyObject "\"'\"" 71 | ] 72 | 73 | test_ints = 74 | [ 75 | f "0L" (0::CLong) fromPyObject (0::CLong) 76 | ,f "-5L" (-5::CLong) fromPyObject (-5::CLong) 77 | ,f "5L" (5::CLong) fromPyObject (5::CLong) 78 | ,f "max long" (maxBound::CLong) fromPyObject (maxBound::CLong) 79 | ,f "min long" (minBound::CLong) fromPyObject (minBound::CLong) 80 | ,f "0i" (0::CInt) fromPyObject (0::CInt) 81 | ,f "-5i" (-5::CInt) fromPyObject (-5::CInt) 82 | ,f "5i" (5::CInt) fromPyObject (5::CInt) 83 | ,f "min int" (minBound::CInt) fromPyObject (minBound::CInt) 84 | ,f "max int" (maxBound::CInt) fromPyObject (maxBound::CInt) 85 | ,f "long/int" (12345::CLong) fromPyObject (12345::CInt) 86 | ,f "int/long" (12354::CInt) fromPyObject (12354::CInt) 87 | ,f "repr max" (maxBound::CLong) reprOf (show (maxBound::CLong)) 88 | ,f "str min" (minBound::CLong) strOf (show (minBound::CLong)) 89 | ] 90 | 91 | test_longs = 92 | [ 93 | f "0" (0::Integer) fromPyObject (0::Integer) 94 | ,f "-5" (-5::Integer) fromPyObject (-5::Integer) 95 | ,f "5" (5::Integer) fromPyObject (5::Integer) 96 | ,f "2^384" ((2 ^ 384)::Integer) fromPyObject ((2 ^ 384)::Integer) 97 | ,f "2^384*-1" (( 2 ^ 384 * (-1))::Integer) fromPyObject ((2 ^ 384 * (-1))::Integer) 98 | ,f "str 2^384" ((2 ^ 384)::Integer) strOf (show ((2 ^ 384)::Integer)) 99 | ] 100 | 101 | test_doubles = 102 | [ 103 | f "0" (0::CDouble) fromPyObject (0::CDouble) 104 | ,f "-5" (-5::CDouble) fromPyObject (-5::CDouble) 105 | ,f "5.1234" (5.1234::CDouble) fromPyObject (5.1234::CDouble) 106 | ,f "str 5.1234" (5.1234::CDouble) strOf "5.1234" 107 | ,f "2^384" ((2^384)::CDouble) fromPyObject ((2^384)::CDouble) 108 | ,f "2^384*-1" ((2^384 * (-1)::CDouble)) fromPyObject ((2^384 * (-1)::CDouble)) 109 | ,f "1/(2^384)" ((1 / (2 ^ 384))::CDouble) fromPyObject 110 | ((1 / (2 ^ 384))::CDouble) 111 | ] 112 | 113 | test_dicts = 114 | [ 115 | f "empty" ([]::[(String, String)]) fromPyObject ([]::[(String, String)]) 116 | ,f "one s" [("foo", "bar")] fromPyObject [("foo", "bar")] 117 | ,f "mult s" [("foo", "bar"), ("quux", "baz")] 118 | (\x -> fromPyObject x >>= return . sort) 119 | [("foo", "bar"), ("quux", "baz")] 120 | ,f "s2i" [("foo", 1::CLong), ("quux", 2)] 121 | (\x -> fromPyObject x >>= return . sort) 122 | [("foo", 1::CLong), ("quux", 2)] 123 | ] 124 | 125 | 126 | test_call = 127 | [ 128 | TestCase $ do func <- pyRun_String "repr" Py_eval_input [] 129 | r <- pyObject_CallHs func [5::Integer] ([]::[(String, String)]) 130 | "5L" @=? r 131 | ] 132 | 133 | test_dir = 134 | [ 135 | TestCase $ do dv <- toPyObject ([]::String) >>= dirPyObject 136 | assertBool "replace" $ "replace" `elem` dv 137 | assertBool "rindex" $ "rindex" `elem` dv 138 | ] 139 | 140 | test_attr = 141 | [ 142 | TestCase $ do pyImport "md5" 143 | md5 <- pyRun_String "md5.md5()" Py_eval_input [] 144 | fupdate <- getattr md5 "update" 145 | fhexdigest <- getattr md5 "hexdigest" 146 | pyObject_RunHs fupdate ["hi"] noKwParms 147 | pyObject_RunHs fupdate ["there"] noKwParms 148 | r <- pyObject_CallHs fhexdigest noParms noKwParms 149 | "a8b767bb9cf0938dc7f40603f33987e5" @=? r 150 | ,TestCase $ do pyImport "md5" 151 | md5 <- pyRun_String "md5.md5()" Py_eval_input [] 152 | runMethodHs md5 "update" ["hi"] noKwParms 153 | runMethodHs md5 "update" ["there"] noKwParms 154 | r <- callMethodHs md5 "hexdigest" noParms noKwParms 155 | "a8b767bb9cf0938dc7f40603f33987e5" @=? r 156 | 157 | ] 158 | 159 | tests = TestList [TestLabel "base" (TestList test_base), 160 | TestLabel "lists/tuples" (TestList test_lists), 161 | TestLabel "al" (TestList test_al), 162 | TestLabel "functions" (TestList test_functions), 163 | TestLabel "strings" (TestList test_strings), 164 | TestLabel "ints" (TestList test_ints), 165 | TestLabel "longs" (TestList test_longs), 166 | TestLabel "doubles" (TestList test_doubles), 167 | TestLabel "dir" (TestList test_dir), 168 | TestLabel "call" (TestList test_call), 169 | TestLabel "attr" (TestList test_attr), 170 | TestLabel "dict" (TestList test_dicts) 171 | ] 172 | -------------------------------------------------------------------------------- /Python/ForeignImports.hsc: -------------------------------------------------------------------------------- 1 | {- arch-tag: Python foreign imports 2 | Copyright (C) 2005 John Goerzen 3 | 4 | This program is free software; you can redistribute it and/or modify 5 | it under the terms of the GNU General Public License as published by 6 | the Free Software Foundation; either version 2 of the License, or 7 | (at your option) any later version. 8 | 9 | This program is distributed in the hope that it will be useful, 10 | but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | GNU General Public License for more details. 13 | 14 | You should have received a copy of the GNU General Public License 15 | along with this program; if not, write to the Free Software 16 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 17 | -} 18 | 19 | {- | 20 | Module : Python.ForeignImports 21 | Copyright : Copyright (C) 2005 John Goerzen 22 | License : GNU GPL, version 2 or above 23 | 24 | Maintainer : John Goerzen, 25 | Maintainer : jgoerzen\@complete.org 26 | Stability : provisional 27 | Portability: portable 28 | 29 | Low-level C interface. Handles foreign imports for everything but 30 | "Python.Exceptions.ExcTypes". 31 | 32 | This is not to be exposed outside this library. 33 | 34 | Written by John Goerzen, jgoerzen\@complete.org 35 | -} 36 | 37 | module Python.ForeignImports where 38 | import Foreign.C.Types 39 | import Foreign 40 | import Python.Types 41 | import Foreign.C.String 42 | import System.IO 43 | 44 | #include "glue.h" 45 | 46 | sf2c :: StartFrom -> CInt 47 | sf2c Py_eval_input = #const Py_eval_input 48 | sf2c Py_file_input = #const Py_file_input 49 | sf2c Py_single_input = #const Py_single_input 50 | 51 | foreign import ccall unsafe "glue.h PyErr_GivenExceptionMatches" 52 | pyErr_GivenExceptionMatches :: Ptr CPyObject -> Ptr CPyObject -> IO CInt 53 | 54 | foreign import ccall unsafe "glue.h Py_Initialize" 55 | cpy_initialize :: IO () 56 | 57 | foreign import ccall unsafe "glue.h PyRun_SimpleString" 58 | cpyRun_SimpleString :: CString -> IO CInt 59 | 60 | foreign import ccall unsafe "glue.h PyRun_String" 61 | cpyRun_String :: CString -> CInt -> Ptr CPyObject -> Ptr CPyObject -> IO (Ptr CPyObject) 62 | 63 | #ifdef PYTHON_PRE_2_5 64 | foreign import ccall unsafe "glue.h PyImport_ImportModuleEx" 65 | cpyImport_ImportModuleEx :: CString -> Ptr CPyObject -> Ptr CPyObject -> Ptr CPyObject -> IO (Ptr CPyObject) 66 | #else 67 | foreign import ccall unsafe "glue.h PyImport_ImportModuleLevel" 68 | cpyImport_ImportModuleLevel :: CString -> Ptr CPyObject -> Ptr CPyObject -> Ptr CPyObject -> CInt -> IO (Ptr CPyObject) 69 | 70 | cpyImport_ImportModuleEx :: CString -> Ptr CPyObject -> Ptr CPyObject -> Ptr CPyObject -> IO (Ptr CPyObject) 71 | cpyImport_ImportModuleEx n g l f = cpyImport_ImportModuleLevel n g l f (fromIntegral (-1)) 72 | #endif 73 | 74 | foreign import ccall unsafe "glue.h PyDict_SetItemString" 75 | pyDict_SetItemString :: Ptr CPyObject -> CString -> Ptr CPyObject -> IO CInt 76 | 77 | foreign import ccall unsafe "glue.h PyImport_GetModuleDict" 78 | pyImport_GetModuleDict :: IO (Ptr CPyObject) 79 | 80 | 81 | foreign import ccall unsafe "glue.h PyString_FromStringAndSize" 82 | pyString_FromStringAndSize :: CString -> CInt -> IO (Ptr CPyObject) 83 | 84 | foreign import ccall unsafe "glue.h PyInt_FromLong" 85 | pyInt_FromLong :: CLong -> IO (Ptr CPyObject) 86 | 87 | foreign import ccall unsafe "glue.h PyInt_AsLong" 88 | pyInt_AsLong :: Ptr CPyObject -> IO CLong 89 | 90 | foreign import ccall unsafe "glue.h PyLong_FromString" 91 | pyLong_FromString :: CString -> Ptr CString -> CInt -> IO (Ptr CPyObject) 92 | 93 | foreign import ccall unsafe "glue.h PyList_New" 94 | pyList_New :: CInt -> IO (Ptr CPyObject) 95 | 96 | foreign import ccall unsafe "glue.h PyList_Append" 97 | pyList_Append :: Ptr CPyObject -> Ptr CPyObject -> IO CInt 98 | 99 | foreign import ccall unsafe "glue.h PyDict_New" 100 | pyDict_New :: IO (Ptr CPyObject) 101 | 102 | foreign import ccall unsafe "glue.h PyObject_SetItem" 103 | pyObject_SetItem :: Ptr CPyObject -> Ptr CPyObject -> Ptr CPyObject -> IO CInt 104 | 105 | foreign import ccall unsafe "glue.h PyObject_DelItem" 106 | pyObject_DelItem :: Ptr CPyObject -> Ptr CPyObject -> IO CInt 107 | 108 | foreign import ccall unsafe "glue.h PyObject_GetItem" 109 | pyObject_GetItem :: Ptr CPyObject -> Ptr CPyObject -> IO (Ptr CPyObject) 110 | 111 | 112 | foreign import ccall unsafe "glue.h PyObject_Repr" 113 | pyObject_Repr :: Ptr CPyObject -> IO (Ptr CPyObject) 114 | 115 | foreign import ccall unsafe "glue.h PyObject_Type" 116 | pyObject_Type :: Ptr CPyObject -> IO (Ptr CPyObject) 117 | 118 | foreign import ccall unsafe "glue.h PyString_AsStringAndSize" 119 | pyString_AsStringAndSize :: Ptr CPyObject -> Ptr CString -> Ptr CInt -> IO () 120 | 121 | foreign import ccall unsafe "glue.h hspy_list_check" 122 | pyList_Check :: Ptr CPyObject -> IO CInt 123 | 124 | foreign import ccall unsafe "glue.h hspy_tuple_check" 125 | pyTuple_Check :: Ptr CPyObject -> IO CInt 126 | 127 | foreign import ccall unsafe "glue.h PyList_Size" 128 | pyList_Size :: Ptr CPyObject -> IO CInt 129 | 130 | foreign import ccall unsafe "glue.h PyTuple_Size" 131 | pyTuple_Size :: Ptr CPyObject -> IO CInt 132 | 133 | foreign import ccall unsafe "glue.h PyList_GetItem" 134 | pyList_GetItem :: Ptr CPyObject -> CInt -> IO (Ptr CPyObject) 135 | 136 | foreign import ccall unsafe "glue.h PyTuple_GetItem" 137 | pyTuple_GetItem :: Ptr CPyObject -> CInt -> IO (Ptr CPyObject) 138 | 139 | foreign import ccall unsafe "glue.h glue_PyMapping_Items" 140 | pyMapping_Items :: Ptr CPyObject -> IO (Ptr CPyObject) 141 | 142 | foreign import ccall unsafe "glue.h PyFloat_FromDouble" 143 | pyFloat_FromDouble :: CDouble -> IO (Ptr CPyObject) 144 | 145 | foreign import ccall unsafe "glue.h PyFloat_AsDouble" 146 | pyFloat_AsDouble :: Ptr CPyObject -> IO CDouble 147 | 148 | foreign import ccall unsafe "glue.h PyObject_Dir" 149 | pyObject_Dir :: Ptr CPyObject -> IO (Ptr CPyObject) 150 | 151 | foreign import ccall "glue.h PyObject_Call" 152 | cpyObject_Call :: Ptr CPyObject -> Ptr CPyObject -> Ptr CPyObject -> 153 | IO (Ptr CPyObject) 154 | 155 | foreign import ccall unsafe "glue.h glue_PyMapping_Keys" 156 | pyMapping_Keys :: Ptr CPyObject -> IO (Ptr CPyObject) 157 | 158 | foreign import ccall unsafe "glue.h PyList_AsTuple" 159 | cpyList_AsTuple :: Ptr CPyObject -> IO (Ptr CPyObject) 160 | 161 | foreign import ccall unsafe "glue.h PyObject_GetAttrString" 162 | pyObject_GetAttrString :: Ptr CPyObject -> CString -> IO (Ptr CPyObject) 163 | 164 | foreign import ccall unsafe "glue.h PyObject_HasAttrString" 165 | pyObject_HasAttrString :: Ptr CPyObject -> CString -> IO CInt 166 | 167 | foreign import ccall unsafe "glue.h PyObject_SetAttrString" 168 | pyObject_SetAttrString :: Ptr CPyObject -> CString -> Ptr CPyObject -> IO CInt 169 | 170 | foreign import ccall unsafe "glue.h PyObject_Str" 171 | pyObject_Str :: Ptr CPyObject -> IO (Ptr CPyObject) 172 | 173 | 174 | foreign import ccall unsafe "glue.h PyModule_GetDict" 175 | cpyModule_GetDict :: Ptr CPyObject -> IO (Ptr CPyObject) 176 | 177 | foreign import ccall "glue.h &hspy_decref" 178 | py_decref :: FunPtr (Ptr CPyObject -> IO ()) 179 | 180 | foreign import ccall "glue.h hspy_incref" 181 | py_incref :: Ptr CPyObject -> IO () 182 | 183 | foreign import ccall unsafe "glue.h hspy_getexc" 184 | hspy_getexc :: IO (Ptr (Ptr CPyObject)) 185 | 186 | foreign import ccall unsafe "glue.h PyErr_Fetch" 187 | pyErr_Fetch :: Ptr (Ptr CPyObject) -> Ptr (Ptr CPyObject) -> Ptr (Ptr CPyObject) -> IO () 188 | 189 | foreign import ccall unsafe "glue.h PyErr_NormalizeException" 190 | pyErr_NormalizeException :: Ptr (Ptr CPyObject) -> Ptr (Ptr CPyObject) -> Ptr (Ptr CPyObject) -> IO () 191 | 192 | foreign import ccall unsafe "glue.h PyErr_Clear" 193 | pyErr_Clear :: IO () 194 | 195 | foreign import ccall unsafe "glue.h PyErr_Print" 196 | pyErr_Print :: IO () 197 | 198 | foreign import ccall unsafe "glue.h PyImport_AddModule" 199 | cpyImport_AddModule :: CString -> IO (Ptr CPyObject) 200 | 201 | foreign import ccall unsafe "glue.h hspy_none" 202 | cNone :: IO (Ptr CPyObject) 203 | 204 | 205 | foreign import ccall unsafe "glue.h PyEval_InitThreads" 206 | cpy_InitThreads :: IO () 207 | 208 | #ifndef PYTHON_PRE_2_3 209 | foreign import ccall unsafe "glue.h PyGILState_Ensure" 210 | cpy_GILEnsure :: IO (Ptr CPyGILState) 211 | 212 | foreign import ccall unsafe "glue.h PyGILState_Release" 213 | cpy_GILRelease :: Ptr CPyGILState -> IO () 214 | #endif 215 | 216 | -------------------------------------------------------------------------------- /Python/Objects/File.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverlappingInstances#-} 2 | 3 | {- arch-tag: Python file-like objects 4 | Copyright (C) 2005 John Goerzen 5 | 6 | This program is free software; you can redistribute it and/or modify 7 | it under the terms of the GNU General Public License as published by 8 | the Free Software Foundation; either version 2 of the License, or 9 | (at your option) any later version. 10 | 11 | This program is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU General Public License for more details. 15 | 16 | You should have received a copy of the GNU General Public License 17 | along with this program; if not, write to the Free Software 18 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 19 | -} 20 | 21 | {- | 22 | Module : Python.Objects.File 23 | Copyright : Copyright (C) 2005 John Goerzen 24 | License : GNU GPL, version 2 or above 25 | 26 | Maintainer : John Goerzen, 27 | Maintainer : jgoerzen\@complete.org 28 | Stability : provisional 29 | Portability: portable 30 | 31 | Python file-like objects 32 | 33 | Written by John Goerzen, jgoerzen\@complete.org 34 | 35 | This module provides a Haskell interface to work with Python file-like objects. 36 | The Haskell interface is a "System.IO.HVIO" interface, which is similar 37 | in concept to the Python file-like object system. 38 | 39 | You can create such objects by using 'openPyFile' from this module, or 40 | 'MissingPy.FileArchive.GZip.openGz' or 'MissingPy.FileArchive.BZip2.openBz2'. 41 | 42 | Functions that you can use to operate on these objects are defined at 43 | "System.IO.HVIO". 44 | -} 45 | 46 | module Python.Objects.File (-- * PyFile Objects 47 | PyFile, 48 | mkPyFile, 49 | fromPyFile, 50 | openPyFile, 51 | pyfwrap, 52 | openModeConv 53 | ) 54 | where 55 | import Python.Objects ( PyObject(..) 56 | , callMethodHs 57 | , fromPyObject 58 | , getattr 59 | , hasattr 60 | , noKwParms 61 | , noParms 62 | , runMethodHs 63 | , showPyObject 64 | , toPyObject 65 | ) 66 | import Python.Interpreter (callByName) 67 | import System.IO (IOMode(..), SeekMode(..)) 68 | import System.IO.Error (eofErrorType) 69 | import System.IO.Unsafe (unsafeInterleaveIO) 70 | import Python.Exceptions (catchPy, exc2ioerror) 71 | import System.IO.HVIO (HVIO(..)) 72 | import Foreign.C.Types (CInt, CLong) 73 | 74 | {- | The basic type for a Python file or file-like object. 75 | 76 | 'PyFile's are a member of System.IO.HVIO and can be used as any other 77 | Haskell HVFS object such as a Handle. 78 | 79 | 'PyFile' objects cannot reliably detect EOF when asked by 'vIsEOF', but 80 | can detect it and raise the appropriate IOError when it is reached. 81 | Also, 'PyFile' objects cannot determine if they are readable, writable, 82 | or seekable in advance. 83 | -} 84 | newtype PyFile = PyFile PyObject 85 | 86 | {- | Takes a 'PyObject' representing a Python file or file-like object 87 | and makes it into a 'PyFile'. -} 88 | mkPyFile :: PyObject -> PyFile 89 | mkPyFile o = PyFile o 90 | 91 | {- | Extracts the 'PyObject' representing this 'PyFile'. -} 92 | fromPyFile :: PyFile -> PyObject 93 | fromPyFile (PyFile o) = o 94 | 95 | {- | Convert a Haskell open mode to a Python mode string -} 96 | openModeConv ReadMode = "r" 97 | openModeConv WriteMode = "w" 98 | openModeConv AppendMode = "a" 99 | openModeConv ReadWriteMode = "w+" 100 | 101 | {- | Open a file on disk and return a 'PyFile'. -} 102 | openPyFile :: FilePath -> IOMode -> IO PyFile 103 | openPyFile fp mode = 104 | do parms1 <- toPyObject [fp] 105 | parms2 <- toPyObject [openModeConv mode] 106 | obj <- callByName "open" [parms1, parms2] [] 107 | return $ mkPyFile obj 108 | 109 | ------------------------------------------------------------ 110 | -- HVIO 111 | ------------------------------------------------------------ 112 | 113 | instance Show PyFile where 114 | show _ = "" 115 | 116 | {- | Wrap an operation, raising exceptions in the IO monad as appropriate. -} 117 | pyfwrap :: PyFile -> (PyObject -> IO a) -> IO a 118 | pyfwrap (PyFile pyobj) func = catchPy (func pyobj) exc2ioerror 119 | 120 | raiseEOF :: PyFile -> IO a 121 | raiseEOF h = vThrow h eofErrorType 122 | 123 | instance HVIO PyFile where 124 | vClose pyf = pyfwrap pyf (\pyo -> runMethodHs pyo "close" noParms noKwParms) 125 | 126 | vIsClosed pyf = pyfwrap pyf (\pyo -> 127 | do h <- hasattr pyo "closed" 128 | if h then 129 | do v <- (getattr pyo "closed" >>= fromPyObject)::IO CInt 130 | if v == 0 131 | then return False 132 | else return True 133 | else return False -- Don't know; fake it. 134 | ) 135 | 136 | vGetContents pyf = do vTestOpen pyf 137 | vTestEOF pyf 138 | pyfwrap pyf (\pyo -> 139 | let loop = unsafeInterleaveIO $ 140 | do block <- callMethodHs pyo "read" 141 | [4096::CLong] noKwParms 142 | case block of 143 | [] -> do vClose pyf 144 | return [] 145 | x -> do next <- loop 146 | return $ x : next 147 | in do c <- loop 148 | return $ concat c 149 | ) 150 | 151 | 152 | -- Have to fake it. We have no EOF indication. 153 | vIsEOF pyf = return False 154 | 155 | vShow pyf = pyfwrap pyf showPyObject 156 | 157 | vGetChar pyf = do vTestOpen pyf 158 | pyfwrap pyf (\pyo -> 159 | do c <- callMethodHs pyo "read" [1::CInt] noKwParms 160 | case c of 161 | [] -> raiseEOF pyf 162 | [x] -> return x 163 | ) 164 | 165 | vGetLine pyf = do vTestOpen pyf 166 | pyfwrap pyf (\pyo -> 167 | do line <- callMethodHs pyo "readline" noParms noKwParms 168 | case reverse line of 169 | [] -> raiseEOF pyf 170 | '\n':xs -> return $ reverse xs 171 | x -> return line 172 | ) 173 | 174 | vPutChar pyf c = vPutStr pyf [c] 175 | 176 | {- Python strings are non-lazy, so process these in chunks. -} 177 | vPutStr pyf [] = vTestOpen pyf >> return () 178 | vPutStr pyf s = let (this, next) = (splitAt 4096 s)::(String, String) 179 | in do vTestOpen pyf 180 | pyfwrap pyf (\pyo -> 181 | runMethodHs pyo "write" [this] noKwParms) 182 | vPutStr pyf next 183 | 184 | vFlush pyf = pyfwrap pyf (\pyo -> 185 | do vTestOpen pyf 186 | h <- hasattr pyo "flush" 187 | if h then runMethodHs pyo "flush" noParms noKwParms 188 | else return () 189 | ) 190 | 191 | {- Some file-like objects don't take an offset. Sigh. -} 192 | vSeek pyf sm offset = 193 | let seekint = case sm of 194 | AbsoluteSeek -> 0::CLong 195 | RelativeSeek -> 1 196 | SeekFromEnd -> 2 197 | in do vTestOpen pyf 198 | pyfwrap pyf (\pyo -> 199 | case sm of 200 | AbsoluteSeek -> runMethodHs pyo "seek" 201 | [(fromIntegral offset)::CLong] 202 | noKwParms 203 | _ -> runMethodHs pyo "seek" [(fromIntegral offset), 204 | seekint] noKwParms 205 | ) 206 | 207 | vTell pyf = pyfwrap pyf (\pyo -> 208 | vTestOpen pyf >> callMethodHs pyo "tell" noParms noKwParms) 209 | 210 | vIsSeekable _ = return True -- fake it 211 | vIsWritable _ = return True -- fake it 212 | vIsReadable _ = return True -- fake it 213 | 214 | -------------------------------------------------------------------------------- /Python/Exceptions/ExcTypes.hsc: -------------------------------------------------------------------------------- 1 | {- NOTICE -- THIS FILE IS AUTO-GENERATED -- DO NOT EDIT 2 | MissingPy: Haskell Python Interface libraries 3 | Copyright (C) 2004 - 2005 John Goerzen 4 | 5 | All code is under the following license unless otherwise noted: 6 | This program is free software; you can redistribute it and/or modify 7 | it under the terms of the GNU General Public License as published by 8 | the Free Software Foundation; either version 2 of the License, or 9 | (at your option) any later version. 10 | 11 | This program is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU General Public License for more details. 15 | 16 | You should have received a copy of the GNU General Public License 17 | along with this program; if not, write to the Free Software 18 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 19 | 20 | The GNU General Public License is available in the file COPYING in the source 21 | distribution. Debian GNU/Linux users may find this in 22 | /usr/share/common-licenses/GPL-2. 23 | 24 | If the GPL is unacceptable for your uses, please e-mail me; alternative 25 | terms can be negotiated for your project. 26 | -} 27 | {- | 28 | Module : Python.Exceptions.ExcTypes 29 | Copyright : Copyright (C) 2005 John Goerzen 30 | License : GNU GPL, version 2 or above 31 | 32 | Maintainer : John Goerzen, 33 | Maintainer : jgoerzen\@complete.org 34 | Stability : provisional 35 | Portability: portable 36 | 37 | Python low-level exception definitions 38 | 39 | These are definitions of the built-in Python exception objects. You can 40 | use them with 'MissingPy.Python.Exceptions.doesExceptionMatch' and 41 | 'MissingPy.Python.Exceptions.catchSpecificPy'. 42 | 43 | The meanings of these exceptions can be found at 44 | . 45 | 46 | Please note that windowsError is available only on Microsoft platforms. 47 | 48 | Written by John Goerzen, jgoerzen\@complete.org 49 | -} 50 | #include 51 | module Python.Exceptions.ExcTypes 52 | ( 53 | 54 | arithmeticError, 55 | assertionError, 56 | attributeError, 57 | pyEOFError, 58 | environmentError, 59 | pyMainException, 60 | floatingPointError, 61 | pyIOError, 62 | importError, 63 | indexError, 64 | keyError, 65 | keyboardInterrupt, 66 | lookupError, 67 | memoryError, 68 | nameError, 69 | notImplementedError, 70 | pyOSError, 71 | overflowError, 72 | referenceError, 73 | runtimeError, 74 | standardError, 75 | syntaxError, 76 | systemError, 77 | systemExit, 78 | typeError, 79 | valueError, 80 | zeroDivisionError 81 | #ifdef MS_WINDOWS 82 | ,windowsError 83 | #endif 84 | 85 | ) 86 | where 87 | import Python.Types 88 | import Python.Objects 89 | import System.IO.Unsafe 90 | import Python.Utils 91 | import Foreign hiding (unsafePerformIO) 92 | exctypes_internal_e :: IO (Ptr CPyObject) -> IO PyObject 93 | exctypes_internal_e f = do p <- f 94 | fp <- newForeignPtr_ p 95 | return $ PyObject fp 96 | 97 | {-# NOINLINE arithmeticError #-} 98 | arithmeticError = unsafePerformIO $ exctypes_internal_e cArithmeticError 99 | 100 | {-# NOINLINE assertionError #-} 101 | assertionError = unsafePerformIO $ exctypes_internal_e cAssertionError 102 | 103 | {-# NOINLINE attributeError #-} 104 | attributeError = unsafePerformIO $ exctypes_internal_e cAttributeError 105 | 106 | {-# NOINLINE pyEOFError #-} 107 | pyEOFError = unsafePerformIO $ exctypes_internal_e cEOFError 108 | 109 | {-# NOINLINE environmentError #-} 110 | environmentError = unsafePerformIO $ exctypes_internal_e cEnvironmentError 111 | 112 | -- | This is Exception in Python; renamed to avoid naming conflicts here. 113 | {-# NOINLINE pyMainException #-} 114 | pyMainException = unsafePerformIO $ exctypes_internal_e cException 115 | 116 | {-# NOINLINE floatingPointError #-} 117 | floatingPointError = unsafePerformIO $ exctypes_internal_e cFloatingPointError 118 | 119 | {-# NOINLINE pyIOError #-} 120 | pyIOError = unsafePerformIO $ exctypes_internal_e cIOError 121 | 122 | {-# NOINLINE importError #-} 123 | importError = unsafePerformIO $ exctypes_internal_e cImportError 124 | 125 | {-# NOINLINE indexError #-} 126 | indexError = unsafePerformIO $ exctypes_internal_e cIndexError 127 | 128 | {-# NOINLINE keyError #-} 129 | keyError = unsafePerformIO $ exctypes_internal_e cKeyError 130 | 131 | {-# NOINLINE keyboardInterrupt #-} 132 | keyboardInterrupt = unsafePerformIO $ exctypes_internal_e cKeyboardInterrupt 133 | 134 | {-# NOINLINE lookupError #-} 135 | lookupError = unsafePerformIO $ exctypes_internal_e cLookupError 136 | 137 | {-# NOINLINE memoryError #-} 138 | memoryError = unsafePerformIO $ exctypes_internal_e cMemoryError 139 | 140 | {-# NOINLINE nameError #-} 141 | nameError = unsafePerformIO $ exctypes_internal_e cNameError 142 | 143 | {-# NOINLINE notImplementedError #-} 144 | notImplementedError = unsafePerformIO $ exctypes_internal_e cNotImplementedError 145 | 146 | {-# NOINLINE pyOSError #-} 147 | pyOSError = unsafePerformIO $ exctypes_internal_e cOSError 148 | 149 | {-# NOINLINE overflowError #-} 150 | overflowError = unsafePerformIO $ exctypes_internal_e cOverflowError 151 | 152 | {-# NOINLINE referenceError #-} 153 | referenceError = unsafePerformIO $ exctypes_internal_e cReferenceError 154 | 155 | {-# NOINLINE runtimeError #-} 156 | runtimeError = unsafePerformIO $ exctypes_internal_e cRuntimeError 157 | 158 | {-# NOINLINE standardError #-} 159 | standardError = unsafePerformIO $ exctypes_internal_e cStandardError 160 | 161 | {-# NOINLINE syntaxError #-} 162 | syntaxError = unsafePerformIO $ exctypes_internal_e cSyntaxError 163 | 164 | {-# NOINLINE systemError #-} 165 | systemError = unsafePerformIO $ exctypes_internal_e cSystemError 166 | 167 | {-# NOINLINE systemExit #-} 168 | systemExit = unsafePerformIO $ exctypes_internal_e cSystemExit 169 | 170 | {-# NOINLINE typeError #-} 171 | typeError = unsafePerformIO $ exctypes_internal_e cTypeError 172 | 173 | {-# NOINLINE valueError #-} 174 | valueError = unsafePerformIO $ exctypes_internal_e cValueError 175 | 176 | {-# NOINLINE zeroDivisionError #-} 177 | zeroDivisionError = unsafePerformIO $ exctypes_internal_e cZeroDivisionError 178 | 179 | 180 | #ifdef MS_WINDOWS 181 | {-# NOINLINE windowsError #-} 182 | windowsError = unsafePerformIO $ exctypes_internal_e cWindowsError 183 | 184 | #endif 185 | 186 | foreign import ccall unsafe "excglue.h hspy_ArithmeticError" 187 | cArithmeticError :: IO (Ptr CPyObject) 188 | 189 | foreign import ccall unsafe "excglue.h hspy_AssertionError" 190 | cAssertionError :: IO (Ptr CPyObject) 191 | 192 | foreign import ccall unsafe "excglue.h hspy_AttributeError" 193 | cAttributeError :: IO (Ptr CPyObject) 194 | 195 | foreign import ccall unsafe "excglue.h hspy_EOFError" 196 | cEOFError :: IO (Ptr CPyObject) 197 | 198 | foreign import ccall unsafe "excglue.h hspy_EnvironmentError" 199 | cEnvironmentError :: IO (Ptr CPyObject) 200 | 201 | foreign import ccall unsafe "excglue.h hspy_Exception" 202 | cException :: IO (Ptr CPyObject) 203 | 204 | foreign import ccall unsafe "excglue.h hspy_FloatingPointError" 205 | cFloatingPointError :: IO (Ptr CPyObject) 206 | 207 | foreign import ccall unsafe "excglue.h hspy_IOError" 208 | cIOError :: IO (Ptr CPyObject) 209 | 210 | foreign import ccall unsafe "excglue.h hspy_ImportError" 211 | cImportError :: IO (Ptr CPyObject) 212 | 213 | foreign import ccall unsafe "excglue.h hspy_IndexError" 214 | cIndexError :: IO (Ptr CPyObject) 215 | 216 | foreign import ccall unsafe "excglue.h hspy_KeyError" 217 | cKeyError :: IO (Ptr CPyObject) 218 | 219 | foreign import ccall unsafe "excglue.h hspy_KeyboardInterrupt" 220 | cKeyboardInterrupt :: IO (Ptr CPyObject) 221 | 222 | foreign import ccall unsafe "excglue.h hspy_LookupError" 223 | cLookupError :: IO (Ptr CPyObject) 224 | 225 | foreign import ccall unsafe "excglue.h hspy_MemoryError" 226 | cMemoryError :: IO (Ptr CPyObject) 227 | 228 | foreign import ccall unsafe "excglue.h hspy_NameError" 229 | cNameError :: IO (Ptr CPyObject) 230 | 231 | foreign import ccall unsafe "excglue.h hspy_NotImplementedError" 232 | cNotImplementedError :: IO (Ptr CPyObject) 233 | 234 | foreign import ccall unsafe "excglue.h hspy_OSError" 235 | cOSError :: IO (Ptr CPyObject) 236 | 237 | foreign import ccall unsafe "excglue.h hspy_OverflowError" 238 | cOverflowError :: IO (Ptr CPyObject) 239 | 240 | foreign import ccall unsafe "excglue.h hspy_ReferenceError" 241 | cReferenceError :: IO (Ptr CPyObject) 242 | 243 | foreign import ccall unsafe "excglue.h hspy_RuntimeError" 244 | cRuntimeError :: IO (Ptr CPyObject) 245 | 246 | foreign import ccall unsafe "excglue.h hspy_StandardError" 247 | cStandardError :: IO (Ptr CPyObject) 248 | 249 | foreign import ccall unsafe "excglue.h hspy_SyntaxError" 250 | cSyntaxError :: IO (Ptr CPyObject) 251 | 252 | foreign import ccall unsafe "excglue.h hspy_SystemError" 253 | cSystemError :: IO (Ptr CPyObject) 254 | 255 | foreign import ccall unsafe "excglue.h hspy_SystemExit" 256 | cSystemExit :: IO (Ptr CPyObject) 257 | 258 | foreign import ccall unsafe "excglue.h hspy_TypeError" 259 | cTypeError :: IO (Ptr CPyObject) 260 | 261 | foreign import ccall unsafe "excglue.h hspy_ValueError" 262 | cValueError :: IO (Ptr CPyObject) 263 | 264 | foreign import ccall unsafe "excglue.h hspy_ZeroDivisionError" 265 | cZeroDivisionError :: IO (Ptr CPyObject) 266 | 267 | 268 | #ifdef MS_WINDOWS 269 | foreign import ccall unsafe "excglue.h hspy_WindowsError" 270 | cWindowsError :: IO (Ptr CPyObject) 271 | 272 | #endif 273 | 274 | -------------------------------------------------------------------------------- /Python/Interpreter.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP, OverlappingInstances #-} 2 | 3 | {- arch-tag: Python interpreter module 4 | Copyright (C) 2005 John Goerzen 5 | 6 | This program is free software; you can redistribute it and/or modify 7 | it under the terms of the GNU General Public License as published by 8 | the Free Software Foundation; either version 2 of the License, or 9 | (at your option) any later version. 10 | 11 | This program is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU General Public License for more details. 15 | 16 | You should have received a copy of the GNU General Public License 17 | along with this program; if not, write to the Free Software 18 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 19 | -} 20 | 21 | {- | 22 | Module : Python.Interpreter 23 | Copyright : Copyright (C) 2005 John Goerzen 24 | License : GNU GPL, version 2 or above 25 | 26 | Maintainer : John Goerzen, 27 | Maintainer : jgoerzen\@complete.org 28 | Stability : provisional 29 | Portability: portable 30 | 31 | Interface to Python interpreter 32 | 33 | Written by John Goerzen, jgoerzen\@complete.org 34 | -} 35 | 36 | module Python.Interpreter ( 37 | py_initialize, 38 | -- * Intrepreting Code 39 | pyRun_SimpleString, 40 | pyRun_String, 41 | pyRun_StringHs, 42 | StartFrom(..), 43 | -- * Calling Code 44 | callByName, 45 | callByNameHs, 46 | noParms, 47 | noKwParms, 48 | -- * Imports 49 | pyImport, 50 | pyImport_ImportModule, 51 | pyImport_AddModule, 52 | pyModule_GetDict, 53 | -- * Threads 54 | py_initializeThreaded, 55 | #ifndef PYTHON_PRE_2_3 56 | cpy_GILEnsure, 57 | cpy_GILRelease, 58 | withGIL, 59 | #endif 60 | ) 61 | where 62 | 63 | import Python.Utils ( 64 | checkCInt 65 | , getDefaultGlobals 66 | , withPyObject 67 | , fromCPyObject 68 | , py_incref 69 | , pyModule_GetDict 70 | , pyImport_AddModule 71 | ) 72 | 73 | import Python.Objects ( 74 | toPyObject 75 | , noParms 76 | , noKwParms 77 | , fromPyObject 78 | , pyObject_Call 79 | , pyObject_CallHs 80 | , PyObject 81 | , ToPyObject 82 | , FromPyObject 83 | ) 84 | 85 | import Python.Types (StartFrom(..)) 86 | 87 | import Python.ForeignImports ( 88 | cpy_initialize 89 | , cpy_InitThreads 90 | , cpyRun_String 91 | , cpyRun_SimpleString 92 | , cpyImport_ImportModuleEx 93 | , sf2c 94 | , pyImport_GetModuleDict 95 | , pyDict_SetItemString 96 | #ifndef PYTHON_PRE_2_3 97 | , cpy_GILEnsure 98 | , cpy_GILRelease 99 | #endif 100 | ) 101 | 102 | import Foreign.C (withCString) 103 | import Control.Exception (handle, finally, throwTo, SomeException) 104 | import Control.Concurrent (rtsSupportsBoundThreads, forkOS, myThreadId) 105 | import Control.Concurrent.MVar 106 | import System.IO.Unsafe 107 | 108 | {- | Initialize the Python interpreter environment. 109 | 110 | MUST BE DONE BEFORE DOING ANYTHING ELSE! -} 111 | py_initialize = 112 | if rtsSupportsBoundThreads 113 | then py_initializeThreaded 114 | else py_initialize' 115 | 116 | py_initialize' :: IO () 117 | py_initialize' = do cpy_initialize 118 | pyImport "traceback" 119 | 120 | {- Python use Thread Local Storage, so all calls must be made through a 121 | - single OS thread. 122 | -} 123 | 124 | py_initializeThreaded :: IO () 125 | py_initializeThreaded = do 126 | forkOS $ do 127 | cpy_InitThreads 128 | py_initialize' 129 | pyPoll 130 | return () 131 | 132 | pyQ :: MVar (IO ()) 133 | pyQ = unsafePerformIO newEmptyMVar 134 | 135 | {- Poll pyQ for python actions, and execute them -} 136 | pyPoll = do 137 | a <- takeMVar pyQ 138 | withGIL' a >> pyPoll 139 | 140 | {- Pass python actions to dedicated python thread for execution. -} 141 | withGIL :: IO a -> IO a 142 | withGIL = 143 | if rtsSupportsBoundThreads 144 | then withGILThreaded 145 | else withGIL' 146 | 147 | withGILThreaded :: IO a -> IO a 148 | withGILThreaded act = do 149 | tid <- myThreadId 150 | r <- newEmptyMVar 151 | putMVar pyQ $ handle (\e -> throwTo tid (e::SomeException)) $ putMVar r =<< act 152 | takeMVar r 153 | 154 | withGIL' :: IO a -> IO a 155 | #ifdef PYTHON_PRE_2_3 156 | withGIL' a = a 157 | #else 158 | withGIL' act = do st <- cpy_GILEnsure 159 | finally act 160 | (cpy_GILRelease st) 161 | #endif 162 | 163 | pyRun_SimpleString :: String -> IO () 164 | pyRun_SimpleString x = withCString x (\cs -> 165 | do cpyRun_SimpleString cs >>= checkCInt 166 | return () 167 | ) 168 | 169 | -- | Like 'pyRun_String', but take more Haskellish args and results. 170 | pyRun_StringHs :: (ToPyObject b, FromPyObject c) => 171 | String -- ^ Command to run 172 | -> StartFrom -- ^ Start token 173 | -- -> [(String, a)] -- ^ Globals (may be empty) 174 | -> [(String, b)] -- ^ Locals (may be empty) 175 | -> IO c 176 | pyRun_StringHs cmd start locals = 177 | let conv (k, v) = do v1 <- toPyObject v 178 | return (k, v1) 179 | in do 180 | --rglobals <- mapM conv globals 181 | rlocals <- mapM conv locals 182 | pyRun_String cmd start rlocals >>= fromPyObject 183 | 184 | -- | Run some code in Python. 185 | pyRun_String :: String -- ^ Command to run 186 | -> StartFrom -- ^ Start Token 187 | -- -> [(String, PyObject)] -- ^ Globals (may be empty) 188 | -> [(String, PyObject)] -- ^ Locals (may be empty) 189 | -> IO PyObject -- ^ Result 190 | pyRun_String command startfrom xlocals = 191 | let cstart = sf2c startfrom 192 | in do dobj <- getDefaultGlobals 193 | rlocals <- toPyObject xlocals 194 | withCString command (\ccommand -> 195 | withPyObject dobj (\cglobals -> 196 | withPyObject rlocals (\clocals -> 197 | cpyRun_String ccommand cstart cglobals clocals >>= fromCPyObject 198 | ))) 199 | 200 | {- | Call a function or callable object by name. -} 201 | callByName :: String -- ^ Object\/function name 202 | -> [PyObject] -- ^ List of non-keyword parameters 203 | -> [(String, PyObject)] -- ^ List of keyword parameters 204 | -> IO PyObject 205 | callByName fname sparms kwparms = 206 | do func <- pyRun_String fname Py_eval_input [] 207 | pyObject_Call func sparms kwparms 208 | 209 | {- | Call a function or callable object by namem using Haskell args 210 | and return values.. 211 | 212 | You can use 'noParms' and 'noKwParms' if you have no simple or 213 | keyword parameters to pass, respectively. -} 214 | callByNameHs :: (ToPyObject a, ToPyObject b, FromPyObject c) => 215 | String -- ^ Object\/function name 216 | -> [a] -- ^ List of non-keyword parameters 217 | -> [(String, b)] -- ^ List of keyword parameters 218 | -> IO c 219 | callByNameHs fname sparms kwparms = 220 | do func <- pyRun_String fname Py_eval_input [] 221 | pyObject_CallHs func sparms kwparms 222 | 223 | 224 | {- | Import a module into the current environment in the normal sense 225 | (similar to \"import\" in Python). 226 | -} 227 | pyImport :: String -> IO () 228 | pyImport x = 229 | do pyImport_ImportModule x 230 | globals <- getDefaultGlobals 231 | cdict <- pyImport_GetModuleDict 232 | py_incref cdict 233 | pyo2 <- fromCPyObject cdict 234 | dict <- fromPyObject pyo2 235 | case lookup x dict of 236 | Nothing -> return () 237 | Just pyo -> do withPyObject globals (\cglobals -> 238 | withPyObject pyo (\cmodule -> 239 | withCString x (\cstr -> 240 | pyDict_SetItemString cglobals cstr cmodule >>= checkCInt))) 241 | return () 242 | 243 | {- | Wrapper around C PyImport_ImportModule, which imports a module. 244 | 245 | You may want the higher-level 'pyImport' instead. -} 246 | pyImport_ImportModule :: String -> IO PyObject 247 | pyImport_ImportModule x = 248 | do globals <- getDefaultGlobals 249 | fromlist <- toPyObject ['*'] 250 | cr <- withPyObject globals (\cglobals -> 251 | withPyObject fromlist (\cfromlist -> 252 | withCString x (\cstr -> 253 | cpyImport_ImportModuleEx cstr cglobals cglobals cfromlist))) 254 | fromCPyObject cr 255 | 256 | -------------------------------------------------------------------------------- /COPYING: -------------------------------------------------------------------------------- 1 | GNU GENERAL PUBLIC LICENSE 2 | Version 2, June 1991 3 | 4 | Copyright (C) 1989, 1991 Free Software Foundation, Inc. 5 | 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 6 | Everyone is permitted to copy and distribute verbatim copies 7 | of this license document, but changing it is not allowed. 8 | 9 | Preamble 10 | 11 | The licenses for most software are designed to take away your 12 | freedom to share and change it. By contrast, the GNU General Public 13 | License is intended to guarantee your freedom to share and change free 14 | software--to make sure the software is free for all its users. This 15 | General Public License applies to most of the Free Software 16 | Foundation's software and to any other program whose authors commit to 17 | using it. (Some other Free Software Foundation software is covered by 18 | the GNU Library General Public License instead.) You can apply it to 19 | your programs, too. 20 | 21 | When we speak of free software, we are referring to freedom, not 22 | price. Our General Public Licenses are designed to make sure that you 23 | have the freedom to distribute copies of free software (and charge for 24 | this service if you wish), that you receive source code or can get it 25 | if you want it, that you can change the software or use pieces of it 26 | in new free programs; and that you know you can do these things. 27 | 28 | To protect your rights, we need to make restrictions that forbid 29 | anyone to deny you these rights or to ask you to surrender the rights. 30 | These restrictions translate to certain responsibilities for you if you 31 | distribute copies of the software, or if you modify it. 32 | 33 | For example, if you distribute copies of such a program, whether 34 | gratis or for a fee, you must give the recipients all the rights that 35 | you have. You must make sure that they, too, receive or can get the 36 | source code. And you must show them these terms so they know their 37 | rights. 38 | 39 | We protect your rights with two steps: (1) copyright the software, and 40 | (2) offer you this license which gives you legal permission to copy, 41 | distribute and/or modify the software. 42 | 43 | Also, for each author's protection and ours, we want to make certain 44 | that everyone understands that there is no warranty for this free 45 | software. If the software is modified by someone else and passed on, we 46 | want its recipients to know that what they have is not the original, so 47 | that any problems introduced by others will not reflect on the original 48 | authors' reputations. 49 | 50 | Finally, any free program is threatened constantly by software 51 | patents. We wish to avoid the danger that redistributors of a free 52 | program will individually obtain patent licenses, in effect making the 53 | program proprietary. To prevent this, we have made it clear that any 54 | patent must be licensed for everyone's free use or not licensed at all. 55 | 56 | The precise terms and conditions for copying, distribution and 57 | modification follow. 58 | 59 | GNU GENERAL PUBLIC LICENSE 60 | TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 61 | 62 | 0. This License applies to any program or other work which contains 63 | a notice placed by the copyright holder saying it may be distributed 64 | under the terms of this General Public License. The "Program", below, 65 | refers to any such program or work, and a "work based on the Program" 66 | means either the Program or any derivative work under copyright law: 67 | that is to say, a work containing the Program or a portion of it, 68 | either verbatim or with modifications and/or translated into another 69 | language. (Hereinafter, translation is included without limitation in 70 | the term "modification".) Each licensee is addressed as "you". 71 | 72 | Activities other than copying, distribution and modification are not 73 | covered by this License; they are outside its scope. The act of 74 | running the Program is not restricted, and the output from the Program 75 | is covered only if its contents constitute a work based on the 76 | Program (independent of having been made by running the Program). 77 | Whether that is true depends on what the Program does. 78 | 79 | 1. You may copy and distribute verbatim copies of the Program's 80 | source code as you receive it, in any medium, provided that you 81 | conspicuously and appropriately publish on each copy an appropriate 82 | copyright notice and disclaimer of warranty; keep intact all the 83 | notices that refer to this License and to the absence of any warranty; 84 | and give any other recipients of the Program a copy of this License 85 | along with the Program. 86 | 87 | You may charge a fee for the physical act of transferring a copy, and 88 | you may at your option offer warranty protection in exchange for a fee. 89 | 90 | 2. You may modify your copy or copies of the Program or any portion 91 | of it, thus forming a work based on the Program, and copy and 92 | distribute such modifications or work under the terms of Section 1 93 | above, provided that you also meet all of these conditions: 94 | 95 | a) You must cause the modified files to carry prominent notices 96 | stating that you changed the files and the date of any change. 97 | 98 | b) You must cause any work that you distribute or publish, that in 99 | whole or in part contains or is derived from the Program or any 100 | part thereof, to be licensed as a whole at no charge to all third 101 | parties under the terms of this License. 102 | 103 | c) If the modified program normally reads commands interactively 104 | when run, you must cause it, when started running for such 105 | interactive use in the most ordinary way, to print or display an 106 | announcement including an appropriate copyright notice and a 107 | notice that there is no warranty (or else, saying that you provide 108 | a warranty) and that users may redistribute the program under 109 | these conditions, and telling the user how to view a copy of this 110 | License. (Exception: if the Program itself is interactive but 111 | does not normally print such an announcement, your work based on 112 | the Program is not required to print an announcement.) 113 | 114 | These requirements apply to the modified work as a whole. If 115 | identifiable sections of that work are not derived from the Program, 116 | and can be reasonably considered independent and separate works in 117 | themselves, then this License, and its terms, do not apply to those 118 | sections when you distribute them as separate works. But when you 119 | distribute the same sections as part of a whole which is a work based 120 | on the Program, the distribution of the whole must be on the terms of 121 | this License, whose permissions for other licensees extend to the 122 | entire whole, and thus to each and every part regardless of who wrote it. 123 | 124 | Thus, it is not the intent of this section to claim rights or contest 125 | your rights to work written entirely by you; rather, the intent is to 126 | exercise the right to control the distribution of derivative or 127 | collective works based on the Program. 128 | 129 | In addition, mere aggregation of another work not based on the Program 130 | with the Program (or with a work based on the Program) on a volume of 131 | a storage or distribution medium does not bring the other work under 132 | the scope of this License. 133 | 134 | 3. You may copy and distribute the Program (or a work based on it, 135 | under Section 2) in object code or executable form under the terms of 136 | Sections 1 and 2 above provided that you also do one of the following: 137 | 138 | a) Accompany it with the complete corresponding machine-readable 139 | source code, which must be distributed under the terms of Sections 140 | 1 and 2 above on a medium customarily used for software interchange; or, 141 | 142 | b) Accompany it with a written offer, valid for at least three 143 | years, to give any third party, for a charge no more than your 144 | cost of physically performing source distribution, a complete 145 | machine-readable copy of the corresponding source code, to be 146 | distributed under the terms of Sections 1 and 2 above on a medium 147 | customarily used for software interchange; or, 148 | 149 | c) Accompany it with the information you received as to the offer 150 | to distribute corresponding source code. (This alternative is 151 | allowed only for noncommercial distribution and only if you 152 | received the program in object code or executable form with such 153 | an offer, in accord with Subsection b above.) 154 | 155 | The source code for a work means the preferred form of the work for 156 | making modifications to it. For an executable work, complete source 157 | code means all the source code for all modules it contains, plus any 158 | associated interface definition files, plus the scripts used to 159 | control compilation and installation of the executable. However, as a 160 | special exception, the source code distributed need not include 161 | anything that is normally distributed (in either source or binary 162 | form) with the major components (compiler, kernel, and so on) of the 163 | operating system on which the executable runs, unless that component 164 | itself accompanies the executable. 165 | 166 | If distribution of executable or object code is made by offering 167 | access to copy from a designated place, then offering equivalent 168 | access to copy the source code from the same place counts as 169 | distribution of the source code, even though third parties are not 170 | compelled to copy the source along with the object code. 171 | 172 | 4. You may not copy, modify, sublicense, or distribute the Program 173 | except as expressly provided under this License. Any attempt 174 | otherwise to copy, modify, sublicense or distribute the Program is 175 | void, and will automatically terminate your rights under this License. 176 | However, parties who have received copies, or rights, from you under 177 | this License will not have their licenses terminated so long as such 178 | parties remain in full compliance. 179 | 180 | 5. You are not required to accept this License, since you have not 181 | signed it. However, nothing else grants you permission to modify or 182 | distribute the Program or its derivative works. These actions are 183 | prohibited by law if you do not accept this License. Therefore, by 184 | modifying or distributing the Program (or any work based on the 185 | Program), you indicate your acceptance of this License to do so, and 186 | all its terms and conditions for copying, distributing or modifying 187 | the Program or works based on it. 188 | 189 | 6. Each time you redistribute the Program (or any work based on the 190 | Program), the recipient automatically receives a license from the 191 | original licensor to copy, distribute or modify the Program subject to 192 | these terms and conditions. You may not impose any further 193 | restrictions on the recipients' exercise of the rights granted herein. 194 | You are not responsible for enforcing compliance by third parties to 195 | this License. 196 | 197 | 7. If, as a consequence of a court judgment or allegation of patent 198 | infringement or for any other reason (not limited to patent issues), 199 | conditions are imposed on you (whether by court order, agreement or 200 | otherwise) that contradict the conditions of this License, they do not 201 | excuse you from the conditions of this License. If you cannot 202 | distribute so as to satisfy simultaneously your obligations under this 203 | License and any other pertinent obligations, then as a consequence you 204 | may not distribute the Program at all. For example, if a patent 205 | license would not permit royalty-free redistribution of the Program by 206 | all those who receive copies directly or indirectly through you, then 207 | the only way you could satisfy both it and this License would be to 208 | refrain entirely from distribution of the Program. 209 | 210 | If any portion of this section is held invalid or unenforceable under 211 | any particular circumstance, the balance of the section is intended to 212 | apply and the section as a whole is intended to apply in other 213 | circumstances. 214 | 215 | It is not the purpose of this section to induce you to infringe any 216 | patents or other property right claims or to contest validity of any 217 | such claims; this section has the sole purpose of protecting the 218 | integrity of the free software distribution system, which is 219 | implemented by public license practices. Many people have made 220 | generous contributions to the wide range of software distributed 221 | through that system in reliance on consistent application of that 222 | system; it is up to the author/donor to decide if he or she is willing 223 | to distribute software through any other system and a licensee cannot 224 | impose that choice. 225 | 226 | This section is intended to make thoroughly clear what is believed to 227 | be a consequence of the rest of this License. 228 | 229 | 8. If the distribution and/or use of the Program is restricted in 230 | certain countries either by patents or by copyrighted interfaces, the 231 | original copyright holder who places the Program under this License 232 | may add an explicit geographical distribution limitation excluding 233 | those countries, so that distribution is permitted only in or among 234 | countries not thus excluded. In such case, this License incorporates 235 | the limitation as if written in the body of this License. 236 | 237 | 9. The Free Software Foundation may publish revised and/or new versions 238 | of the General Public License from time to time. Such new versions will 239 | be similar in spirit to the present version, but may differ in detail to 240 | address new problems or concerns. 241 | 242 | Each version is given a distinguishing version number. If the Program 243 | specifies a version number of this License which applies to it and "any 244 | later version", you have the option of following the terms and conditions 245 | either of that version or of any later version published by the Free 246 | Software Foundation. If the Program does not specify a version number of 247 | this License, you may choose any version ever published by the Free Software 248 | Foundation. 249 | 250 | 10. If you wish to incorporate parts of the Program into other free 251 | programs whose distribution conditions are different, write to the author 252 | to ask for permission. For software which is copyrighted by the Free 253 | Software Foundation, write to the Free Software Foundation; we sometimes 254 | make exceptions for this. Our decision will be guided by the two goals 255 | of preserving the free status of all derivatives of our free software and 256 | of promoting the sharing and reuse of software generally. 257 | 258 | NO WARRANTY 259 | 260 | 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY 261 | FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN 262 | OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES 263 | PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED 264 | OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF 265 | MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS 266 | TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE 267 | PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, 268 | REPAIR OR CORRECTION. 269 | 270 | 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING 271 | WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR 272 | REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, 273 | INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING 274 | OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED 275 | TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY 276 | YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER 277 | PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE 278 | POSSIBILITY OF SUCH DAMAGES. 279 | 280 | END OF TERMS AND CONDITIONS 281 | 282 | How to Apply These Terms to Your New Programs 283 | 284 | If you develop a new program, and you want it to be of the greatest 285 | possible use to the public, the best way to achieve this is to make it 286 | free software which everyone can redistribute and change under these terms. 287 | 288 | To do so, attach the following notices to the program. It is safest 289 | to attach them to the start of each source file to most effectively 290 | convey the exclusion of warranty; and each file should have at least 291 | the "copyright" line and a pointer to where the full notice is found. 292 | 293 | 294 | Copyright (C) 295 | 296 | This program is free software; you can redistribute it and/or modify 297 | it under the terms of the GNU General Public License as published by 298 | the Free Software Foundation; either version 2 of the License, or 299 | (at your option) any later version. 300 | 301 | This program is distributed in the hope that it will be useful, 302 | but WITHOUT ANY WARRANTY; without even the implied warranty of 303 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 304 | GNU General Public License for more details. 305 | 306 | You should have received a copy of the GNU General Public License 307 | along with this program; if not, write to the Free Software 308 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 309 | 310 | 311 | Also add information on how to contact you by electronic and paper mail. 312 | 313 | If the program is interactive, make it output a short notice like this 314 | when it starts in an interactive mode: 315 | 316 | Gnomovision version 69, Copyright (C) year name of author 317 | Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. 318 | This is free software, and you are welcome to redistribute it 319 | under certain conditions; type `show c' for details. 320 | 321 | The hypothetical commands `show w' and `show c' should show the appropriate 322 | parts of the General Public License. Of course, the commands you use may 323 | be called something other than `show w' and `show c'; they could even be 324 | mouse-clicks or menu items--whatever suits your program. 325 | 326 | You should also get your employer (if you work as a programmer) or your 327 | school, if any, to sign a "copyright disclaimer" for the program, if 328 | necessary. Here is a sample; alter the names: 329 | 330 | Yoyodyne, Inc., hereby disclaims all copyright interest in the program 331 | `Gnomovision' (which makes passes at compilers) written by James Hacker. 332 | 333 | , 1 April 1989 334 | Ty Coon, President of Vice 335 | 336 | This General Public License does not permit incorporating your program into 337 | proprietary programs. If your program is a subroutine library, you may 338 | consider it more useful to permit linking proprietary applications with the 339 | library. If this is what you want to do, use the GNU Library General 340 | Public License instead of this License. 341 | 342 | # arch-tag: License file 343 | 344 | -------------------------------------------------------------------------------- /Python/Objects.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverlappingInstances#-} 2 | 3 | {- arch-tag: Python type instances 4 | Copyright (C) 2005 John Goerzen 5 | 6 | This program is free software; you can redistribute it and/or modify 7 | it under the terms of the GNU General Public License as published by 8 | the Free Software Foundation; either version 2 of the License, or 9 | (at your option) any later version. 10 | 11 | This program is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU General Public License for more details. 15 | 16 | You should have received a copy of the GNU General Public License 17 | along with this program; if not, write to the Free Software 18 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 19 | -} 20 | 21 | {- | 22 | Module : Python.Objects 23 | Copyright : Copyright (C) 2005 John Goerzen 24 | License : GNU GPL, version 2 or above 25 | 26 | Maintainer : John Goerzen, 27 | Maintainer : jgoerzen\@complete.org 28 | Stability : provisional 29 | Portability: portable 30 | 31 | Python type instances and object utilities. 32 | 33 | For more similar utilities, see "Python.Objects.File" and 34 | "Python.Objects.Dict". 35 | 36 | Written by John Goerzen, jgoerzen\@complete.org 37 | -} 38 | 39 | module Python.Objects ( 40 | -- * Basic Object Types 41 | PyObject, 42 | -- * Conversions between Haskell and Python Objects 43 | ToPyObject(..), 44 | FromPyObject(..), 45 | -- * Information about Python Objects 46 | typeOf, 47 | strOf, 48 | reprOf, 49 | showPyObject, 50 | dirPyObject, 51 | getattr, 52 | hasattr, 53 | setattr, 54 | -- * Conversions between Python Objects 55 | pyList_AsTuple, 56 | -- * Calling Python Objects 57 | pyObject_Call, 58 | pyObject_CallHs, 59 | pyObject_RunHs, 60 | callMethodHs, 61 | runMethodHs, 62 | noParms, 63 | noKwParms 64 | ) 65 | where 66 | import Python.Types 67 | import Python.Utils 68 | import Foreign.C.Types ( 69 | CLong 70 | , CInt 71 | , CDouble 72 | ) 73 | 74 | import Foreign.C.String ( 75 | withCString 76 | , peekCStringLen 77 | , CStringLen 78 | ) 79 | import Foreign.Ptr (nullPtr) 80 | import Foreign.Storable (peek) 81 | import Foreign.Marshal.Alloc (alloca) 82 | import Python.ForeignImports ( 83 | cpyList_AsTuple 84 | , cpyObject_Call 85 | , pyDict_New 86 | , pyFloat_AsDouble 87 | , pyFloat_FromDouble 88 | , pyInt_AsLong 89 | , pyInt_FromLong 90 | , pyList_Append 91 | , pyList_Check 92 | , pyList_GetItem 93 | , pyList_New 94 | , pyList_Size 95 | , pyLong_FromString 96 | , pyMapping_Items 97 | , pyObject_Dir 98 | , pyObject_GetAttrString 99 | , pyObject_HasAttrString 100 | , pyObject_Repr 101 | , pyObject_SetAttrString 102 | , pyObject_SetItem 103 | , pyObject_Str 104 | , pyObject_Type 105 | , pyString_AsStringAndSize 106 | , pyString_FromStringAndSize 107 | , pyTuple_Check 108 | , pyTuple_GetItem 109 | , pyTuple_Size 110 | ) 111 | 112 | 113 | 114 | 115 | {- | Members of this class can be converted from a Haskell type 116 | to a Python object. -} 117 | class ToPyObject a where 118 | toPyObject :: a -> IO PyObject 119 | 120 | {- | Members of this class can be derived from a Python object. -} 121 | class FromPyObject a where 122 | fromPyObject :: PyObject -> IO a 123 | 124 | ---------------------------------------------------------------------- 125 | -- Functions 126 | ---------------------------------------------------------------------- 127 | {- | Gets the type of a Python object. Same as type(x) in Python. -} 128 | typeOf :: PyObject -> IO PyObject 129 | typeOf x = withPyObject x (\pyo -> pyObject_Type pyo >>= fromCPyObject) 130 | 131 | {- | Gets a string representation of a Python object. Same 132 | as str(x) in Python. -} 133 | strOf :: PyObject -> IO String 134 | strOf x = withPyObject x 135 | (\pyo -> pyObject_Str pyo >>= fromCPyObject >>= fromPyObject) 136 | 137 | 138 | {- | Gets the Python representation of a Python object. 139 | Same as repr(x) in Python. -} 140 | reprOf :: PyObject -> IO String 141 | reprOf x = withPyObject x 142 | (\pyo -> pyObject_Repr pyo >>= fromCPyObject >>= fromPyObject) 143 | 144 | {- | Displays a Python object and its type. -} 145 | showPyObject :: PyObject -> IO String 146 | showPyObject x = do typestr <- typeOf x >>= strOf 147 | contentstr <- strOf x 148 | return $ typestr ++ ": " ++ contentstr 149 | 150 | {- | Displays a list of keys contained in the Python object. -} 151 | dirPyObject :: PyObject -> IO [String] 152 | dirPyObject x = withPyObject x (\cpyo -> 153 | do dr <- pyObject_Dir cpyo >>= fromCPyObject 154 | fromPyObject dr 155 | ) 156 | 157 | {- | Call a Python object with all-Haskell parameters. 158 | Similar to 'PyObject_Call'. This limits you to a single item type for 159 | the regular arguments and another single item type for the keyword arguments. 160 | Nevertheless, it could be a handy shortcut at times. 161 | 162 | For a higher-level wrapper, see 'Python.Interpreter.callByName'. 163 | 164 | You may find 'noParms' and 'noKwParms' useful if you aren't passing any 165 | parameters. -} 166 | pyObject_CallHs :: (ToPyObject a, ToPyObject b, FromPyObject c) => 167 | PyObject -- ^ Object t 168 | -> [a] -- ^ List of non-keyword parameters 169 | -> [(String, b)] -- ^ List of keyword parameters 170 | -> IO c -- ^ Return value 171 | pyObject_CallHs callobj simpleargs kwargs = 172 | pyObject_Hs callobj simpleargs kwargs >>= fromPyObject 173 | 174 | pyObject_Hs :: (ToPyObject a, ToPyObject b) => 175 | PyObject -- ^ Object t 176 | -> [a] -- ^ List of non-keyword parameters 177 | -> [(String, b)] -- ^ List of keyword parameters 178 | -> IO PyObject -- ^ Return value 179 | pyObject_Hs callobj simpleargs kwargs = 180 | let conv (k, v) = do v1 <- toPyObject v 181 | return (k, v1) 182 | in 183 | do s <- mapM toPyObject simpleargs 184 | k <- mapM conv kwargs 185 | pyObject_Call callobj s k 186 | 187 | {- | Like 'PyObject_CallHs', but discards the return value. -} 188 | pyObject_RunHs :: (ToPyObject a, ToPyObject b) => 189 | PyObject -- ^ Object t 190 | -> [a] -- ^ List of non-keyword parameters 191 | -> [(String, b)] -- ^ List of keyword parameters 192 | -> IO () -- ^ Return value 193 | pyObject_RunHs callobj simpleargs kwargs = 194 | pyObject_Hs callobj simpleargs kwargs >> return () 195 | 196 | callMethodHs_internal :: (ToPyObject a, ToPyObject b) => 197 | PyObject 198 | -> String 199 | -> [a] 200 | -> [(String, b)] 201 | -> IO PyObject 202 | callMethodHs_internal pyo method args kwargs = 203 | do mobj <- getattr pyo method 204 | pyObject_Hs mobj args kwargs 205 | 206 | {- | Calls the named method of the given object. -} 207 | callMethodHs :: (ToPyObject a, ToPyObject b, FromPyObject c) => 208 | PyObject -- ^ The main object 209 | -> String -- ^ Name of method to call 210 | -> [a] -- ^ Non-kw args 211 | -> [(String, b)] -- ^ Keyword args 212 | -> IO c -- ^ Result 213 | callMethodHs pyo method args kwargs = 214 | callMethodHs_internal pyo method args kwargs >>= fromPyObject 215 | 216 | {- | Like 'callMethodHs', but discards the return value. -} 217 | runMethodHs :: (ToPyObject a, ToPyObject b) => 218 | PyObject -- ^ The main object 219 | -> String -- ^ Name of method to call 220 | -> [a] -- ^ Non-kw args 221 | -> [(String, b)] -- ^ Keyword args 222 | -> IO () -- ^ Result 223 | runMethodHs pyo method args kwargs = 224 | callMethodHs_internal pyo method args kwargs >> return () 225 | 226 | noParms :: [String] 227 | noParms = [] 228 | 229 | noKwParms :: [(String, String)] 230 | noKwParms = [] 231 | 232 | 233 | 234 | {- | Call a Python object (function, etc). 235 | 236 | For a higher-level wrapper, see 'Python.Interpreter.callByName'. 237 | -} 238 | pyObject_Call :: PyObject -- ^ Object to call 239 | -> [PyObject] -- ^ List of non-keyword parameters (may be empty) 240 | -> [(String, PyObject)] -- ^ List of keyword parameters (may be empty) 241 | -> IO PyObject -- ^ Return value 242 | pyObject_Call callobj simpleparams kwparams = 243 | do pyosimple <- toPyObject simpleparams >>= pyList_AsTuple 244 | pyokw <- toPyObject kwparams 245 | cval <- withPyObject callobj (\ccallobj -> 246 | withPyObject pyosimple (\cpyosimple -> 247 | withPyObject pyokw (\cpyokw -> 248 | cpyObject_Call ccallobj cpyosimple cpyokw))) 249 | fromCPyObject cval 250 | 251 | -- ^ Converts a Python list to a tuple. 252 | pyList_AsTuple :: PyObject -> IO PyObject 253 | pyList_AsTuple x = 254 | withPyObject x (\cpo -> cpyList_AsTuple cpo >>= fromCPyObject) 255 | 256 | {- | An interface to a function similar to Python's getattr. This will 257 | look up an attribute (such as a method) of an object. -} 258 | getattr :: PyObject -> String -> IO PyObject 259 | getattr pyo s = 260 | withPyObject pyo (\cpo -> 261 | withCString s (\cstr -> 262 | pyObject_GetAttrString cpo cstr >>= fromCPyObject)) 263 | 264 | {- | An interface to Python's hasattr. Returns True if the named 265 | attribute exists; False otherwise. -} 266 | hasattr :: PyObject -> String -> IO Bool 267 | hasattr pyo s = 268 | withPyObject pyo (\cpo -> 269 | withCString s (\cstr -> 270 | do r <- pyObject_HasAttrString cpo cstr >>= checkCInt 271 | if r == 0 272 | then return False 273 | else return True 274 | ) 275 | ) 276 | {- | An interface to Python's setattr, used to set attributes of an object. 277 | -} 278 | setattr :: PyObject -- ^ Object to operate on 279 | -> String -- ^ Name of attribute 280 | -> PyObject -- ^ Set the attribute to this value 281 | -> IO () 282 | setattr pyo s setpyo = 283 | withPyObject pyo (\cpo -> 284 | withPyObject setpyo (\csetpyo -> 285 | withCString s (\cstr -> 286 | pyObject_SetAttrString cpo cstr csetpyo >>= checkCInt >> return () 287 | ))) 288 | 289 | ---------------------------------------------------------------------- 290 | -- Instances 291 | ---------------------------------------------------------------------- 292 | 293 | -- FIXME: ERROR CHECKING! 294 | 295 | -------------------------------------------------- 296 | -- [PyObject] Lists 297 | 298 | -- | Lists from a PyObject 299 | instance ToPyObject [PyObject] where 300 | toPyObject mainlist = 301 | do l <- pyList_New 0 302 | mapM_ (\pyo -> withPyObject pyo (\x -> pyList_Append l x >>= checkCInt)) mainlist 303 | fromCPyObject l 304 | 305 | -- | Tuples and Lists to [PyObject] lists 306 | instance FromPyObject [PyObject] where 307 | fromPyObject x = 308 | let worker cpyo = 309 | do islist <- pyList_Check cpyo >>= checkCInt 310 | istuple <- pyTuple_Check cpyo >>= checkCInt 311 | if islist /= 0 312 | then fromx pyList_Size pyList_GetItem cpyo 313 | else if istuple /= 0 314 | then fromx pyTuple_Size pyTuple_GetItem cpyo 315 | else fail "Error fromPyObject to [PyObject]: Passed object not a list or tuple." 316 | fromx sizefunc itemfunc cpyo = do size <- sizefunc cpyo 317 | fromx_worker 0 size itemfunc cpyo 318 | fromx_worker counter size itemfunc cpyo = 319 | if counter >= size 320 | then return [] 321 | else do thisitem <- itemfunc cpyo counter 322 | py_incref thisitem 323 | thisobj <- fromCPyObject thisitem 324 | {- This unsafeInterlaveIO caused segfaults. Theory: 325 | parent object would be deallocated before all 326 | items would be consumed. -} 327 | next <- {-unsafeInterleaveIO $-} fromx_worker (succ counter) size itemfunc cpyo 328 | return $ thisobj : next 329 | in 330 | withPyObject x worker 331 | 332 | -------------------------------------------------- 333 | -- Association Lists 334 | 335 | -- | Dicts from ALs 336 | instance ToPyObject [(PyObject, PyObject)] where 337 | toPyObject mainlist = 338 | do d <- pyDict_New 339 | mapM_ (setitem d) mainlist 340 | fromCPyObject d 341 | where setitem l (key, value) = 342 | withPyObject key (\keyo -> 343 | withPyObject value (\valueo -> 344 | pyObject_SetItem l keyo valueo >>= checkCInt)) 345 | 346 | -- | ALs from Dicts 347 | instance FromPyObject [(PyObject, PyObject)] where 348 | fromPyObject pydict = withPyObject pydict (\cpydict -> 349 | -- Type sigs here are for clarity only 350 | do -- This gives a PyObject 351 | items <- (pyMapping_Items cpydict >>= fromCPyObject):: IO PyObject 352 | -- Now, make a Haskell [[PyObject, PyObject]] list 353 | itemlist <- (fromPyObject items)::IO [[PyObject]] 354 | -- Finally, convert it to a list of tuples. 355 | return $ map list2tup itemlist 356 | ) 357 | where list2tup x = case x of 358 | x1:x2:[] -> (x1, x2) 359 | _ -> error "Expected 2-tuples in fromPyObject dict" 360 | 361 | -- | This is a common variant used for arg lists 362 | instance ToPyObject a => ToPyObject [(a, PyObject)] where 363 | toPyObject mainlist = 364 | let conv (k, v) = do k1 <- toPyObject k 365 | return (k1, v) 366 | in mapM conv mainlist >>= toPyObject 367 | instance FromPyObject a => FromPyObject [(a, PyObject)] where 368 | fromPyObject pyo = 369 | let conv (k, v) = do k1 <- fromPyObject k 370 | return (k1, v) 371 | in do list <- (fromPyObject pyo)::IO [(PyObject, PyObject)] 372 | mapM conv list 373 | 374 | 375 | -- | Dicts from Haskell objects 376 | instance (ToPyObject a, ToPyObject b) => ToPyObject [(a, b)] where 377 | toPyObject mainlist = 378 | let convone (i1, i2) = do oi1 <- toPyObject i1 379 | oi2 <- toPyObject i2 380 | return (oi1, oi2) 381 | in do newl <- mapM convone mainlist 382 | toPyObject newl 383 | 384 | -- | Dicts to Haskell objects 385 | instance (FromPyObject a, FromPyObject b) => FromPyObject [(a, b)] where 386 | fromPyObject pydict = 387 | let conv (x, y) = do x1 <- fromPyObject x 388 | y1 <- fromPyObject y 389 | return (x1, y1) 390 | in do pyodict <- ((fromPyObject pydict)::IO [(PyObject, PyObject)]) 391 | mapM conv pyodict 392 | 393 | -------------------------------------------------- 394 | -- Strings 395 | 396 | -- CStringLen to PyObject. Use CStringLen to handle embedded nulls. 397 | instance ToPyObject CStringLen where 398 | toPyObject (x, len) = 399 | pyString_FromStringAndSize x (fromIntegral len) >>= fromCPyObject 400 | 401 | -- String to PyObject 402 | instance ToPyObject String where 403 | toPyObject x = withCString x (\cstr -> toPyObject (cstr, length x)) 404 | 405 | -- PyObject to String 406 | instance FromPyObject String where 407 | fromPyObject x = withPyObject x (\po -> 408 | alloca (\lenptr -> 409 | alloca (\strptr -> 410 | do pyString_AsStringAndSize po strptr lenptr 411 | len <- peek lenptr 412 | cstr <- peek strptr 413 | peekCStringLen (cstr, (fromIntegral) len) 414 | ) 415 | ) 416 | ) 417 | 418 | -------------------------------------------------- 419 | -- Numbers, Python Ints 420 | 421 | -- Python ints are C longs 422 | instance ToPyObject CLong where 423 | toPyObject x = pyInt_FromLong x >>= fromCPyObject 424 | 425 | -- And convert back. 426 | instance FromPyObject CLong where 427 | fromPyObject x = withPyObject x pyInt_AsLong 428 | 429 | -- We'll also support CInts. 430 | instance ToPyObject CInt where 431 | toPyObject x = toPyObject ((fromIntegral x)::CLong) 432 | 433 | instance FromPyObject CInt where 434 | fromPyObject x = do y <- (fromPyObject x)::IO CLong 435 | return $ fromIntegral y 436 | 437 | -------------------------------------------------- 438 | -- Numbers, Python Longs 439 | 440 | instance ToPyObject Integer where 441 | toPyObject i = 442 | -- Use strings here since no other C type supports 443 | -- unlimited precision. 444 | let repr = show i 445 | in withCString repr (\cstr -> 446 | pyLong_FromString cstr nullPtr 10 >>= fromCPyObject) 447 | 448 | instance FromPyObject Integer where 449 | fromPyObject pyo = 450 | do longstr <- strOf pyo 451 | return $ read longstr 452 | 453 | -------------------------------------------------- 454 | -- Numbers, anything else. 455 | {- For these, we attempt to guess whether to handle it as an 456 | int or a long. -} 457 | {- 458 | Disabled for now; this is a low-level interface, and it seems to be overly 459 | complex for this. 460 | 461 | instance Integral a => ToPyObject a where 462 | toPyObject x = 463 | let intval = toInteger x 464 | in 465 | if (intval < (toInteger (minBound::CLong)) || 466 | intval > (toInteger (maxBound::CLong))) 467 | then toPyObject intval 468 | else toPyObject ((fromIntegral x)::CLong) 469 | 470 | -- On the return conversion, we see what the bounds for 471 | -- the desired type are, and treat it thusly. 472 | instance (Bounded a, Integral a) => FromPyObject a where 473 | fromPyObject x = 474 | let minpyint = toInteger (minBound::CLong) 475 | maxpyint = toInteger (maxBound::CLong) 476 | minpassed = toInteger (minBound::a) 477 | maxpassed = toInteger (maxBound::a) 478 | in if (minpassed < minpyint || maxpassed > maxpyint) 479 | then do intval <- fromPyObject x 480 | return $ fromInteger intval 481 | else do longval <- ((fromPyObject x)::IO CLong) 482 | return $ fromIntegral longval 483 | 484 | -} 485 | 486 | -------------------------------------------------- 487 | -- Floating-Point Values 488 | 489 | instance ToPyObject CDouble where 490 | toPyObject x = pyFloat_FromDouble x >>= fromCPyObject 491 | 492 | instance FromPyObject CDouble where 493 | fromPyObject x = withPyObject x pyFloat_AsDouble 494 | 495 | -- | Lists from anything else 496 | instance ToPyObject a => ToPyObject [a] where 497 | toPyObject mainlist = 498 | do newlist <- mapM toPyObject mainlist 499 | toPyObject newlist 500 | 501 | instance FromPyObject a => FromPyObject [a] where 502 | fromPyObject pylistobj = 503 | do pylist <- fromPyObject pylistobj 504 | mapM fromPyObject pylist 505 | 506 | 507 | --------------------------------------------------------------------------------