missing-py2 (empty) → 1.0.0
raw patch · 44 files changed
+4110/−0 lines, 44 filesdep +Cabaldep +HUnitdep +MissingHbuild-type:Customsetup-changedbinary-added
Dependencies added: Cabal, HUnit, MissingH, anydbm, base, directory, missing-py2
Files
- COPYING +343/−0
- COPYRIGHT +24/−0
- INSTALL +32/−0
- MissingPy.md +73/−0
- README.md +32/−0
- Setup.hs +43/−0
- genexceptions.hs +103/−0
- glue/excglue.c +59/−0
- glue/excglue.h +59/−0
- glue/glue.c +63/−0
- glue/glue.h +29/−0
- missing-py2.cabal +137/−0
- originaltests/AnyDBMPytest.hs +41/−0
- originaltests/AnyDBMtest.hs +137/−0
- originaltests/BZip2test.hs +89/−0
- originaltests/Dicttest.hs +110/−0
- originaltests/Exceptionstest.hs +57/−0
- originaltests/GZiptest.hs +85/−0
- originaltests/Interpretertest.hs +78/−0
- originaltests/Main.hs +36/−0
- originaltests/Objectstest.hs +182/−0
- originaltests/Tests.hs +44/−0
- originaltests/Testutil.hs +55/−0
- src/MissingPy/AnyDBM.hs +98/−0
- src/MissingPy/FileArchive/BZip2.hs +71/−0
- src/MissingPy/FileArchive/GZip.hs +68/−0
- src/Python/Exceptions.hs +111/−0
- src/Python/Exceptions/ExcTypes.hsc +273/−0
- src/Python/ForeignImports.hsc +215/−0
- src/Python/Interpreter.hs +255/−0
- src/Python/Objects.hs +506/−0
- src/Python/Objects/Dict.hs +137/−0
- src/Python/Objects/File.hs +213/−0
- src/Python/Types.hs +93/−0
- src/Python/Utils.hs +159/−0
- testfiles/bz2files/empty.bz2 binary
- testfiles/bz2files/t1.bz2 binary
- testfiles/bz2files/t2.bz2 binary
- testfiles/bz2files/zeros.bz2 binary
- testfiles/gzfiles/empty.gz binary
- testfiles/gzfiles/t1.gz binary
- testfiles/gzfiles/t1bad.gz binary
- testfiles/gzfiles/t2.gz binary
- testfiles/gzfiles/zeros.gz binary
+ COPYING view
@@ -0,0 +1,343 @@+ GNU GENERAL PUBLIC LICENSE+ Version 2, June 1991++ Copyright (C) 1989, 1991 Free Software Foundation, Inc.+ 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.++ Preamble++ The licenses for most software are designed to take away your+freedom to share and change it. By contrast, the GNU General Public+License is intended to guarantee your freedom to share and change free+software--to make sure the software is free for all its users. This+General Public License applies to most of the Free Software+Foundation's software and to any other program whose authors commit to+using it. (Some other Free Software Foundation software is covered by+the GNU Library General Public License instead.) You can apply it to+your programs, too.++ When we speak of free software, we are referring to freedom, not+price. Our General Public Licenses are designed to make sure that you+have the freedom to distribute copies of free software (and charge for+this service if you wish), that you receive source code or can get it+if you want it, that you can change the software or use pieces of it+in new free programs; and that you know you can do these things.++ To protect your rights, we need to make restrictions that forbid+anyone to deny you these rights or to ask you to surrender the rights.+These restrictions translate to certain responsibilities for you if you+distribute copies of the software, or if you modify it.++ For example, if you distribute copies of such a program, whether+gratis or for a fee, you must give the recipients all the rights that+you have. You must make sure that they, too, receive or can get the+source code. And you must show them these terms so they know their+rights.++ We protect your rights with two steps: (1) copyright the software, and+(2) offer you this license which gives you legal permission to copy,+distribute and/or modify the software.++ Also, for each author's protection and ours, we want to make certain+that everyone understands that there is no warranty for this free+software. If the software is modified by someone else and passed on, we+want its recipients to know that what they have is not the original, so+that any problems introduced by others will not reflect on the original+authors' reputations.++ Finally, any free program is threatened constantly by software+patents. We wish to avoid the danger that redistributors of a free+program will individually obtain patent licenses, in effect making the+program proprietary. To prevent this, we have made it clear that any+patent must be licensed for everyone's free use or not licensed at all.++ The precise terms and conditions for copying, distribution and+modification follow.++ GNU GENERAL PUBLIC LICENSE+ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION++ 0. This License applies to any program or other work which contains+a notice placed by the copyright holder saying it may be distributed+under the terms of this General Public License. The "Program", below,+refers to any such program or work, and a "work based on the Program"+means either the Program or any derivative work under copyright law:+that is to say, a work containing the Program or a portion of it,+either verbatim or with modifications and/or translated into another+language. (Hereinafter, translation is included without limitation in+the term "modification".) Each licensee is addressed as "you".++Activities other than copying, distribution and modification are not+covered by this License; they are outside its scope. The act of+running the Program is not restricted, and the output from the Program+is covered only if its contents constitute a work based on the+Program (independent of having been made by running the Program).+Whether that is true depends on what the Program does.++ 1. You may copy and distribute verbatim copies of the Program's+source code as you receive it, in any medium, provided that you+conspicuously and appropriately publish on each copy an appropriate+copyright notice and disclaimer of warranty; keep intact all the+notices that refer to this License and to the absence of any warranty;+and give any other recipients of the Program a copy of this License+along with the Program.++You may charge a fee for the physical act of transferring a copy, and+you may at your option offer warranty protection in exchange for a fee.++ 2. You may modify your copy or copies of the Program or any portion+of it, thus forming a work based on the Program, and copy and+distribute such modifications or work under the terms of Section 1+above, provided that you also meet all of these conditions:++ a) You must cause the modified files to carry prominent notices+ stating that you changed the files and the date of any change.++ b) You must cause any work that you distribute or publish, that in+ whole or in part contains or is derived from the Program or any+ part thereof, to be licensed as a whole at no charge to all third+ parties under the terms of this License.++ c) If the modified program normally reads commands interactively+ when run, you must cause it, when started running for such+ interactive use in the most ordinary way, to print or display an+ announcement including an appropriate copyright notice and a+ notice that there is no warranty (or else, saying that you provide+ a warranty) and that users may redistribute the program under+ these conditions, and telling the user how to view a copy of this+ License. (Exception: if the Program itself is interactive but+ does not normally print such an announcement, your work based on+ the Program is not required to print an announcement.)++These requirements apply to the modified work as a whole. If+identifiable sections of that work are not derived from the Program,+and can be reasonably considered independent and separate works in+themselves, then this License, and its terms, do not apply to those+sections when you distribute them as separate works. But when you+distribute the same sections as part of a whole which is a work based+on the Program, the distribution of the whole must be on the terms of+this License, whose permissions for other licensees extend to the+entire whole, and thus to each and every part regardless of who wrote it.++Thus, it is not the intent of this section to claim rights or contest+your rights to work written entirely by you; rather, the intent is to+exercise the right to control the distribution of derivative or+collective works based on the Program.++In addition, mere aggregation of another work not based on the Program+with the Program (or with a work based on the Program) on a volume of+a storage or distribution medium does not bring the other work under+the scope of this License.++ 3. You may copy and distribute the Program (or a work based on it,+under Section 2) in object code or executable form under the terms of+Sections 1 and 2 above provided that you also do one of the following:++ a) Accompany it with the complete corresponding machine-readable+ source code, which must be distributed under the terms of Sections+ 1 and 2 above on a medium customarily used for software interchange; or,++ b) Accompany it with a written offer, valid for at least three+ years, to give any third party, for a charge no more than your+ cost of physically performing source distribution, a complete+ machine-readable copy of the corresponding source code, to be+ distributed under the terms of Sections 1 and 2 above on a medium+ customarily used for software interchange; or,++ c) Accompany it with the information you received as to the offer+ to distribute corresponding source code. (This alternative is+ allowed only for noncommercial distribution and only if you+ received the program in object code or executable form with such+ an offer, in accord with Subsection b above.)++The source code for a work means the preferred form of the work for+making modifications to it. For an executable work, complete source+code means all the source code for all modules it contains, plus any+associated interface definition files, plus the scripts used to+control compilation and installation of the executable. However, as a+special exception, the source code distributed need not include+anything that is normally distributed (in either source or binary+form) with the major components (compiler, kernel, and so on) of the+operating system on which the executable runs, unless that component+itself accompanies the executable.++If distribution of executable or object code is made by offering+access to copy from a designated place, then offering equivalent+access to copy the source code from the same place counts as+distribution of the source code, even though third parties are not+compelled to copy the source along with the object code.++ 4. You may not copy, modify, sublicense, or distribute the Program+except as expressly provided under this License. Any attempt+otherwise to copy, modify, sublicense or distribute the Program is+void, and will automatically terminate your rights under this License.+However, parties who have received copies, or rights, from you under+this License will not have their licenses terminated so long as such+parties remain in full compliance.++ 5. You are not required to accept this License, since you have not+signed it. However, nothing else grants you permission to modify or+distribute the Program or its derivative works. These actions are+prohibited by law if you do not accept this License. Therefore, by+modifying or distributing the Program (or any work based on the+Program), you indicate your acceptance of this License to do so, and+all its terms and conditions for copying, distributing or modifying+the Program or works based on it.++ 6. Each time you redistribute the Program (or any work based on the+Program), the recipient automatically receives a license from the+original licensor to copy, distribute or modify the Program subject to+these terms and conditions. You may not impose any further+restrictions on the recipients' exercise of the rights granted herein.+You are not responsible for enforcing compliance by third parties to+this License.++ 7. If, as a consequence of a court judgment or allegation of patent+infringement or for any other reason (not limited to patent issues),+conditions are imposed on you (whether by court order, agreement or+otherwise) that contradict the conditions of this License, they do not+excuse you from the conditions of this License. If you cannot+distribute so as to satisfy simultaneously your obligations under this+License and any other pertinent obligations, then as a consequence you+may not distribute the Program at all. For example, if a patent+license would not permit royalty-free redistribution of the Program by+all those who receive copies directly or indirectly through you, then+the only way you could satisfy both it and this License would be to+refrain entirely from distribution of the Program.++If any portion of this section is held invalid or unenforceable under+any particular circumstance, the balance of the section is intended to+apply and the section as a whole is intended to apply in other+circumstances.++It is not the purpose of this section to induce you to infringe any+patents or other property right claims or to contest validity of any+such claims; this section has the sole purpose of protecting the+integrity of the free software distribution system, which is+implemented by public license practices. Many people have made+generous contributions to the wide range of software distributed+through that system in reliance on consistent application of that+system; it is up to the author/donor to decide if he or she is willing+to distribute software through any other system and a licensee cannot+impose that choice.++This section is intended to make thoroughly clear what is believed to+be a consequence of the rest of this License.++ 8. If the distribution and/or use of the Program is restricted in+certain countries either by patents or by copyrighted interfaces, the+original copyright holder who places the Program under this License+may add an explicit geographical distribution limitation excluding+those countries, so that distribution is permitted only in or among+countries not thus excluded. In such case, this License incorporates+the limitation as if written in the body of this License.++ 9. The Free Software Foundation may publish revised and/or new versions+of the General Public License from time to time. Such new versions will+be similar in spirit to the present version, but may differ in detail to+address new problems or concerns.++Each version is given a distinguishing version number. If the Program+specifies a version number of this License which applies to it and "any+later version", you have the option of following the terms and conditions+either of that version or of any later version published by the Free+Software Foundation. If the Program does not specify a version number of+this License, you may choose any version ever published by the Free Software+Foundation.++ 10. If you wish to incorporate parts of the Program into other free+programs whose distribution conditions are different, write to the author+to ask for permission. For software which is copyrighted by the Free+Software Foundation, write to the Free Software Foundation; we sometimes+make exceptions for this. Our decision will be guided by the two goals+of preserving the free status of all derivatives of our free software and+of promoting the sharing and reuse of software generally.++ NO WARRANTY++ 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES+PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS+TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,+REPAIR OR CORRECTION.++ 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR+REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING+OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED+TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY+YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE+POSSIBILITY OF SUCH DAMAGES.++ END OF TERMS AND CONDITIONS++ How to Apply These Terms to Your New Programs++ If you develop a new program, and you want it to be of the greatest+possible use to the public, the best way to achieve this is to make it+free software which everyone can redistribute and change under these terms.++ To do so, attach the following notices to the program. It is safest+to attach them to the start of each source file to most effectively+convey the exclusion of warranty; and each file should have at least+the "copyright" line and a pointer to where the full notice is found.++ <one line to give the program's name and a brief idea of what it does.>+ Copyright (C) <year> <name of author>++ This program is free software; you can redistribute it and/or modify+ it under the terms of the GNU General Public License as published by+ the Free Software Foundation; either version 2 of the License, or+ (at your option) any later version.++ This program is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU General Public License for more details.++ You should have received a copy of the GNU General Public License+ along with this program; if not, write to the Free Software+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+++Also add information on how to contact you by electronic and paper mail.++If the program is interactive, make it output a short notice like this+when it starts in an interactive mode:++ Gnomovision version 69, Copyright (C) year name of author+ Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.+ This is free software, and you are welcome to redistribute it+ under certain conditions; type `show c' for details.++The hypothetical commands `show w' and `show c' should show the appropriate+parts of the General Public License. Of course, the commands you use may+be called something other than `show w' and `show c'; they could even be+mouse-clicks or menu items--whatever suits your program.++You should also get your employer (if you work as a programmer) or your+school, if any, to sign a "copyright disclaimer" for the program, if+necessary. Here is a sample; alter the names:++ Yoyodyne, Inc., hereby disclaims all copyright interest in the program+ `Gnomovision' (which makes passes at compilers) written by James Hacker.++ <signature of Ty Coon>, 1 April 1989+ Ty Coon, President of Vice++This General Public License does not permit incorporating your program into+proprietary programs. If your program is a subroutine library, you may+consider it more useful to permit linking proprietary applications with the+library. If this is what you want to do, use the GNU Library General+Public License instead of this License.++# arch-tag: License file+
+ COPYRIGHT view
@@ -0,0 +1,24 @@+MissingPy: Haskell Python Interface libraries+Copyright (C) 2004 - 2008 John Goerzen <jgoerzen@complete.org>++All code is under the following license unless otherwise noted:+ This program is free software; you can redistribute it and/or modify+ it under the terms of the GNU General Public License as published by+ the Free Software Foundation; either version 2 of the License, or+ (at your option) any later version.++ This program is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU General Public License for more details.++ You should have received a copy of the GNU General Public License+ along with this program; if not, write to the Free Software+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA++The GNU General Public License is available in the file COPYING in the source+distribution. Debian GNU/Linux users may find this in+/usr/share/common-licenses/GPL-2.++If the GPL is unacceptable for your uses, please e-mail me; alternative+terms can be negotiated for your project.
+ INSTALL view
@@ -0,0 +1,32 @@+INSTALLATION INSTRUCTIONS+-------------------------++Before you start, you will of course need to have Python installed,+version 2.3 or better. Get it from www.python.org if you don't have+it already. It's very portable and easily built.++Now, you're ready to build MissingPy.++You'll need GHC 6.8.++Next, download and install MissingH, version 1.0.1 or above. Grab it+from http://software.complete.org/missingh. Debian users can+apt-get install libghc6-missingh-dev.++This will generate the build file MissingPy.cabal. Look at the+declarations near the top and edit them if necessary.++Now, run "make setup" (you may need to edit the Makefile if you don't+use GHC or if your GHC is at an unusual location).++Then:++ ./setup configure+ ./setup build+ ./setup install+ +Optionally, to run the unit tests, you'll need to install HUnit. Then:++ make test++(More to come in this file)
+ MissingPy.md view
@@ -0,0 +1,73 @@+-------------------------+What is MissingPy?+-------------------------++It's two things:++1. A Haskell binding for many C and Python libraries for tasks such as+ data compression, databases, etc. This can be found in the+ MissingPy module tree.++2. A low-level Haskell binding to the Python interpreter to+ enable development of hybrid applications that use both+ environments. This can be found in the Python module tree. The+ Haskell bindings above use this environment.++MissingPy permits you to call Python code from Haskell. It does NOT+permit you to call Haskell code from Python.++-------------------------+Major Features+-------------------------++ * GZip and BZip2 compression and decompression using the generic+ Handle-like HVIO interface++ * *dbm persistent storage using the generic AnyDBM interface++ * Low-level interface to Python for extending your own Haskell code++ * Many unit tests to verify proper functionality++** THIS IS CURRENTLY BETA-QUALITY CODE; MAJOR API FLUCTUATIONS MAY YET OCCUR.++-------------------------+Quick Start+-------------------------++See the file INSTALL.++-------------------------+Usage in programs+-------------------------++You can simply use -package MissingPy in ghc to enable+this library. ++Note that you'll want to compile most of your programs with+-fallow-overlapping-instances at least. (If you use *only*+MissingPy/*, that may not be necessary.) Also, please note that you+must call Python.Interpreter.py_initialize before doing anything else.++The API docs can be built with "make doc", or you can find them at:++http://software.complete.org/missingpy++-------------------------+Author & Homepage+-------------------------++MissingPy was written by John Goerzen <jgoerzen@complete.org>.++The latest version may be obtained at:++ http://software.complete.org/missingpy++Documentation is also available on that page.++This program is copyrighted under the terms of the GNU General Public License.+See the COPYRIGHT and COPYING files for more details.++If the GPL is unacceptable for your uses, please e-mail me; alternative+terms can be negotiated for your project.+
+ README.md view
@@ -0,0 +1,32 @@+# missing-py2 [](https://travis-ci.org/domdere/missing-py2)++A fork of John Goerzen's [**MissingPy**] [softmechanics-missingpy]++Updated to run with **GHC 7.6.3** and run with **Python 2.7.3**, for maintaining projects with existing MissingPy dependencies.++see the original documentation for that project [**here**](./MissingPy.md).++# Usage++Just add `missing-py2` to your `build-depends` list, e.g:++ build-depends:+ base < 5 && >= 4+ , missing-py2++The original documentation prescribes that the `OverlappingInstances` **GHC** extension is neccessary anywhere you use the `Python.*` modules.++That **may** be neccessary, however the unit tests seem to run fine without it now.++Don't forget to run `py_initialize` from `Python.Interpreter` during the start up phase of your application++Requires the `python-dev` libs, which can be installed on Ubuntu with `sudo apt-get install python-dev`.++# See Also++- [**softmechanics/missingpy**] [softmechanics-missingpy] : The original project+- [**cpython**](http://hackage.haskell.org/package/cpython "cpython on hackage") : Another set of `libpython` bindings (looks more well-maintained),+ this would probably be preferable for new projects.+++[softmechanics-missingpy]: https://github.com/softmechanics/missingpy "softmechanics/missingpy on GitHub.com"
+ Setup.hs view
@@ -0,0 +1,43 @@+#!/usr/bin/env runhaskell++import Distribution.PackageDescription+import Distribution.Simple+import Distribution.Simple.LocalBuildInfo+import Distribution.Simple.Program+import Distribution.PackageDescription.Parse (writeHookedBuildInfo)+import qualified Distribution.Verbosity as Verbosity+import Data.List++main = defaultMainWithHooks autoconfUserHooks {+ hookedPrograms = [pyConfigProgram],+ postConf=configure+ }++pyConfigProgram = (simpleProgram "python") ++configure _ _ _ lbi = do+ mb_bi <- pyConfigBuildInfo Verbosity.normal lbi+ writeHookedBuildInfo "MissingPy.buildinfo" (mb_bi,[])++pyVersionDefines = [((<2.5), "PYTHON_PRE_2_5"),+ ((<2.3), "PYTHON_PRE_2_3")]++definesFor v = map (\(_,d) -> "-D" ++ d) $ filter (\(f,_) -> f v) pyVersionDefines++-- Populate BuildInfo using python tool.+pyConfigBuildInfo verbosity lbi = do+ (pyConfigProg, _) <- requireProgram verbosity pyConfigProgram (withPrograms lbi)+ let python = rawSystemProgramStdout verbosity pyConfigProg+ libDir <- python ["-c", "from distutils.sysconfig import *; print get_python_lib()"]+ incDir <- python ["-c", "from distutils.sysconfig import *; print get_python_inc()"]+ confLibDir <- python ["-c", "from distutils.sysconfig import *; print get_config_var('LIBDIR')"]+ pyVersionStr <- python ["-c", "import sys; sys.stdout.write(\"%d.%d\" % (sys.version_info[0], sys.version_info[1]))"]+ let libName = "python" ++ pyVersionStr+ pyVersion = read pyVersionStr+ + return $ Just emptyBuildInfo {+ extraLibDirs = lines confLibDir ++ lines libDir,+ includeDirs = lines incDir ++ ["glue"],+ extraLibs = lines libName,+ cppOptions = definesFor pyVersion+ }
+ genexceptions.hs view
@@ -0,0 +1,103 @@+import MissingH.Str+import Data.List+import System.IO+import Data.Char++notice = " NOTICE -- THIS FILE IS AUTO-GENERATED -- DO NOT EDIT"++ifdefcode str =+ "#ifdef MS_WINDOWS\n" ++ str ++ "\n#endif\n"++windowsexc = "WindowsError"++genGlue copyright excs =+ do h <- openFile "glue/excglue.h" WriteMode+ c <- openFile "glue/excglue.c" WriteMode+ let heads = "/* " ++ notice ++ "\n" ++ copyright ++ + "*/\n#include <Python.h>"+ hPutStrLn h heads+ hPutStrLn c heads+ hPutStrLn h $ unlines . map excfunch $ excs+ hPutStrLn h $ ifdefcode $ excfunch windowsexc+ hPutStrLn c $ unlines . map excfuncc $ excs+ hPutStrLn c $ ifdefcode $ excfuncc windowsexc+ hClose h+ hClose c+ where excfunch e =+ "extern PyObject *hspy_" ++ e ++ "(void);"+ excfuncc e = + "PyObject *hspy_" ++ e ++ "(void) { return PyExc_" ++ e+ ++ "; }"++genExcTypes copyright excs =+ do h <- openFile "Python/Exceptions/ExcTypes.hsc" WriteMode+ hPutStrLn h $ "{- " ++ notice ++ "\n" ++ copyright +++ "-}"+ hPutStrLn h $ unlines $ + ["{- |",+ " Module : Python.Exceptions.ExcTypes",+ " Copyright : Copyright (C) 2005 John Goerzen",+ " License : GNU GPL, version 2 or above",+ "",+ " Maintainer : John Goerzen,",+ " Maintainer : jgoerzen\@complete.org",+ " Stability : provisional",+ " Portability: portable",+ "",+ "Python low-level exception definitions",+ "",+ "These are definitions of the built-in Python exception objects. You can",+ "use them with 'MissingPy.Python.Exceptions.doesExceptionMatch' and",+ "'MissingPy.Python.Exceptions.catchSpecificPy'.",+ "",+ "The meanings of these exceptions can be found at",+ "<http://www.python.org/doc/current/lib/module-exceptions.html>.",+ "",+ "Please note that windowsError is available only on Microsoft platforms.",+ "",+ "Written by John Goerzen, jgoerzen\\@complete.org",+ "-}",+ "#include <Python.h>",+ "module Python.Exceptions.ExcTypes",+ "("]+ hPutStrLn h $ concat $ intersperse ",\n" . map hsname $ excs+ hPutStrLn h $ ifdefcode $ "," ++ (hsname windowsexc)+ hPutStrLn h ")\nwhere"+ hPutStrLn h $ unlines $+ ["import Python.Types",+ "import Python.Objects",+ "import System.IO.Unsafe",+ "import Python.Utils",+ "import Foreign",+ "exctypes_internal_e :: IO (Ptr CPyObject) -> IO PyObject",+ "exctypes_internal_e f = do p <- f",+ " fp <- newForeignPtr_ p",+ " return $ PyObject fp"+ ]+ hPutStrLn h $ unlines . map hsfunc $ excs+ hPutStrLn h $ ifdefcode $ hsfunc windowsexc+ hPutStrLn h $ unlines . map cfunc $ excs+ hPutStrLn h $ ifdefcode $ cfunc windowsexc+ hClose h+ where hsname "Exception" = "pyMainException"+ hsname "EOFError" = "pyEOFError"+ hsname "IOError" = "pyIOError"+ hsname "OSError" = "pyOSError"+ hsname (x:xs) = toLower x : xs+ hscomment "Exception" = "-- | This is Exception in Python; renamed to avoid naming conflicts here.\n"+ hscomment _ = ""+ hsfunc exc =+ hscomment exc ++ + "{-# NOINLINE " ++ hsname exc ++ " #-}\n" +++ hsname exc ++ " = unsafePerformIO $ exctypes_internal_e " +++ "c" ++ exc ++ "\n"+ cfunc exc = + "foreign import ccall unsafe \"excglue.h hspy_" ++ exc ++ "\"\n" +++ " c" ++ exc ++ " :: IO (Ptr CPyObject)\n"+ ++main = do c <- readFile "exceptionlist"+ copyright <- readFile "COPYRIGHT"+ let excs = sort . map strip . filter (/= "") . lines $ c+ genGlue copyright excs+ genExcTypes copyright excs
+ glue/excglue.c view
@@ -0,0 +1,59 @@+/* NOTICE -- THIS FILE IS AUTO-GENERATED -- DO NOT EDIT+MissingPy: Haskell Python Interface libraries+Copyright (C) 2004 - 2005 John Goerzen <jgoerzen@complete.org>++All code is under the following license unless otherwise noted:+ This program is free software; you can redistribute it and/or modify+ it under the terms of the GNU General Public License as published by+ the Free Software Foundation; either version 2 of the License, or+ (at your option) any later version.++ This program is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU General Public License for more details.++ You should have received a copy of the GNU General Public License+ along with this program; if not, write to the Free Software+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA++The GNU General Public License is available in the file COPYING in the source+distribution. Debian GNU/Linux users may find this in+/usr/share/common-licenses/GPL-2.++If the GPL is unacceptable for your uses, please e-mail me; alternative+terms can be negotiated for your project.+*/+#include <Python.h>+PyObject *hspy_ArithmeticError(void) { return PyExc_ArithmeticError; }+PyObject *hspy_AssertionError(void) { return PyExc_AssertionError; }+PyObject *hspy_AttributeError(void) { return PyExc_AttributeError; }+PyObject *hspy_EOFError(void) { return PyExc_EOFError; }+PyObject *hspy_EnvironmentError(void) { return PyExc_EnvironmentError; }+PyObject *hspy_Exception(void) { return PyExc_Exception; }+PyObject *hspy_FloatingPointError(void) { return PyExc_FloatingPointError; }+PyObject *hspy_IOError(void) { return PyExc_IOError; }+PyObject *hspy_ImportError(void) { return PyExc_ImportError; }+PyObject *hspy_IndexError(void) { return PyExc_IndexError; }+PyObject *hspy_KeyError(void) { return PyExc_KeyError; }+PyObject *hspy_KeyboardInterrupt(void) { return PyExc_KeyboardInterrupt; }+PyObject *hspy_LookupError(void) { return PyExc_LookupError; }+PyObject *hspy_MemoryError(void) { return PyExc_MemoryError; }+PyObject *hspy_NameError(void) { return PyExc_NameError; }+PyObject *hspy_NotImplementedError(void) { return PyExc_NotImplementedError; }+PyObject *hspy_OSError(void) { return PyExc_OSError; }+PyObject *hspy_OverflowError(void) { return PyExc_OverflowError; }+PyObject *hspy_ReferenceError(void) { return PyExc_ReferenceError; }+PyObject *hspy_RuntimeError(void) { return PyExc_RuntimeError; }+PyObject *hspy_StandardError(void) { return PyExc_StandardError; }+PyObject *hspy_SyntaxError(void) { return PyExc_SyntaxError; }+PyObject *hspy_SystemError(void) { return PyExc_SystemError; }+PyObject *hspy_SystemExit(void) { return PyExc_SystemExit; }+PyObject *hspy_TypeError(void) { return PyExc_TypeError; }+PyObject *hspy_ValueError(void) { return PyExc_ValueError; }+PyObject *hspy_ZeroDivisionError(void) { return PyExc_ZeroDivisionError; }++#ifdef MS_WINDOWS+PyObject *hspy_WindowsError(void) { return PyExc_WindowsError; }+#endif+
+ glue/excglue.h view
@@ -0,0 +1,59 @@+/* NOTICE -- THIS FILE IS AUTO-GENERATED -- DO NOT EDIT+MissingPy: Haskell Python Interface libraries+Copyright (C) 2004 - 2005 John Goerzen <jgoerzen@complete.org>++All code is under the following license unless otherwise noted:+ This program is free software; you can redistribute it and/or modify+ it under the terms of the GNU General Public License as published by+ the Free Software Foundation; either version 2 of the License, or+ (at your option) any later version.++ This program is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU General Public License for more details.++ You should have received a copy of the GNU General Public License+ along with this program; if not, write to the Free Software+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA++The GNU General Public License is available in the file COPYING in the source+distribution. Debian GNU/Linux users may find this in+/usr/share/common-licenses/GPL-2.++If the GPL is unacceptable for your uses, please e-mail me; alternative+terms can be negotiated for your project.+*/+#include <Python.h>+extern PyObject *hspy_ArithmeticError(void);+extern PyObject *hspy_AssertionError(void);+extern PyObject *hspy_AttributeError(void);+extern PyObject *hspy_EOFError(void);+extern PyObject *hspy_EnvironmentError(void);+extern PyObject *hspy_Exception(void);+extern PyObject *hspy_FloatingPointError(void);+extern PyObject *hspy_IOError(void);+extern PyObject *hspy_ImportError(void);+extern PyObject *hspy_IndexError(void);+extern PyObject *hspy_KeyError(void);+extern PyObject *hspy_KeyboardInterrupt(void);+extern PyObject *hspy_LookupError(void);+extern PyObject *hspy_MemoryError(void);+extern PyObject *hspy_NameError(void);+extern PyObject *hspy_NotImplementedError(void);+extern PyObject *hspy_OSError(void);+extern PyObject *hspy_OverflowError(void);+extern PyObject *hspy_ReferenceError(void);+extern PyObject *hspy_RuntimeError(void);+extern PyObject *hspy_StandardError(void);+extern PyObject *hspy_SyntaxError(void);+extern PyObject *hspy_SystemError(void);+extern PyObject *hspy_SystemExit(void);+extern PyObject *hspy_TypeError(void);+extern PyObject *hspy_ValueError(void);+extern PyObject *hspy_ZeroDivisionError(void);++#ifdef MS_WINDOWS+extern PyObject *hspy_WindowsError(void);+#endif+
+ glue/glue.c view
@@ -0,0 +1,63 @@+/* arch-tag: Python Utility Functions+Copyright (C) 2005 John Goerzen <jgoerzen@complete.org>++This program is free software; you can redistribute it and/or modify+it under the terms of the GNU General Public License as published by+the Free Software Foundation; either version 2 of the License, or+(at your option) any later version.++This program is distributed in the hope that it will be useful,+but WITHOUT ANY WARRANTY; without even the implied warranty of+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+GNU General Public License for more details.++You should have received a copy of the GNU General Public License+along with this program; if not, write to the Free Software+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+ */++#include <Python.h>++void hspy_decref(PyObject *o) {+ Py_DECREF(o);+}++void hspy_incref(PyObject *o) {+ Py_INCREF(o);+}++int hspy_list_check(PyObject *o) {+ return PyList_Check(o);+}++int hspy_tuple_check(PyObject *o) {+ return PyTuple_Check(o);+}++PyObject ** hspy_getexc(void) {+ static PyObject *retval [3];+ PyObject *type;+ PyObject *val;+ PyObject *tb;++ PyErr_Fetch(&type, &val, &tb);+ PyErr_NormalizeException(&type, &val, &tb);+ retval[0] = type;+ retval[1] = val;+ retval[2] = tb;+ PyErr_Clear();+ return retval;+}++PyObject *hspy_none(void) {+ Py_INCREF(Py_None);+ return Py_None;+}++PyObject *glue_PyMapping_Keys(PyObject *o) {+ return PyMapping_Keys(o);+}++PyObject *glue_PyMapping_Items(PyObject *o) {+ return PyMapping_Items(o);+}
+ glue/glue.h view
@@ -0,0 +1,29 @@+/* arch-tag: Python Utility Functions, header file+Copyright (C) 2005 John Goerzen <jgoerzen@complete.org>++This program is free software; you can redistribute it and/or modify+it under the terms of the GNU General Public License as published by+the Free Software Foundation; either version 2 of the License, or+(at your option) any later version.++This program is distributed in the hope that it will be useful,+but WITHOUT ANY WARRANTY; without even the implied warranty of+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+GNU General Public License for more details.++You should have received a copy of the GNU General Public License+along with this program; if not, write to the Free Software+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+ */++#include <Python.h>+extern void hspy_decref(PyObject *o);+extern void hspy_incref(PyObject *o);+extern PyObject ** hspy_getexc();+extern int hspy_list_check(PyObject *o);+extern int hspy_tuple_check(PyObject *o);+extern PyObject *hspy_none(void);++/* These are now macros */+extern PyObject *glue_PyMapping_Keys(PyObject *o);+extern PyObject *glue_PyMapping_Items(PyObject *o);
+ missing-py2.cabal view
@@ -0,0 +1,137 @@+name: missing-py2+version: 1.0.0+license: GPL-2+maintainer: Dom De Re+author: John Goerzen+license-file: COPYRIGHT+extra-source-files:+ COPYING+ , genexceptions.hs+ , README.md+ , MissingPy.md+ , INSTALL+ , glue/excglue.h+ , glue/glue.h+ , testfiles/bz2files/empty.bz2+ , testfiles/bz2files/t1.bz2+ , testfiles/bz2files/t2.bz2+ , testfiles/bz2files/zeros.bz2+ , testfiles/gzfiles/empty.gz+ , testfiles/gzfiles/t1.gz+ , testfiles/gzfiles/t1bad.gz+ , testfiles/gzfiles/t2.gz+ , testfiles/gzfiles/zeros.gz++stability: Alpha+copyright: Copyright (c) 2005-2008 John Goerzen+synopsis: Haskell interface to Python+category: Foreign+homepage: https://github.com/domdere/missing-py2+bug-reports: https://github.com/domdere/missing-py2/issues++description:++ A Haskell Interface into the standard Python Interpreter++ A fork of John Goerzen's MissingPy library, hlinted and updated to run with GHC 7.6.3,++ this is for legacy projects,++ for newer projects you might want to consider http://hackage.haskell.org/package/cpython+ instead++ Original Documentation:++ MissingPy is two things:++ .+ A Haskell binding for many C and Python libraries for tasks such as+ data compression, databases, etc. This can be found in the+ MissingPy module tree.+ .+ Also, it's a low-level Haskell binding to the Python interpreter to+ enable development of hybrid applications that use both+ environments. This can be found in the Python module tree. The+ Haskell bindings above use this environment.+ .+ MissingPy permits you to call Python code from Haskell. It does NOT+ permit you to call Haskell code from Python.+ .+ MissingPy is the companion to my MissingH library, and integrates with+ it.++build-type: Custom+cabal-version: >= 1.10++source-repository head+ type: git+ location: https://github.com/domdere/missing-py2++library+ default-language:+ Haskell2010++ exposed-modules: Python.Types,+ Python.Utils,+ Python.Objects,+ Python.Interpreter,+ Python.Exceptions,+ Python.Exceptions.ExcTypes,+ Python.Objects.File,+ Python.Objects.Dict,+ MissingPy.FileArchive.GZip,+ MissingPy.FileArchive.BZip2,+ MissingPy.AnyDBM++ other-modules:+ Python.ForeignImports++ build-depends:+ base < 5 && >= 4+ , MissingH >= 1.0.1+ , anydbm >= 1.0.5++ hs-source-dirs:+ src++ c-sources: glue/glue.c glue/excglue.c++ default-extensions:+ ForeignFunctionInterface,+ TypeSynonymInstances,+ FlexibleInstances++test-suite originalunittests+ type: exitcode-stdio-1.0+ main-is: Main.hs++ other-modules:+ AnyDBMPytest+ AnyDBMtest+ BZip2test+ Dicttest+ Exceptionstest+ GZiptest+ Interpretertest+ Objectstest+ Tests+ Testutil++ default-language:+ Haskell2010++ build-depends:+ base < 5 && >= 4,+ Cabal,+ anydbm >= 1.0.5,+ directory,+ MissingH >= 1.0.1,+ HUnit,+ missing-py2++ ghc-options:+ -Wall+ -threaded++ hs-source-dirs:+ originaltests
+ originaltests/AnyDBMPytest.hs view
@@ -0,0 +1,41 @@+{- arch-tag: AnyDBM tests for Python+Copyright (C) 2004-2005 John Goerzen <jgoerzen@complete.org>++This program is free software; you can redistribute it and/or modify+it under the terms of the GNU General Public License as published by+the Free Software Foundation; either version 2 of the License, or+(at your option) any later version.++This program is distributed in the hope that it will be useful,+but WITHOUT ANY WARRANTY; without even the implied warranty of+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+GNU General Public License for more details.++You should have received a copy of the GNU General Public License+along with this program; if not, write to the Free Software+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+-}++module AnyDBMPytest(tests) where+import Test.HUnit+import MissingPy.AnyDBM+import AnyDBMtest hiding (tests)++testmod :: String -> [Test]+testmod m = genericPersistTest (return ())+ (const $ openSpecificDBM m ("testtmp/" ++ m) DBM_ReadWriteCreate)+ +++ genericTest (return ())+ (const $ openSpecificDBM m ("testtmp/" ++ m) DBM_ReadWriteCreate)++tests :: Test+tests = TestList [ TestLabel "anydbm" (TestList $ testmod "anydbm")+ , TestLabel "dbhash" (TestList $ testmod "dbhash")+-- , TestLabel "dbm" (TestList $ testmod "dbm")+ , TestLabel "dumbdbm" (TestList $ testmod "dumbdbm")+ , TestLabel "gdbm" (TestList $ testmod "gdbm")+ ]++++
+ originaltests/AnyDBMtest.hs view
@@ -0,0 +1,137 @@+{- arch-tag: AnyDBM tests main file+Copyright (C) 2004-2005 John Goerzen <jgoerzen@complete.org>++This program is free software; you can redistribute it and/or modify+it under the terms of the GNU General Public License as published by+the Free Software Foundation; either version 2 of the License, or+(at your option) any later version.++This program is distributed in the hope that it will be useful,+but WITHOUT ANY WARRANTY; without even the implied warranty of+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+GNU General Public License for more details.++You should have received a copy of the GNU General Public License+along with this program; if not, write to the Free Software+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+-}++module AnyDBMtest(mf, genericPersistTest, genericTest, tests) where+import Test.HUnit+import System.IO.HVFS+import Control.Monad (liftM)+import Database.AnyDBM+import Database.AnyDBM.StringDBM+import Database.AnyDBM.MapDBM+import System.Directory+import System.IO.HVFS.Utils+import Data.HashTable+import Data.List (sort)+import Control.Exception (finally)++mf :: AnyDBM a => IO b -> (b -> IO a) -> String -> (a -> Assertion) -> Test+mf initfunc openfunc msg code =+ TestLabel msg $ TestCase $ do i <- initfunc+ h <- openfunc i+ finally (code h) (closeA h)++(@>=?) :: (Eq a, Show a) => a -> IO a -> Assertion+(@>=?) expression res = do+ r <- res+ expression @=? r++infix 1 @>=?++deleteall :: AnyDBM a => a -> IO ()+deleteall h = do+ k <- keysA h+ mapM_ (deleteA h) k+ [] @>=? keysA h++weirdl :: [(String, String)]+weirdl = sort [ ("", "empty")+ , ("foo\nbar", "v1\0v2")+ , ("v3,v4", "")+ , ("k\0ey", "")+ ]++createdir :: Test+createdir = TestCase $ createDirectory "testtmp"++removedir :: Test+removedir = TestCase $ recursiveRemove SystemFS "testtmp"++genericTest :: AnyDBM a => IO b -> (b -> IO a) -> [Test]+genericTest initfunc openfunc =+ let f = mf initfunc openfunc in+ [ createdir+ , f "empty" $ \h -> do+ [] @>=? keysA h+ [] @>=? valuesA h+ [] @>=? toListA h+ Nothing @>=? lookupA h "foo"+ , f "basic" $ \h -> do+ insertA h "key" "value"+ Just "value" @>=? lookupA h "key"+ [("key", "value")] @>=? toListA h+ insertA h "key" "v2"+ [("key", "v2")] @>=? toListA h+ deleteA h "key"+ [] @>=? toListA h+ , f "mult" $ \h -> do+ insertListA h [("1", "2"), ("3", "4"), ("5", "6")]+ [("1", "2"), ("3", "4"), ("5", "6")] @>=?+ liftM sort (toListA h)+ ["1", "3", "5"] @>=? liftM sort (keysA h)+ ["2", "4", "6"] @>=? liftM sort (valuesA h)+ deleteall h+ , f "weirdchars" $ \h -> do+ insertListA h weirdl+ weirdl @>=? liftM sort (toListA h)+ deleteall h+ , removedir+ ]++genericPersistTest :: AnyDBM a => IO b -> (b -> IO a) -> [Test]+genericPersistTest initfunc openfunc =+ let f = mf initfunc openfunc in+ [ createdir+ , f "empty" deleteall+ , f "weirdpop" $ \h -> insertListA h weirdl+ , f "weirdcheck" $ \h -> do+ weirdl @>=? liftM sort (toListA h)+ deleteall h+ insertA h "key" "value"+ , f "step3" $ \h -> do+ [("key", "value")] @>=? liftM sort (toListA h)+ insertA h "key" "v2"+ insertA h "z" "y"+ , f "step4" $ \h -> [("key", "v2"), ("z", "y")] @>=?+ liftM sort (toListA h)+ , f "cleanupdb" deleteall+ , removedir+ ]++testHashtable :: [Test]+testHashtable = genericTest (return ())+ (\_ -> new (==) hashString :: IO (HashTable String String))++testMap :: [Test]+testMap = genericTest (return ())+ (const newMapDBM)++testStringdbm :: [Test]+testStringdbm = genericPersistTest (return SystemFS)+ (\f -> openStringVDBM f "testtmp/StringDBM" ReadWriteMode)+ +++ genericTest (return SystemFS)+ (\f -> openStringVDBM f "testtmp/StringDBM" ReadWriteMode)++tests :: Test+tests = TestList [ TestLabel "HashTable" (TestList testHashtable)+ , TestLabel "StringDBM" (TestList testStringdbm)+ , TestLabel "Map" (TestList testMap)+ ]+++
+ originaltests/BZip2test.hs view
@@ -0,0 +1,89 @@+{- arch-tag: BZip2 tests main file+Copyright (C) 2005 John Goerzen <jgoerzen@complete.org>++This program is free software; you can redistribute it and/or modify+it under the terms of the GNU General Public License as published by+the Free Software Foundation; either version 2 of the License, or+(at your option) any later version.++This program is distributed in the hope that it will be useful,+but WITHOUT ANY WARRANTY; without even the implied warranty of+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+GNU General Public License for more details.++You should have received a copy of the GNU General Public License+along with this program; if not, write to the Free Software+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+-}++module BZip2test (tests) where+import Test.HUnit+import Python.Exceptions+import MissingPy.FileArchive.BZip2+import Control.Monad (unless)+import System.IO.HVIO+import System.IO+import System.IO.Error+import Testutil+import System.Directory+import Control.Exception (finally)++f' :: (a -> String -> IO b) -> String -> a -> Test+f' mf fn expression = TestLabel fn $ TestCase $ handlePy exc2ioerror $ do + bzf <- openBz2 ("testfiles/bz2files/" ++ fn) ReadMode 9+ c <- vGetContents bzf+ _ <- mf expression c+ vClose bzf++f :: String -> String -> Test+f = f' (@=?)++f2 :: String -> String -> Test+f2 = f' nodisptest++-- @=? loads the whole thing into memory. ick. This is much better.+nodisptest :: (Eq a) => a -> a -> IO ()+nodisptest x y = unless (x == y) $ assertFailure "Data mismatch"++testBunzip2 :: [Test]+testBunzip2 =+ [ f "t1.bz2" "Test 1"+ , f "t2.bz2" "Test 1Test 2"+ , f "empty.bz2" ""+ , TestCase $ do+ bzf <- openBz2 "testfiles/bz2files/zeros.bz2" ReadMode 1+ c <- vGetContents bzf+ 10485760 @=? length c+ vClose bzf+ , f2 "zeros.bz2" (replicate 10485760 '\0')+ ]++testBzip2 :: Test+testBzip2 = TestCase $+ handlePy exc2ioerror $ do+ bzf <- openBz2 "testfiles/bz2files/deleteme.bz2" WriteMode 9+ finally (do+ vPutStr bzf "Test 2\n"+ vFlush bzf+ vPutStr bzf "Test 3\n"+ vPutStr bzf (replicate 1048576 't')+ vPutChar bzf '\n'+ vClose bzf+ bzf2 <- openBz2 "testfiles/bz2files/deleteme.bz2" ReadMode 9+ vGetLine bzf2 >>= (@=? "Test 2")+ vGetLine bzf2 >>= (@=? "Test 3")+ _ <- vGetLine bzf2+ assertRaises "eof" (mkIOError eofErrorType "" Nothing Nothing) (vGetLine bzf2)++ vRewind bzf2+ c <- vGetContents bzf2+ ("Test 2\nTest 3\n" ++ replicate 1048576 't' ++ "\n")+ @=? c+ assertRaises "closed" (mkIOError illegalOperationErrorType "" Nothing Nothing) (vGetLine bzf2)+ vClose bzf2+ ) $ removeFile "testfiles/bz2files/deleteme.bz2"++tests :: Test+tests = TestList [ TestLabel "bzip2" testBzip2+ , TestLabel "bunzip2" (TestList testBunzip2)+ ]
+ originaltests/Dicttest.hs view
@@ -0,0 +1,110 @@+{- arch-tag: AnyDBM/Dict Python Tests Main File+Copyright (C) 2004-2005 John Goerzen <jgoerzen@complete.org>++This program is free software; you can redistribute it and/or modify+it under the terms of the GNU General Public License as published by+the Free Software Foundation; either version 2 of the License, or+(at your option) any later version.++This program is distributed in the hope that it will be useful,+but WITHOUT ANY WARRANTY; without even the implied warranty of+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+GNU General Public License for more details.++You should have received a copy of the GNU General Public License+along with this program; if not, write to the Free Software+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+-}++module Dicttest(mf, genericTest, tests) where+import Test.HUnit+import Database.AnyDBM+import Data.List (sort)+import Control.Exception (finally)+import Control.Monad (liftM)+import Python.Objects+import Python.Objects.Dict++mf :: AnyDBM a => IO b -> (b -> IO a) -> String -> (a -> Assertion) -> Test+mf initfunc openfunc msg code =+ TestLabel msg $ TestCase $ do+ i <- initfunc+ h <- openfunc i+ finally (code h) (closeA h)++(@>=?) :: (Eq a, Show a) => a -> IO a -> Assertion+(@>=?) expression res = do+ r <- res+ expression @=? r+infix 1 @>=?++deleteall :: AnyDBM a => a -> IO ()+deleteall h = do+ k <- keysA h+ mapM_ (deleteA h) k+ [] @>=? keysA h++weirdl :: [(String, String)]+weirdl = sort [("", "empty"),+ ("foo\nbar", "v1\0v2"),+ ("v3,v4", ""),+ ("k\0ey", "")]++genericTest :: AnyDBM b => IO a -> (a -> IO b) -> [Test]+genericTest initfunc openfunc =+ let+ f = mf initfunc openfunc+ in+ [ f "empty" $ \h -> do+ [] @>=? keysA h+ [] @>=? valuesA h+ [] @>=? toListA h+ Nothing @>=? lookupA h "foo"+ , f "basic" $ \h -> do+ insertA h "key" "value"+ Just "value" @>=? lookupA h "key"+ [("key", "value")] @>=? toListA h+ insertA h "key" "v2"+ [("key", "v2")] @>=? toListA h+ deleteA h "key"+ [] @>=? toListA h+ , f "mult" $ \h -> do+ insertListA h [("1", "2"), ("3", "4"), ("5", "6")]+ [("1", "2"), ("3", "4"), ("5", "6")] @>=?+ liftM sort (toListA h)+ ["1", "3", "5"] @>=? liftM sort (keysA h)+ ["2", "4", "6"] @>=? liftM sort (valuesA h)+ deleteall h+ , f "weirdchars" $ \h -> do+ insertListA h weirdl+ weirdl @>=? liftM sort (toListA h)+ deleteall h+ ]++--genericPersistTest :: AnyDBM b => IO a -> (a -> IO b) -> [Test]+--genericPersistTest initfunc openfunc =+-- let+-- f = mf initfunc openfunc+-- in+-- [ f "empty" deleteall+-- , f "weirdpop" $ \h -> insertListA h weirdl+-- , f "weirdcheck" $ \h -> do+-- weirdl @>=? liftM sort (toListA h)+-- deleteall h+-- insertA h "key" "value"+-- , f "step3" $ \h -> do+-- [("key", "value")] @>=? liftM sort (toListA h)+-- insertA h "key" "v2"+-- insertA h "z" "y"+-- , f "step4" $ \h -> [("key", "v2"), ("z", "y")] @>=? liftM sort (toListA h)+-- , f "cleanup" deleteall+-- ]++testDict :: [Test]+testDict = genericTest (return ())+ (const $ liftM mkPyDict (toPyObject ([] :: [(String, String)])))+++tests :: Test+tests = TestList [ TestLabel "Basic Dict" (TestList testDict)+ ]
+ originaltests/Exceptionstest.hs view
@@ -0,0 +1,57 @@+{- arch-tag: Exceptions tests main file+Copyright (C) 2005 John Goerzen <jgoerzen@complete.org>++This program is free software; you can redistribute it and/or modify+it under the terms of the GNU General Public License as published by+the Free Software Foundation; either version 2 of the License, or+(at your option) any later version.++This program is distributed in the hope that it will be useful,+but WITHOUT ANY WARRANTY; without even the implied warranty of+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+GNU General Public License for more details.++You should have received a copy of the GNU General Public License+along with this program; if not, write to the Free Software+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+-}++module Exceptionstest(tests) where+import Test.HUnit+import Python.Objects+import Python.Exceptions+import Python.Exceptions.ExcTypes+import Python.Interpreter+import Python.Types+import Control.Exception (catch)++--f :: (ToPyObject a, Eq b, Show b) => String -> a -> (PyObject -> IO b) -> b -> Test+--f msg inp code expression = TestLabel msg $ TestCase $ do+-- pyo <- toPyObject inp+-- r <- code pyo+-- expression @=? r++testBase :: [Test]+testBase =+ let handler = const $ return ()+ in+ [ TestCase $ catchPy (do+ r <- pyRun_StringHs " 2 + None" Py_eval_input noKwParms+ r @=? "no exception raised"+ ) handler+ , TestCase $ catchSpecificPy typeError (do+ r <- pyRun_StringHs "2 + None" Py_eval_input noKwParms+ r @=? "no exception raised"+ ) handler+ , TestCase $ catchSpecificPy valueError (+ Control.Exception.catch (do+ r <- pyRun_StringHs "2 + None" Py_eval_input noKwParms+ r @=? "no exception raised"+ )+ (\PyException {} -> return () )+ ) (const $ fail "Incorrectly caught exception")+ ]++tests :: Test+tests = TestList [ TestLabel "base" (TestList testBase)+ ]
+ originaltests/GZiptest.hs view
@@ -0,0 +1,85 @@+{- arch-tag: GZip tests main file+Copyright (C) 2005-2008 John Goerzen <jgoerzen@complete.org>++This program is free software; you can redistribute it and/or modify+it under the terms of the GNU General Public License as published by+the Free Software Foundation; either version 2 of the License, or+(at your option) any later version.++This program is distributed in the hope that it will be useful,+but WITHOUT ANY WARRANTY; without even the implied warranty of+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+GNU General Public License for more details.++You should have received a copy of the GNU General Public License+along with this program; if not, write to the Free Software+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+-}++module GZiptest(tests) where+import Test.HUnit+import Python.Exceptions+import MissingPy.FileArchive.GZip+import System.IO.HVIO+import System.IO+import System.IO.Error+import Testutil+import System.Directory+import Control.Exception (finally)++f :: String -> String -> Test+f fn expression = TestCase $ do+ gzf <- openGz ("testfiles/gzfiles/" ++ fn) ReadMode 9+ c <- vGetContents gzf+ expression @=? c+ vClose gzf++testGunzip :: [Test]+testGunzip =+ [ f "t1.gz" "Test 1"+ , f "empty.gz" ""+ -- , "t1bad has errors+ , f "t2.gz" "Test 1Test 2"+ , TestCase $ handlePy exc2ioerror $ do+ gzf <- openGz "testfiles/gzfiles/t1bad.gz" ReadMode 1+ assertRaises "crc" (userError "Python <type 'exceptions.IOError'>: CRC check failed 0x9827f819 != 0x9927f819L")+ (handlePy exc2ioerror $ do+ c <- vGetContents gzf+ "nonexistant bad data" @=? c+ )+ vClose gzf+ , TestCase $ do+ gzf <- openGz "testfiles/gzfiles/zeros.gz" ReadMode 1+ c <- vGetContents gzf+ 10485760 @=? length c+ vClose gzf+ --, f "zeros.gz" (replicate 10485760 '\0')+ ]++testGzip :: Test+testGzip = TestCase $+ handlePy exc2ioerror $ do+ gzf <- openGz "testfiles/gzfiles/deleteme.gz" ReadWriteMode 9+ finally (do+ vPutStr gzf "Test 2\n"+ vSeek gzf AbsoluteSeek 7+ vFlush gzf+ vPutStr gzf "Test 3\n"+ vPutStr gzf (replicate 1048576 't')+ vPutChar gzf '\n'+ vClose gzf+ gzf2 <- openGz "testfiles/gzfiles/deleteme.gz" ReadMode 9+ vGetLine gzf2 >>= (@=? "Test 2")+ vGetLine gzf2 >>= (@=? "Test 3")+ vRewind gzf2+ c <- vGetContents gzf2+ ("Test 2\nTest 3\n" ++ replicate 1048576 't' ++ "\n")+ @=? c+ assertRaises "eof" (mkIOError illegalOperationErrorType "" Nothing Nothing) (vGetLine gzf2)+ vClose gzf2+ ) (removeFile "testfiles/gzfiles/deleteme.gz")++tests :: Test+tests = TestList [ TestLabel "gzip" testGzip+ , TestLabel "gunzip" (TestList testGunzip)+ ]
+ originaltests/Interpretertest.hs view
@@ -0,0 +1,78 @@+{- arch-tag: Interpreter tests main file+Copyright (C) 2005 John Goerzen <jgoerzen@complete.org>++This program is free software; you can redistribute it and/or modify+it under the terms of the GNU General Public License as published by+the Free Software Foundation; either version 2 of the License, or+(at your option) any later version.++This program is distributed in the hope that it will be useful,+but WITHOUT ANY WARRANTY; without even the implied warranty of+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+GNU General Public License for more details.++You should have received a copy of the GNU General Public License+along with this program; if not, write to the Free Software+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+-}++module Interpretertest(tests) where++import Testutil (testMedInt)++import Test.HUnit+import Python.Interpreter+import Foreign.C.Types+import Python.Objects++testBase :: [Test]+testBase =+ let f msg t = TestLabel msg $ TestCase t in+ [ f "longs" $ do+ pyo <- toPyObject (10::CLong)+ newl <- fromPyObject pyo+ (10::CLong) @=? newl+ , f "print" $ pyRun_SimpleString "print \"Hi from Python\\n\""+ ]++testCallByName :: [Test]+testCallByName =+ let+ f msg func inp expression = TestLabel msg $ TestCase $ do+ r <-callByNameHs func inp noKwParms+ expression @=? r+ in+ [ f "repr" "repr" [5::Integer] "5L"+ , f "repr2" "repr" [5::CLong] "5"+ , f "pow" "pow" [2::CInt, 32::CInt] testMedInt++ , TestLabel "import" $ TestCase $ do+ pyImport "base64"+ r <- callByNameHs "base64.encodestring" ["hi"] noKwParms+ "aGk=\n" @=? r+ ]++testArgs :: [Test]+testArgs =+ let+ f msg code inp expression = TestLabel msg $ TestCase $ do+ let testhdict = [("testval", inp)]+ retobj <- pyRun_StringHs code Py_eval_input testhdict+ expression @=? retobj+ in+ [ f "addition" "testval + 3" (2::CLong) (5::CLong)+{-+ , TestLabel "m1" $ TestCase $+ do testpydict <- toPyObject [(5::CInt, 2::CInt)]+ retobj <- pyRun_String "testval + 3" 0 Nothing (Just testpydict)+ retval <- fromPyObject retobj+ 5 @=? retval+-}+ ]+++tests :: Test+tests = TestList [ TestLabel "base" (TestList testBase)+ , TestLabel "args" (TestList testArgs)+ , TestLabel "callByName" (TestList testCallByName)+ ]
+ originaltests/Main.hs view
@@ -0,0 +1,36 @@+{- arch-tag: Test runner+Copyright (C) 2004 John Goerzen <jgoerzen@complete.org>++This program is free software; you can redistribute it and/or modify+it under the terms of the GNU General Public License as published by+the Free Software Foundation; either version 2 of the License, or+(at your option) any later version.++This program is distributed in the hope that it will be useful,+but WITHOUT ANY WARRANTY; without even the implied warranty of+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+GNU General Public License for more details.++You should have received a copy of the GNU General Public License+along with this program; if not, write to the Free Software+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+-}++module Main where++import Tests (tests)+import Python.Interpreter++import Control.Monad (unless)+import Test.HUnit (runTestTT, Counts(..))+import System.Exit (exitFailure)++main :: IO ()+main = do+ py_initialize+ counts <- runTestTT tests+ unless (isSuccess counts) exitFailure++isSuccess :: Counts -> Bool+isSuccess (Counts _ _ numErrors numFails) = (numErrors == 0) && (numFails == 0)+
+ originaltests/Objectstest.hs view
@@ -0,0 +1,182 @@+{- arch-tag: Object tests main file+Copyright (C) 2005 John Goerzen <jgoerzen@complete.org>++This program is free software; you can redistribute it and/or modify+it under the terms of the GNU General Public License as published by+the Free Software Foundation; either version 2 of the License, or+(at your option) any later version.++This program is distributed in the hope that it will be useful,+but WITHOUT ANY WARRANTY; without even the implied warranty of+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+GNU General Public License for more details.++You should have received a copy of the GNU General Public License+along with this program; if not, write to the Free Software+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+-}++module Objectstest(tests) where++import Testutil ( testBigInt+ , testBigDouble+ )++import Test.HUnit+import Python.Objects+import Foreign.C.Types+import Python.Types+import Control.Monad ((>=>))+import Data.List+import Python.Interpreter++f :: (ToPyObject a, Eq b, Show b) => String -> a -> (PyObject -> IO b) -> b -> Test+f msg inp code expression = TestLabel msg $ TestCase $ do+ pyo <- toPyObject inp+ r <- code pyo+ expression @=? r+++testBase :: [Test]+testBase =+ [ f "showPyObject" (5::CInt) showPyObject "<type 'int'>: 5"+ ]++testLists :: [Test]+testLists =+ [ f "empty" ([]::[CInt]) fromPyObject ([]::[CInt])+ , f "repr empty" ([]::[CInt]) reprOf "[]"+ , f "some cints" [1::CInt, 2, 3] fromPyObject [1::CInt, 2, 3]+ , f "some cints repr" [1::CInt, 2, 3] reprOf "[1, 2, 3]"+ , f "strings" ["foo", "bar"] fromPyObject ["foo", "bar"]+ , f "strings repr" ["foo", "bar"] reprOf "['foo', 'bar']"+ ]++testAl :: [Test]+testAl =+ [ f "emptypyo" ([]::[(PyObject, PyObject)]) fromPyObject+ ([]::[(PyObject, PyObject)])+ , f "cint to cint" [(1::CInt, 2::CInt), (3, 4)]+ (fromPyObject >=> (return . sort))+ [(1::CInt, 2::CInt), (3, 4)]+ ]++testFunctions :: [Test]+testFunctions =+ [ f "typestr" (5::CInt) (typeOf >=> strOf) "<type 'int'>"+ , f "repr" ["foo", "bar"] reprOf "['foo', 'bar']"+ ]++testStrings :: [Test]+testStrings =+ [ f "empty" ([]::String) fromPyObject ([]::String)+ , f "basic" "foo" fromPyObject "foo"+ , f "dquotes" "foo\"" fromPyObject "foo\""+ , f "squotes" "foo'" fromPyObject "foo'"+ , f "embedded null" "foo\0bar" fromPyObject "foo\0bar"+ , f "null only" "\0" fromPyObject "\0"+ , f "quotes" "\"'\"" fromPyObject "\"'\""+ ]++testInts :: [Test]+testInts =+ [ f "0L" (0::CLong) fromPyObject (0::CLong)+ , f "-5L" (-5::CLong) fromPyObject (-5::CLong)+ , f "5L" (5::CLong) fromPyObject (5::CLong)+ , f "max long" (maxBound::CLong) fromPyObject (maxBound::CLong)+ , f "min long" (minBound::CLong) fromPyObject (minBound::CLong)+ , f "0i" (0::CInt) fromPyObject (0::CInt)+ , f "-5i" (-5::CInt) fromPyObject (-5::CInt)+ , f "5i" (5::CInt) fromPyObject (5::CInt)+ , f "min int" (minBound::CInt) fromPyObject (minBound::CInt)+ , f "max int" (maxBound::CInt) fromPyObject (maxBound::CInt)+ , f "long/int" (12345::CLong) fromPyObject (12345::CInt)+ , f "int/long" (12354::CInt) fromPyObject (12354::CInt)+ , f "repr max" (maxBound::CLong) reprOf (show (maxBound::CLong))+ , f "str min" (minBound::CLong) strOf (show (minBound::CLong))+ ]++testLongs :: [Test]+testLongs =+ [ f "0" (0::Integer) fromPyObject (0::Integer)+ , f "-5" (-5::Integer) fromPyObject (-5::Integer)+ , f "5" (5::Integer) fromPyObject (5::Integer)+ , f "2^384" testBigInt fromPyObject testBigInt+ , f "2^384*-1" (( testBigInt * (-1))::Integer) fromPyObject ((testBigInt * (-1))::Integer)+ , f "str 2^384" testBigInt strOf (show testBigInt)+ ]++testDoubles :: [Test]+testDoubles =+ [ f "0" (0::CDouble) fromPyObject (0::CDouble)+ , f "-5" (-5::CDouble) fromPyObject (-5::CDouble)+ , f "5.1234" (5.1234::CDouble) fromPyObject (5.1234::CDouble)+ , f "str 5.1234" (5.1234::CDouble) strOf "5.1234"+ , f "2^384" testBigDouble fromPyObject testBigDouble+ , f "2^384*-1" (testBigDouble * (-1)) fromPyObject (testBigDouble * (-1))+ , f "1/(2^384)" (1 / testBigDouble) fromPyObject (1 / testBigDouble)+ ]++testDicts :: [Test]+testDicts =+ [ f "empty" ([]::[(String, String)]) fromPyObject ([]::[(String, String)])+ , f "one s" [("foo", "bar")] fromPyObject [("foo", "bar")]+ , f "mult s" [("foo", "bar"), ("quux", "baz")]+ (fromPyObject >=> (return . sort))+ [("foo", "bar"), ("quux", "baz")]+ , f "s2i" [("foo", 1::CLong), ("quux", 2)]+ (fromPyObject >=> (return.sort))+ [("foo", 1::CLong), ("quux", 2)]+ ]++testCalls :: [Test]+testCalls =+ [ TestCase $ do+ func <- pyRun_String "repr" Py_eval_input []+ r <- pyObject_CallHs func [5::Integer] ([]::[(String, String)])+ "5L" @=? r+ ]++testDir :: [Test]+testDir =+ [ TestCase $ do+ dv <- toPyObject ([]::String) >>= dirPyObject+ assertBool "replace" $ "replace" `elem` dv+ assertBool "rindex" $ "rindex" `elem` dv+ ]++testAttr :: [Test]+testAttr =+ [ TestCase $ do+ pyImport "md5"+ md5 <- pyRun_String "md5.md5()" Py_eval_input []+ fupdate <- getattr md5 "update"+ fhexdigest <- getattr md5 "hexdigest"+ pyObject_RunHs fupdate ["hi"] noKwParms+ pyObject_RunHs fupdate ["there"] noKwParms+ r <- pyObject_CallHs fhexdigest noParms noKwParms+ "a8b767bb9cf0938dc7f40603f33987e5" @=? r+ , TestCase $ do+ pyImport "md5"+ md5 <- pyRun_String "md5.md5()" Py_eval_input []+ runMethodHs md5 "update" ["hi"] noKwParms+ runMethodHs md5 "update" ["there"] noKwParms+ r <- callMethodHs md5 "hexdigest" noParms noKwParms+ "a8b767bb9cf0938dc7f40603f33987e5" @=? r++ ]++tests :: Test+tests = TestList [ TestLabel "base" (TestList testBase)+ , TestLabel "lists/tuples" (TestList testLists)+ , TestLabel "al" (TestList testAl)+ , TestLabel "functions" (TestList testFunctions)+ , TestLabel "strings" (TestList testStrings)+ , TestLabel "ints" (TestList testInts)+ , TestLabel "longs" (TestList testLongs)+ , TestLabel "doubles" (TestList testDoubles)+ , TestLabel "dir" (TestList testDir)+ , TestLabel "call" (TestList testCalls)+ , TestLabel "attr" (TestList testAttr)+ , TestLabel "dict" (TestList testDicts)+ ]
+ originaltests/Tests.hs view
@@ -0,0 +1,44 @@+{- arch-tag: Tests main file+Copyright (C) 2004 - 2005 John Goerzen <jgoerzen@complete.org>++This program is free software; you can redistribute it and/or modify+it under the terms of the GNU General Public License as published by+the Free Software Foundation; either version 2 of the License, or+(at your option) any later version.++This program is distributed in the hope that it will be useful,+but WITHOUT ANY WARRANTY; without even the implied warranty of+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+GNU General Public License for more details.++You should have received a copy of the GNU General Public License+along with this program; if not, write to the Free Software+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+-}++module Tests(tests) where+import Test.HUnit+import qualified Interpretertest+import qualified Objectstest+import qualified Exceptionstest+import qualified GZiptest+import qualified BZip2test+import qualified Dicttest+import qualified AnyDBMPytest++test1 :: Test+test1 = TestCase ("x" @=? "x")++tests :: Test+tests = TestList [ TestLabel "test1" test1+ , TestLabel "objects" Objectstest.tests+ , TestLabel "interpreter" Interpretertest.tests+ , TestLabel "exceptions" Exceptionstest.tests+ , TestLabel "AnyDBM/Dict" Dicttest.tests+ , TestLabel "AnyDBM/dbm" AnyDBMPytest.tests+ , TestLabel "bzip2" BZip2test.tests+ , TestLabel "gzip" GZiptest.tests+ ]+++
+ originaltests/Testutil.hs view
@@ -0,0 +1,55 @@+{- arch-tag: Test utilities+Copyright (C) 2004 John Goerzen <jgoerzen@complete.org>++This program is free software; you can redistribute it and/or modify+it under the terms of the GNU General Public License as published by+the Free Software Foundation; either version 2 of the License, or+(at your option) any later version.++This program is distributed in the hope that it will be useful,+but WITHOUT ANY WARRANTY; without even the implied warranty of+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+GNU General Public License for more details.++You should have received a copy of the GNU General Public License+along with this program; if not, write to the Free Software+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+-}++module Testutil ( assertRaises+ , mapassertEqual+ , testBigInt+ , testMedInt+ , testBigDouble+ ) where++import Test.HUnit+import Control.Monad (unless)+import qualified Control.Exception+import Foreign.C.Types (CDouble)++testBigInt :: Integer+testBigInt = (2 :: Integer) ^ (348 :: Integer)++-- Test that a function wont overflow+testMedInt :: Integer+testMedInt = (2 :: Integer) ^ (32 :: Integer)++testBigDouble :: CDouble+testBigDouble= 2.0 ^^ (348 :: Integer)++assertRaises :: (Show a, Control.Exception.Exception b, Eq b) => String -> b -> IO a -> IO ()+assertRaises msg selector action =+ let thetest e = unless (e == selector) $+ assertFailure $ msg ++ "\nReceived unexpected exception: "+ ++ show e ++ "\ninstead of exception: " ++ show selector+ in do+ r <- Control.Exception.try action+ case r of+ Left e -> thetest e+ Right _ -> assertFailure $ msg ++ "\nReceived no exception, but was expecting exception: " ++ show selector++mapassertEqual :: (Show b, Eq b) => String -> (a -> b) -> [(a, b)] -> [Test]+mapassertEqual _ _ [] = []+mapassertEqual descrip func ((inp,result):xs) =+ (TestCase $ assertEqual descrip result (func inp)) : mapassertEqual descrip func xs
+ src/MissingPy/AnyDBM.hs view
@@ -0,0 +1,98 @@+{-# LANGUAGE OverlappingInstances#-}++{- arch-tag: Interface to anydbm.py+Copyright (C) 2005 John Goerzen <jgoerzen@complete.org>++This program is free software; you can redistribute it and/or modify+it under the terms of the GNU General Public License as published by+the Free Software Foundation; either version 2 of the License, or+(at your option) any later version.++This program is distributed in the hope that it will be useful,+but WITHOUT ANY WARRANTY; without even the implied warranty of+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+GNU General Public License for more details.++You should have received a copy of the GNU General Public License+along with this program; if not, write to the Free Software+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+-}++{- |+ Module : MissingPy.AnyDBM+ Copyright : Copyright (C) 2005 John Goerzen+ License : GNU GPL, version 2 or above++ Maintainer : John Goerzen,+ Maintainer : jgoerzen\@complete.org+ Stability : provisional+ Portability: portable++This module interfaces "Database.AnyDBM" to Python's anydbm.py.+Implementations for specific Python *dbm modules are also available.++See and import "Database.AnyDBM" to use these features.++Written by John Goerzen, jgoerzen\@complete.org+-}++module MissingPy.AnyDBM(PyDBMOpenFlags(..),+ openAnyDBM,+ openSpecificDBM+ )+where+++import Python.Objects.Dict+import Python.Interpreter+import Python.Utils+import Python.Exceptions+import Python.Objects+import Database.AnyDBM++{- | Flags used to open a dbm-type database -}+data PyDBMOpenFlags = + DBM_ReadOnly -- ^ Open an /existing/ database for read only+ | DBM_ReadWrite -- ^ Open an /existing/ database for reading and writing+ | DBM_ReadWriteCreate -- ^ Open a database for reading and writing, creating if it doesn't exist+ | DBM_ReadWriteNew -- ^ Open a database, creating it anew each time (deleting any existing data)+flag2str :: PyDBMOpenFlags -> String+flag2str DBM_ReadOnly = "r"+flag2str DBM_ReadWrite = "w"+flag2str DBM_ReadWriteCreate = "c"+flag2str DBM_ReadWriteNew = "n"++{- | Opens a persistent storage database using the \"best\" storage mechanism+available to Python on this system. This will usually be one of the *dbm+services, though in rare circumstances, could be \"dumbdbm\", which is+only marginally better than "Database.AnyDBM.StringDBM".+-}+openAnyDBM :: FilePath -> PyDBMOpenFlags -> IO PyDict+openAnyDBM = openSpecificDBM "anydbm"++{- | Open a database using a specific module given by the first parameter. The+module supported are:++* dbhash++* dbm++* dumbdbm++* gdbm++SECURITY NOTE: the string is not validated before being passed to Python.+Do not pass an arbitrary value to this function.+-}+openSpecificDBM :: String -- ^ Python module name to use+ -> FilePath -- ^ Path to database files+ -> PyDBMOpenFlags -- ^ Flags to use when opening+ -> IO PyDict -- ^ Result+openSpecificDBM mod fp flag =+ let flagstr = flag2str flag+ in handlePy exc2ioerror $ + do pyImport mod+ fileobj <- toPyObject fp+ flagobj <- toPyObject flagstr+ obj <- callByName (mod ++ ".open") [fileobj, flagobj] []+ return $ mkPyDict obj
+ src/MissingPy/FileArchive/BZip2.hs view
@@ -0,0 +1,71 @@+{-# LANGUAGE OverlappingInstances#-}++{- arch-tag: BZip2 files+Copyright (C) 2005 John Goerzen <jgoerzen@complete.org>++This program is free software; you can redistribute it and/or modify+it under the terms of the GNU General Public License as published by+the Free Software Foundation; either version 2 of the License, or+(at your option) any later version.++This program is distributed in the hope that it will be useful,+but WITHOUT ANY WARRANTY; without even the implied warranty of+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+GNU General Public License for more details.++You should have received a copy of the GNU General Public License+along with this program; if not, write to the Free Software+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+-}++{- |+ Module : MissingPy.FileArchive.BZip2+ Copyright : Copyright (C) 2005 John Goerzen+ License : GNU GPL, version 2 or above++ Maintainer : John Goerzen,+ Maintainer : jgoerzen\@complete.org+ Stability : provisional+ Portability: portable++Support for BZip2 files++Written by John Goerzen, jgoerzen\@complete.org+-}++module MissingPy.FileArchive.BZip2 (openBz2)+where++import Python.Types+import Python.Utils+import Python.Objects+import Python.Interpreter+import System.IO+import System.IO.Error+import Python.Exceptions+import System.IO.HVIO+import Foreign.C.Types+import Python.Objects.File++{- |Open a BZip2 file. The compression level should be from 1+(least compression) to 9 (most compression). This is ignored when the file+is opened read-only.++Once opened, the functions defined in "System.IO.HVIO" can be used+to work with it.++BZip2 supports only ReadMode and WriteMode for the IOMode. -}+openBz2 :: FilePath -- ^ File to open+ -> IOMode -- ^ Mode to open with+ -> Int -- ^ Compression Level+ -> IO PyFile -- ^ Resulting handle+openBz2 _ ReadWriteMode _ = fail "BZip2 doesn't support ReadWriteMode"+openBz2 _ AppendMode _ = fail "BZip2 doesn't support AppendMode"+openBz2 fp mode level =+ do ofp <- toPyObject fp+ omode <- toPyObject (openModeConv mode)+ obuffering <- toPyObject (0::CLong)+ ocl <- toPyObject ((fromIntegral level)::CLong)+ pyImport "bz2"+ obj <- callByName "bz2.BZ2File" [ofp, omode, obuffering, ocl] []+ return $ mkPyFile obj
+ src/MissingPy/FileArchive/GZip.hs view
@@ -0,0 +1,68 @@+{-# LANGUAGE OverlappingInstances#-}++{- arch-tag: GZip files+Copyright (C) 2005 John Goerzen <jgoerzen@complete.org>++This program is free software; you can redistribute it and/or modify+it under the terms of the GNU General Public License as published by+the Free Software Foundation; either version 2 of the License, or+(at your option) any later version.++This program is distributed in the hope that it will be useful,+but WITHOUT ANY WARRANTY; without even the implied warranty of+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+GNU General Public License for more details.++You should have received a copy of the GNU General Public License+along with this program; if not, write to the Free Software+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+-}++{- |+ Module : MissingPy.FileArchive.GZip+ Copyright : Copyright (C) 2005 John Goerzen+ License : GNU GPL, version 2 or above++ Maintainer : John Goerzen,+ Maintainer : jgoerzen\@complete.org+ Stability : provisional+ Portability: portable++Support for GZip files++Written by John Goerzen, jgoerzen\@complete.org+-}++module MissingPy.FileArchive.GZip (openGz+ )+where+++import Python.Types+import Python.Utils+import Python.Objects+import Python.Interpreter+import System.IO+import System.IO.Error+import Python.Exceptions+import System.IO.HVIO+import Foreign.C.Types+import Python.Objects.File++{- |Open a GZip file. The compression level should be from 1+(least compression) to 9 (most compression). This is ignored when the+file is opened read-only.++Once opened, the functions defined in 'System.IO.HVIO' can be used to +work with it. -}+openGz :: FilePath -- ^ File to open+ -> IOMode -- ^ Mode to open with+ -> Int -- ^ Compression Level+ -> IO PyFile -- ^ Resulting handle+openGz fp mode level =+ do ofp <- toPyObject fp+ omode <- toPyObject (openModeConv mode)+ ocl <- toPyObject ((fromIntegral level)::CLong)+ pyImport "gzip"+ obj <- callByName "gzip.open" [ofp, omode, ocl] []+ return $ mkPyFile obj
+ src/Python/Exceptions.hs view
@@ -0,0 +1,111 @@+{- arch-tag: Python low-level exception handling+Copyright (C) 2005 John Goerzen <jgoerzen@complete.org>++This program is free software; you can redistribute it and/or modify+it under the terms of the GNU General Public License as published by+the Free Software Foundation; either version 2 of the License, or+(at your option) any later version.++This program is distributed in the hope that it will be useful,+but WITHOUT ANY WARRANTY; without even the implied warranty of+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+GNU General Public License for more details.++You should have received a copy of the GNU General Public License+along with this program; if not, write to the Free Software+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+-}++{- |+ Module : Python.Exceptions+ Copyright : Copyright (C) 2005 John Goerzen+ License : GNU GPL, version 2 or above++ Maintainer : John Goerzen,+ Maintainer : jgoerzen\@complete.org+ Stability : provisional+ Portability: portable++Python low-level exception handling++Written by John Goerzen, jgoerzen\@complete.org+-}++module Python.Exceptions (-- * Types+ PyException(..),+ -- * General Catching+ catchPy,+ handlePy,+ -- * Catching of specific Python exceptions+ catchSpecificPy,+ -- * Exception Object Operations+ formatException,+ doesExceptionMatch,+ -- * Re-Raising Exceptions+ exc2ioerror+ )+where++import Python.Utils (withPyObject, checkCInt)+import Python.Objects (strOf)+import Python.Types ( excType+ , excValue+ , excFormatted+ , PyObject+ , PyException+ )+import Data.Dynamic (fromDynamic)+import Python.ForeignImports (pyErr_GivenExceptionMatches)+import Control.Exception (throw, catch, Exception)++{- | Execute the given IO action.++If it raises a 'PyException', then execute the supplied handler and return+its return value. Otherwise, process as normal. -}+catchPy :: IO a -> (PyException -> IO a) -> IO a+catchPy = Control.Exception.catch++{- | Like 'catchPy', with the order of arguments reversed. -}+handlePy :: (PyException -> IO a) -> IO a -> IO a+handlePy = flip catchPy++{- | Like catchPy, but catches only instances of the Python class given+(see 'doesExceptionMatch'). -}+catchSpecificPy :: PyObject -> IO a -> (PyException -> IO a) -> IO a+catchSpecificPy pyo action handlerfunc =+ let handler e = do d <- doesExceptionMatch e pyo+ if d+ then handlerfunc e+ else throw e+ in catchPy action handler++{- | When an exception is thrown, it is not immediately formatted.++This call will format it. -}+formatException :: PyException -> IO PyException+formatException e =+{-+ do fmt <- callByName "traceback.format_exception" + [excType e, excValue e, excTraceBack e] [] >>= fromPyObject+-}+ do ename <- strOf (excType e)+ evalue <- strOf (excValue e)+ let fmt = ename ++ ": " ++ evalue+ return $ e {excFormatted = fmt}++{- | Returns true if the passed 'PyException' matches the given Python+exception class or one of its subclasses. Standard Python exception classes+are given in 'Python.Exceptions.ExcTypes'. -}+doesExceptionMatch :: PyException -> PyObject -> IO Bool+doesExceptionMatch e pyo =+ withPyObject (excType e) (\ctyp ->+ withPyObject pyo (\cpo ->+ do r <- pyErr_GivenExceptionMatches ctyp cpo >>= checkCInt+ return $ not $ r == 0))++{- | A handler for use in 'catchPy' or 'handlePy'. Grabs the Python exception,+describes it, and raises the description in the IO monad with 'fail'. -}+exc2ioerror :: PyException -> IO a+exc2ioerror e = do e2 <- formatException e+ fail $ "Python " ++ show e2+
+ src/Python/Exceptions/ExcTypes.hsc view
@@ -0,0 +1,273 @@+{- NOTICE -- THIS FILE IS AUTO-GENERATED -- DO NOT EDIT+MissingPy: Haskell Python Interface libraries+Copyright (C) 2004 - 2005 John Goerzen <jgoerzen@complete.org>++All code is under the following license unless otherwise noted:+ This program is free software; you can redistribute it and/or modify+ it under the terms of the GNU General Public License as published by+ the Free Software Foundation; either version 2 of the License, or+ (at your option) any later version.++ This program is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU General Public License for more details.++ You should have received a copy of the GNU General Public License+ along with this program; if not, write to the Free Software+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA++The GNU General Public License is available in the file COPYING in the source+distribution. Debian GNU/Linux users may find this in+/usr/share/common-licenses/GPL-2.++If the GPL is unacceptable for your uses, please e-mail me; alternative+terms can be negotiated for your project.+-}+{- |+ Module : Python.Exceptions.ExcTypes+ Copyright : Copyright (C) 2005 John Goerzen+ License : GNU GPL, version 2 or above++ Maintainer : John Goerzen,+ Maintainer : jgoerzen\@complete.org+ Stability : provisional+ Portability: portable++Python low-level exception definitions++These are definitions of the built-in Python exception objects. You can+use them with 'MissingPy.Python.Exceptions.doesExceptionMatch' and+'MissingPy.Python.Exceptions.catchSpecificPy'.++The meanings of these exceptions can be found at+<http://www.python.org/doc/current/lib/module-exceptions.html>.++Please note that windowsError is available only on Microsoft platforms.++Written by John Goerzen, jgoerzen\@complete.org+-}+#include <Python.h>+module Python.Exceptions.ExcTypes+(++arithmeticError,+assertionError,+attributeError,+pyEOFError,+environmentError,+pyMainException,+floatingPointError,+pyIOError,+importError,+indexError,+keyError,+keyboardInterrupt,+lookupError,+memoryError,+nameError,+notImplementedError,+pyOSError,+overflowError,+referenceError,+runtimeError,+standardError,+syntaxError,+systemError,+systemExit,+typeError,+valueError,+zeroDivisionError+#ifdef MS_WINDOWS+,windowsError+#endif++)+where+import Python.Types+import Python.Objects+import System.IO.Unsafe+import Python.Utils+import Foreign hiding (unsafePerformIO)+exctypes_internal_e :: IO (Ptr CPyObject) -> IO PyObject+exctypes_internal_e f = do p <- f+ fp <- newForeignPtr_ p+ return $ PyObject fp++{-# NOINLINE arithmeticError #-}+arithmeticError = unsafePerformIO $ exctypes_internal_e cArithmeticError++{-# NOINLINE assertionError #-}+assertionError = unsafePerformIO $ exctypes_internal_e cAssertionError++{-# NOINLINE attributeError #-}+attributeError = unsafePerformIO $ exctypes_internal_e cAttributeError++{-# NOINLINE pyEOFError #-}+pyEOFError = unsafePerformIO $ exctypes_internal_e cEOFError++{-# NOINLINE environmentError #-}+environmentError = unsafePerformIO $ exctypes_internal_e cEnvironmentError++-- | This is Exception in Python; renamed to avoid naming conflicts here.+{-# NOINLINE pyMainException #-}+pyMainException = unsafePerformIO $ exctypes_internal_e cException++{-# NOINLINE floatingPointError #-}+floatingPointError = unsafePerformIO $ exctypes_internal_e cFloatingPointError++{-# NOINLINE pyIOError #-}+pyIOError = unsafePerformIO $ exctypes_internal_e cIOError++{-# NOINLINE importError #-}+importError = unsafePerformIO $ exctypes_internal_e cImportError++{-# NOINLINE indexError #-}+indexError = unsafePerformIO $ exctypes_internal_e cIndexError++{-# NOINLINE keyError #-}+keyError = unsafePerformIO $ exctypes_internal_e cKeyError++{-# NOINLINE keyboardInterrupt #-}+keyboardInterrupt = unsafePerformIO $ exctypes_internal_e cKeyboardInterrupt++{-# NOINLINE lookupError #-}+lookupError = unsafePerformIO $ exctypes_internal_e cLookupError++{-# NOINLINE memoryError #-}+memoryError = unsafePerformIO $ exctypes_internal_e cMemoryError++{-# NOINLINE nameError #-}+nameError = unsafePerformIO $ exctypes_internal_e cNameError++{-# NOINLINE notImplementedError #-}+notImplementedError = unsafePerformIO $ exctypes_internal_e cNotImplementedError++{-# NOINLINE pyOSError #-}+pyOSError = unsafePerformIO $ exctypes_internal_e cOSError++{-# NOINLINE overflowError #-}+overflowError = unsafePerformIO $ exctypes_internal_e cOverflowError++{-# NOINLINE referenceError #-}+referenceError = unsafePerformIO $ exctypes_internal_e cReferenceError++{-# NOINLINE runtimeError #-}+runtimeError = unsafePerformIO $ exctypes_internal_e cRuntimeError++{-# NOINLINE standardError #-}+standardError = unsafePerformIO $ exctypes_internal_e cStandardError++{-# NOINLINE syntaxError #-}+syntaxError = unsafePerformIO $ exctypes_internal_e cSyntaxError++{-# NOINLINE systemError #-}+systemError = unsafePerformIO $ exctypes_internal_e cSystemError++{-# NOINLINE systemExit #-}+systemExit = unsafePerformIO $ exctypes_internal_e cSystemExit++{-# NOINLINE typeError #-}+typeError = unsafePerformIO $ exctypes_internal_e cTypeError++{-# NOINLINE valueError #-}+valueError = unsafePerformIO $ exctypes_internal_e cValueError++{-# NOINLINE zeroDivisionError #-}+zeroDivisionError = unsafePerformIO $ exctypes_internal_e cZeroDivisionError+++#ifdef MS_WINDOWS+{-# NOINLINE windowsError #-}+windowsError = unsafePerformIO $ exctypes_internal_e cWindowsError++#endif++foreign import ccall unsafe "excglue.h hspy_ArithmeticError"+ cArithmeticError :: IO (Ptr CPyObject)++foreign import ccall unsafe "excglue.h hspy_AssertionError"+ cAssertionError :: IO (Ptr CPyObject)++foreign import ccall unsafe "excglue.h hspy_AttributeError"+ cAttributeError :: IO (Ptr CPyObject)++foreign import ccall unsafe "excglue.h hspy_EOFError"+ cEOFError :: IO (Ptr CPyObject)++foreign import ccall unsafe "excglue.h hspy_EnvironmentError"+ cEnvironmentError :: IO (Ptr CPyObject)++foreign import ccall unsafe "excglue.h hspy_Exception"+ cException :: IO (Ptr CPyObject)++foreign import ccall unsafe "excglue.h hspy_FloatingPointError"+ cFloatingPointError :: IO (Ptr CPyObject)++foreign import ccall unsafe "excglue.h hspy_IOError"+ cIOError :: IO (Ptr CPyObject)++foreign import ccall unsafe "excglue.h hspy_ImportError"+ cImportError :: IO (Ptr CPyObject)++foreign import ccall unsafe "excglue.h hspy_IndexError"+ cIndexError :: IO (Ptr CPyObject)++foreign import ccall unsafe "excglue.h hspy_KeyError"+ cKeyError :: IO (Ptr CPyObject)++foreign import ccall unsafe "excglue.h hspy_KeyboardInterrupt"+ cKeyboardInterrupt :: IO (Ptr CPyObject)++foreign import ccall unsafe "excglue.h hspy_LookupError"+ cLookupError :: IO (Ptr CPyObject)++foreign import ccall unsafe "excglue.h hspy_MemoryError"+ cMemoryError :: IO (Ptr CPyObject)++foreign import ccall unsafe "excglue.h hspy_NameError"+ cNameError :: IO (Ptr CPyObject)++foreign import ccall unsafe "excglue.h hspy_NotImplementedError"+ cNotImplementedError :: IO (Ptr CPyObject)++foreign import ccall unsafe "excglue.h hspy_OSError"+ cOSError :: IO (Ptr CPyObject)++foreign import ccall unsafe "excglue.h hspy_OverflowError"+ cOverflowError :: IO (Ptr CPyObject)++foreign import ccall unsafe "excglue.h hspy_ReferenceError"+ cReferenceError :: IO (Ptr CPyObject)++foreign import ccall unsafe "excglue.h hspy_RuntimeError"+ cRuntimeError :: IO (Ptr CPyObject)++foreign import ccall unsafe "excglue.h hspy_StandardError"+ cStandardError :: IO (Ptr CPyObject)++foreign import ccall unsafe "excglue.h hspy_SyntaxError"+ cSyntaxError :: IO (Ptr CPyObject)++foreign import ccall unsafe "excglue.h hspy_SystemError"+ cSystemError :: IO (Ptr CPyObject)++foreign import ccall unsafe "excglue.h hspy_SystemExit"+ cSystemExit :: IO (Ptr CPyObject)++foreign import ccall unsafe "excglue.h hspy_TypeError"+ cTypeError :: IO (Ptr CPyObject)++foreign import ccall unsafe "excglue.h hspy_ValueError"+ cValueError :: IO (Ptr CPyObject)++foreign import ccall unsafe "excglue.h hspy_ZeroDivisionError"+ cZeroDivisionError :: IO (Ptr CPyObject)+++#ifdef MS_WINDOWS+foreign import ccall unsafe "excglue.h hspy_WindowsError"+ cWindowsError :: IO (Ptr CPyObject)++#endif+
+ src/Python/ForeignImports.hsc view
@@ -0,0 +1,215 @@+{- arch-tag: Python foreign imports+Copyright (C) 2005 John Goerzen <jgoerzen@complete.org>++This program is free software; you can redistribute it and/or modify+it under the terms of the GNU General Public License as published by+the Free Software Foundation; either version 2 of the License, or+(at your option) any later version.++This program is distributed in the hope that it will be useful,+but WITHOUT ANY WARRANTY; without even the implied warranty of+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+GNU General Public License for more details.++You should have received a copy of the GNU General Public License+along with this program; if not, write to the Free Software+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+-}++{- |+ Module : Python.ForeignImports+ Copyright : Copyright (C) 2005 John Goerzen+ License : GNU GPL, version 2 or above++ Maintainer : John Goerzen,+ Maintainer : jgoerzen\@complete.org+ Stability : provisional+ Portability: portable++Low-level C interface. Handles foreign imports for everything but +"Python.Exceptions.ExcTypes".++This is not to be exposed outside this library.++Written by John Goerzen, jgoerzen\@complete.org+-}++module Python.ForeignImports where+import Foreign.C.Types+import Foreign+import Python.Types+import Foreign.C.String+import System.IO++#include "glue.h"++sf2c :: StartFrom -> CInt+sf2c Py_eval_input = #const Py_eval_input+sf2c Py_file_input = #const Py_file_input+sf2c Py_single_input = #const Py_single_input++foreign import ccall unsafe "glue.h PyErr_GivenExceptionMatches"+ pyErr_GivenExceptionMatches :: Ptr CPyObject -> Ptr CPyObject -> IO CInt++foreign import ccall unsafe "glue.h Py_Initialize"+ cpy_initialize :: IO ()++foreign import ccall unsafe "glue.h PyRun_SimpleString"+ cpyRun_SimpleString :: CString -> IO CInt++foreign import ccall unsafe "glue.h PyRun_String"+ cpyRun_String :: CString -> CInt -> Ptr CPyObject -> Ptr CPyObject -> IO (Ptr CPyObject)++#ifdef PYTHON_PRE_2_5+foreign import ccall unsafe "glue.h PyImport_ImportModuleEx"+ cpyImport_ImportModuleEx :: CString -> Ptr CPyObject -> Ptr CPyObject -> Ptr CPyObject -> IO (Ptr CPyObject)+#else+foreign import ccall unsafe "glue.h PyImport_ImportModuleLevel"+ cpyImport_ImportModuleLevel :: CString -> Ptr CPyObject -> Ptr CPyObject -> Ptr CPyObject -> CInt -> IO (Ptr CPyObject)++cpyImport_ImportModuleEx :: CString -> Ptr CPyObject -> Ptr CPyObject -> Ptr CPyObject -> IO (Ptr CPyObject)+cpyImport_ImportModuleEx n g l f = cpyImport_ImportModuleLevel n g l f (fromIntegral (-1))+#endif++foreign import ccall unsafe "glue.h PyDict_SetItemString"+ pyDict_SetItemString :: Ptr CPyObject -> CString -> Ptr CPyObject -> IO CInt++foreign import ccall unsafe "glue.h PyImport_GetModuleDict"+ pyImport_GetModuleDict :: IO (Ptr CPyObject)+++foreign import ccall unsafe "glue.h PyString_FromStringAndSize"+ pyString_FromStringAndSize :: CString -> CInt -> IO (Ptr CPyObject)++foreign import ccall unsafe "glue.h PyInt_FromLong"+ pyInt_FromLong :: CLong -> IO (Ptr CPyObject)++foreign import ccall unsafe "glue.h PyInt_AsLong"+ pyInt_AsLong :: Ptr CPyObject -> IO CLong++foreign import ccall unsafe "glue.h PyLong_FromString"+ pyLong_FromString :: CString -> Ptr CString -> CInt -> IO (Ptr CPyObject)++foreign import ccall unsafe "glue.h PyList_New"+ pyList_New :: CInt -> IO (Ptr CPyObject)++foreign import ccall unsafe "glue.h PyList_Append"+ pyList_Append :: Ptr CPyObject -> Ptr CPyObject -> IO CInt++foreign import ccall unsafe "glue.h PyDict_New"+ pyDict_New :: IO (Ptr CPyObject)++foreign import ccall unsafe "glue.h PyObject_SetItem"+ pyObject_SetItem :: Ptr CPyObject -> Ptr CPyObject -> Ptr CPyObject -> IO CInt++foreign import ccall unsafe "glue.h PyObject_DelItem"+ pyObject_DelItem :: Ptr CPyObject -> Ptr CPyObject -> IO CInt++foreign import ccall unsafe "glue.h PyObject_GetItem"+ pyObject_GetItem :: Ptr CPyObject -> Ptr CPyObject -> IO (Ptr CPyObject)+++foreign import ccall unsafe "glue.h PyObject_Repr"+ pyObject_Repr :: Ptr CPyObject -> IO (Ptr CPyObject)++foreign import ccall unsafe "glue.h PyObject_Type"+ pyObject_Type :: Ptr CPyObject -> IO (Ptr CPyObject)++foreign import ccall unsafe "glue.h PyString_AsStringAndSize"+ pyString_AsStringAndSize :: Ptr CPyObject -> Ptr CString -> Ptr CInt -> IO ()++foreign import ccall unsafe "glue.h hspy_list_check"+ pyList_Check :: Ptr CPyObject -> IO CInt++foreign import ccall unsafe "glue.h hspy_tuple_check"+ pyTuple_Check :: Ptr CPyObject -> IO CInt++foreign import ccall unsafe "glue.h PyList_Size"+ pyList_Size :: Ptr CPyObject -> IO CInt++foreign import ccall unsafe "glue.h PyTuple_Size"+ pyTuple_Size :: Ptr CPyObject -> IO CInt++foreign import ccall unsafe "glue.h PyList_GetItem"+ pyList_GetItem :: Ptr CPyObject -> CInt -> IO (Ptr CPyObject)++foreign import ccall unsafe "glue.h PyTuple_GetItem"+ pyTuple_GetItem :: Ptr CPyObject -> CInt -> IO (Ptr CPyObject)++foreign import ccall unsafe "glue.h glue_PyMapping_Items"+ pyMapping_Items :: Ptr CPyObject -> IO (Ptr CPyObject)++foreign import ccall unsafe "glue.h PyFloat_FromDouble"+ pyFloat_FromDouble :: CDouble -> IO (Ptr CPyObject)++foreign import ccall unsafe "glue.h PyFloat_AsDouble"+ pyFloat_AsDouble :: Ptr CPyObject -> IO CDouble++foreign import ccall unsafe "glue.h PyObject_Dir"+ pyObject_Dir :: Ptr CPyObject -> IO (Ptr CPyObject)++foreign import ccall "glue.h PyObject_Call"+ cpyObject_Call :: Ptr CPyObject -> Ptr CPyObject -> Ptr CPyObject ->+ IO (Ptr CPyObject)++foreign import ccall unsafe "glue.h glue_PyMapping_Keys"+ pyMapping_Keys :: Ptr CPyObject -> IO (Ptr CPyObject)++foreign import ccall unsafe "glue.h PyList_AsTuple"+ cpyList_AsTuple :: Ptr CPyObject -> IO (Ptr CPyObject)++foreign import ccall unsafe "glue.h PyObject_GetAttrString"+ pyObject_GetAttrString :: Ptr CPyObject -> CString -> IO (Ptr CPyObject)++foreign import ccall unsafe "glue.h PyObject_HasAttrString"+ pyObject_HasAttrString :: Ptr CPyObject -> CString -> IO CInt++foreign import ccall unsafe "glue.h PyObject_SetAttrString"+ pyObject_SetAttrString :: Ptr CPyObject -> CString -> Ptr CPyObject -> IO CInt++foreign import ccall unsafe "glue.h PyObject_Str"+ pyObject_Str :: Ptr CPyObject -> IO (Ptr CPyObject)+++foreign import ccall unsafe "glue.h PyModule_GetDict"+ cpyModule_GetDict :: Ptr CPyObject -> IO (Ptr CPyObject)++foreign import ccall "glue.h &hspy_decref"+ py_decref :: FunPtr (Ptr CPyObject -> IO ())++foreign import ccall "glue.h hspy_incref"+ py_incref :: Ptr CPyObject -> IO ()++foreign import ccall unsafe "glue.h hspy_getexc"+ hspy_getexc :: IO (Ptr (Ptr CPyObject))++foreign import ccall unsafe "glue.h PyErr_Fetch"+ pyErr_Fetch :: Ptr (Ptr CPyObject) -> Ptr (Ptr CPyObject) -> Ptr (Ptr CPyObject) -> IO ()++foreign import ccall unsafe "glue.h PyErr_NormalizeException"+ pyErr_NormalizeException :: Ptr (Ptr CPyObject) -> Ptr (Ptr CPyObject) -> Ptr (Ptr CPyObject) -> IO ()++foreign import ccall unsafe "glue.h PyErr_Clear"+ pyErr_Clear :: IO ()++foreign import ccall unsafe "glue.h PyErr_Print"+ pyErr_Print :: IO ()++foreign import ccall unsafe "glue.h PyImport_AddModule"+ cpyImport_AddModule :: CString -> IO (Ptr CPyObject)++foreign import ccall unsafe "glue.h hspy_none"+ cNone :: IO (Ptr CPyObject)+++foreign import ccall unsafe "glue.h PyEval_InitThreads"+ cpy_InitThreads :: IO ()++#ifndef PYTHON_PRE_2_3+foreign import ccall unsafe "glue.h PyGILState_Ensure"+ cpy_GILEnsure :: IO (Ptr CPyGILState)++foreign import ccall unsafe "glue.h PyGILState_Release"+ cpy_GILRelease :: Ptr CPyGILState -> IO ()+#endif+
+ src/Python/Interpreter.hs view
@@ -0,0 +1,255 @@+{-# LANGUAGE CPP, OverlappingInstances #-}++{- arch-tag: Python interpreter module+Copyright (C) 2005 John Goerzen <jgoerzen@complete.org>++This program is free software; you can redistribute it and/or modify+it under the terms of the GNU General Public License as published by+the Free Software Foundation; either version 2 of the License, or+(at your option) any later version.++This program is distributed in the hope that it will be useful,+but WITHOUT ANY WARRANTY; without even the implied warranty of+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+GNU General Public License for more details.++You should have received a copy of the GNU General Public License+along with this program; if not, write to the Free Software+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+-}++{- |+ Module : Python.Interpreter+ Copyright : Copyright (C) 2005 John Goerzen+ License : GNU GPL, version 2 or above++ Maintainer : John Goerzen,+ Maintainer : jgoerzen\@complete.org+ Stability : provisional+ Portability: portable++Interface to Python interpreter++Written by John Goerzen, jgoerzen\@complete.org+-}++module Python.Interpreter (+ py_initialize,+ -- * Intrepreting Code+ pyRun_SimpleString,+ pyRun_String,+ pyRun_StringHs,+ StartFrom(..),+ -- * Calling Code+ callByName,+ callByNameHs,+ noParms,+ noKwParms,+ -- * Imports+ pyImport,+ pyImport_ImportModule,+ pyImport_AddModule,+ pyModule_GetDict,+ -- * Threads+ py_initializeThreaded,+#ifndef PYTHON_PRE_2_3 + cpy_GILEnsure,+ cpy_GILRelease,+ withGIL,+#endif+ )+where++import Python.Utils (+ checkCInt+ , getDefaultGlobals+ , withPyObject+ , fromCPyObject+ , py_incref+ , pyModule_GetDict+ , pyImport_AddModule+ )++import Python.Objects (+ toPyObject+ , noParms+ , noKwParms+ , fromPyObject+ , pyObject_Call+ , pyObject_CallHs+ , PyObject+ , ToPyObject+ , FromPyObject+ )++import Python.Types (StartFrom(..))++import Python.ForeignImports (+ cpy_initialize+ , cpy_InitThreads+ , cpyRun_String+ , cpyRun_SimpleString+ , cpyImport_ImportModuleEx+ , sf2c+ , pyImport_GetModuleDict+ , pyDict_SetItemString+#ifndef PYTHON_PRE_2_3 + , cpy_GILEnsure+ , cpy_GILRelease+#endif+ )++import Foreign.C (withCString)+import Control.Exception (handle, finally, throwTo, SomeException)+import Control.Concurrent (rtsSupportsBoundThreads, forkOS, myThreadId)+import Control.Concurrent.MVar+import System.IO.Unsafe++{- | Initialize the Python interpreter environment.++MUST BE DONE BEFORE DOING ANYTHING ELSE! -}+py_initialize =+ if rtsSupportsBoundThreads+ then py_initializeThreaded+ else py_initialize'++py_initialize' :: IO ()+py_initialize' = do cpy_initialize+ pyImport "traceback"++{- Python use Thread Local Storage, so all calls must be made through a + - single OS thread.+ -}++py_initializeThreaded :: IO ()+py_initializeThreaded = do + forkOS $ do + cpy_InitThreads+ py_initialize'+ pyPoll+ return ()+ +pyQ :: MVar (IO ())+pyQ = unsafePerformIO newEmptyMVar++{- Poll pyQ for python actions, and execute them -}+pyPoll = do+ a <- takeMVar pyQ+ withGIL' a >> pyPoll++{- Pass python actions to dedicated python thread for execution. -} +withGIL :: IO a -> IO a+withGIL = + if rtsSupportsBoundThreads+ then withGILThreaded+ else withGIL'++withGILThreaded :: IO a -> IO a+withGILThreaded act = do+ tid <- myThreadId+ r <- newEmptyMVar+ putMVar pyQ $ handle (\e -> throwTo tid (e::SomeException)) $ putMVar r =<< act+ takeMVar r++withGIL' :: IO a -> IO a +#ifdef PYTHON_PRE_2_3+withGIL' a = a+#else+withGIL' act = do st <- cpy_GILEnsure+ finally act+ (cpy_GILRelease st)+#endif ++pyRun_SimpleString :: String -> IO ()+pyRun_SimpleString x = withCString x (\cs ->+ do cpyRun_SimpleString cs >>= checkCInt+ return ()+ )++-- | Like 'pyRun_String', but take more Haskellish args and results.+pyRun_StringHs :: (ToPyObject b, FromPyObject c) =>+ String -- ^ Command to run+ -> StartFrom -- ^ Start token+-- -> [(String, a)] -- ^ Globals (may be empty)+ -> [(String, b)] -- ^ Locals (may be empty)+ -> IO c+pyRun_StringHs cmd start locals =+ let conv (k, v) = do v1 <- toPyObject v+ return (k, v1)+ in do+ --rglobals <- mapM conv globals+ rlocals <- mapM conv locals+ pyRun_String cmd start rlocals >>= fromPyObject+ +-- | Run some code in Python.+pyRun_String :: String -- ^ Command to run+ -> StartFrom -- ^ Start Token+-- -> [(String, PyObject)] -- ^ Globals (may be empty)+ -> [(String, PyObject)] -- ^ Locals (may be empty)+ -> IO PyObject -- ^ Result+pyRun_String command startfrom xlocals =+ let cstart = sf2c startfrom+ in do dobj <- getDefaultGlobals+ rlocals <- toPyObject xlocals+ withCString command (\ccommand ->+ withPyObject dobj (\cglobals ->+ withPyObject rlocals (\clocals ->+ cpyRun_String ccommand cstart cglobals clocals >>= fromCPyObject+ )))++{- | Call a function or callable object by name. -}+callByName :: String -- ^ Object\/function name+ -> [PyObject] -- ^ List of non-keyword parameters+ -> [(String, PyObject)] -- ^ List of keyword parameters+ -> IO PyObject+callByName fname sparms kwparms =+ do func <- pyRun_String fname Py_eval_input []+ pyObject_Call func sparms kwparms++{- | Call a function or callable object by namem using Haskell args+and return values..++You can use 'noParms' and 'noKwParms' if you have no simple or+keyword parameters to pass, respectively. -}+callByNameHs :: (ToPyObject a, ToPyObject b, FromPyObject c) =>+ String -- ^ Object\/function name+ -> [a] -- ^ List of non-keyword parameters+ -> [(String, b)] -- ^ List of keyword parameters+ -> IO c+callByNameHs fname sparms kwparms =+ do func <- pyRun_String fname Py_eval_input []+ pyObject_CallHs func sparms kwparms+++{- | Import a module into the current environment in the normal sense+(similar to \"import\" in Python).+-}+pyImport :: String -> IO ()+pyImport x = + do pyImport_ImportModule x + globals <- getDefaultGlobals+ cdict <- pyImport_GetModuleDict+ py_incref cdict+ pyo2 <- fromCPyObject cdict+ dict <- fromPyObject pyo2+ case lookup x dict of+ Nothing -> return ()+ Just pyo -> do withPyObject globals (\cglobals ->+ withPyObject pyo (\cmodule ->+ withCString x (\cstr ->+ pyDict_SetItemString cglobals cstr cmodule >>= checkCInt)))+ return ()++{- | Wrapper around C PyImport_ImportModule, which imports a module.++You may want the higher-level 'pyImport' instead. -}+pyImport_ImportModule :: String -> IO PyObject+pyImport_ImportModule x =+ do globals <- getDefaultGlobals+ fromlist <- toPyObject ['*']+ cr <- withPyObject globals (\cglobals ->+ withPyObject fromlist (\cfromlist ->+ withCString x (\cstr -> + cpyImport_ImportModuleEx cstr cglobals cglobals cfromlist)))+ fromCPyObject cr+
+ src/Python/Objects.hs view
@@ -0,0 +1,506 @@+{-# LANGUAGE OverlappingInstances#-}++{- arch-tag: Python type instances+Copyright (C) 2005 John Goerzen <jgoerzen@complete.org>++This program is free software; you can redistribute it and/or modify+it under the terms of the GNU General Public License as published by+the Free Software Foundation; either version 2 of the License, or+(at your option) any later version.++This program is distributed in the hope that it will be useful,+but WITHOUT ANY WARRANTY; without even the implied warranty of+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+GNU General Public License for more details.++You should have received a copy of the GNU General Public License+along with this program; if not, write to the Free Software+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+-}++{- |+ Module : Python.Objects+ Copyright : Copyright (C) 2005 John Goerzen+ License : GNU GPL, version 2 or above++ Maintainer : John Goerzen,+ Maintainer : jgoerzen\@complete.org+ Stability : provisional+ Portability: portable++Python type instances and object utilities.++For more similar utilities, see "Python.Objects.File" and+"Python.Objects.Dict".++Written by John Goerzen, jgoerzen\@complete.org+-}++module Python.Objects (+ -- * Basic Object Types+ PyObject,+ -- * Conversions between Haskell and Python Objects+ ToPyObject(..),+ FromPyObject(..),+ -- * Information about Python Objects+ typeOf,+ strOf,+ reprOf,+ showPyObject,+ dirPyObject,+ getattr,+ hasattr,+ setattr,+ -- * Conversions between Python Objects+ pyList_AsTuple,+ -- * Calling Python Objects+ pyObject_Call,+ pyObject_CallHs,+ pyObject_RunHs,+ callMethodHs,+ runMethodHs,+ noParms,+ noKwParms+ )+where+import Python.Types+import Python.Utils+import Foreign.C.Types (+ CLong+ , CInt+ , CDouble+ )++import Foreign.C.String (+ withCString+ , peekCStringLen+ , CStringLen+ )+import Foreign.Ptr (nullPtr)+import Foreign.Storable (peek)+import Foreign.Marshal.Alloc (alloca)+import Python.ForeignImports (+ cpyList_AsTuple+ , cpyObject_Call+ , pyDict_New+ , pyFloat_AsDouble+ , pyFloat_FromDouble+ , pyInt_AsLong+ , pyInt_FromLong+ , pyList_Append+ , pyList_Check+ , pyList_GetItem+ , pyList_New+ , pyList_Size+ , pyLong_FromString+ , pyMapping_Items+ , pyObject_Dir+ , pyObject_GetAttrString+ , pyObject_HasAttrString+ , pyObject_Repr+ , pyObject_SetAttrString+ , pyObject_SetItem+ , pyObject_Str+ , pyObject_Type+ , pyString_AsStringAndSize+ , pyString_FromStringAndSize+ , pyTuple_Check+ , pyTuple_GetItem+ , pyTuple_Size+ )+++++{- | Members of this class can be converted from a Haskell type+to a Python object. -}+class ToPyObject a where+ toPyObject :: a -> IO PyObject++{- | Members of this class can be derived from a Python object. -}+class FromPyObject a where+ fromPyObject :: PyObject -> IO a++----------------------------------------------------------------------+-- Functions+----------------------------------------------------------------------+{- | Gets the type of a Python object. Same as type(x) in Python. -}+typeOf :: PyObject -> IO PyObject+typeOf x = withPyObject x (\pyo -> pyObject_Type pyo >>= fromCPyObject)+ +{- | Gets a string representation of a Python object. Same +as str(x) in Python. -}+strOf :: PyObject -> IO String+strOf x = withPyObject x + (\pyo -> pyObject_Str pyo >>= fromCPyObject >>= fromPyObject)++ +{- | Gets the Python representation of a Python object.+Same as repr(x) in Python. -}+reprOf :: PyObject -> IO String+reprOf x = withPyObject x+ (\pyo -> pyObject_Repr pyo >>= fromCPyObject >>= fromPyObject)++{- | Displays a Python object and its type. -}+showPyObject :: PyObject -> IO String+showPyObject x = do typestr <- typeOf x >>= strOf+ contentstr <- strOf x+ return $ typestr ++ ": " ++ contentstr++{- | Displays a list of keys contained in the Python object. -}+dirPyObject :: PyObject -> IO [String]+dirPyObject x = withPyObject x (\cpyo ->+ do dr <- pyObject_Dir cpyo >>= fromCPyObject+ fromPyObject dr+ )++{- | Call a Python object with all-Haskell parameters.+Similar to 'PyObject_Call'. This limits you to a single item type for+the regular arguments and another single item type for the keyword arguments. +Nevertheless, it could be a handy shortcut at times.++For a higher-level wrapper, see 'Python.Interpreter.callByName'.++You may find 'noParms' and 'noKwParms' useful if you aren't passing any+parameters. -}+pyObject_CallHs :: (ToPyObject a, ToPyObject b, FromPyObject c) =>+ PyObject -- ^ Object t+ -> [a] -- ^ List of non-keyword parameters+ -> [(String, b)] -- ^ List of keyword parameters+ -> IO c -- ^ Return value+pyObject_CallHs callobj simpleargs kwargs =+ pyObject_Hs callobj simpleargs kwargs >>= fromPyObject++pyObject_Hs :: (ToPyObject a, ToPyObject b) =>+ PyObject -- ^ Object t+ -> [a] -- ^ List of non-keyword parameters+ -> [(String, b)] -- ^ List of keyword parameters+ -> IO PyObject -- ^ Return value+pyObject_Hs callobj simpleargs kwargs =+ let conv (k, v) = do v1 <- toPyObject v+ return (k, v1)+ in+ do s <- mapM toPyObject simpleargs+ k <- mapM conv kwargs+ pyObject_Call callobj s k++{- | Like 'PyObject_CallHs', but discards the return value. -}+pyObject_RunHs :: (ToPyObject a, ToPyObject b) =>+ PyObject -- ^ Object t+ -> [a] -- ^ List of non-keyword parameters+ -> [(String, b)] -- ^ List of keyword parameters+ -> IO () -- ^ Return value+pyObject_RunHs callobj simpleargs kwargs =+ pyObject_Hs callobj simpleargs kwargs >> return ()++callMethodHs_internal :: (ToPyObject a, ToPyObject b) =>+ PyObject+ -> String+ -> [a]+ -> [(String, b)]+ -> IO PyObject+callMethodHs_internal pyo method args kwargs =+ do mobj <- getattr pyo method+ pyObject_Hs mobj args kwargs+ +{- | Calls the named method of the given object. -}+callMethodHs :: (ToPyObject a, ToPyObject b, FromPyObject c) =>+ PyObject -- ^ The main object+ -> String -- ^ Name of method to call+ -> [a] -- ^ Non-kw args+ -> [(String, b)] -- ^ Keyword args+ -> IO c -- ^ Result+callMethodHs pyo method args kwargs =+ callMethodHs_internal pyo method args kwargs >>= fromPyObject++{- | Like 'callMethodHs', but discards the return value. -}+runMethodHs :: (ToPyObject a, ToPyObject b) =>+ PyObject -- ^ The main object+ -> String -- ^ Name of method to call+ -> [a] -- ^ Non-kw args+ -> [(String, b)] -- ^ Keyword args+ -> IO () -- ^ Result+runMethodHs pyo method args kwargs =+ callMethodHs_internal pyo method args kwargs >> return ()++noParms :: [String]+noParms = []++noKwParms :: [(String, String)]+noKwParms = []++++{- | Call a Python object (function, etc).++For a higher-level wrapper, see 'Python.Interpreter.callByName'.+ -}+pyObject_Call :: PyObject -- ^ Object to call+ -> [PyObject] -- ^ List of non-keyword parameters (may be empty)+ -> [(String, PyObject)] -- ^ List of keyword parameters (may be empty)+ -> IO PyObject -- ^ Return value+pyObject_Call callobj simpleparams kwparams =+ do pyosimple <- toPyObject simpleparams >>= pyList_AsTuple+ pyokw <- toPyObject kwparams+ cval <- withPyObject callobj (\ccallobj ->+ withPyObject pyosimple (\cpyosimple ->+ withPyObject pyokw (\cpyokw ->+ cpyObject_Call ccallobj cpyosimple cpyokw)))+ fromCPyObject cval+ +-- ^ Converts a Python list to a tuple.+pyList_AsTuple :: PyObject -> IO PyObject+pyList_AsTuple x =+ withPyObject x (\cpo -> cpyList_AsTuple cpo >>= fromCPyObject)++{- | An interface to a function similar to Python's getattr. This will+look up an attribute (such as a method) of an object. -}+getattr :: PyObject -> String -> IO PyObject+getattr pyo s =+ withPyObject pyo (\cpo ->+ withCString s (\cstr ->+ pyObject_GetAttrString cpo cstr >>= fromCPyObject))++{- | An interface to Python's hasattr. Returns True if the named+attribute exists; False otherwise. -}+hasattr :: PyObject -> String -> IO Bool+hasattr pyo s =+ withPyObject pyo (\cpo ->+ withCString s (\cstr ->+ do r <- pyObject_HasAttrString cpo cstr >>= checkCInt+ if r == 0+ then return False+ else return True+ )+ )+{- | An interface to Python's setattr, used to set attributes of an object.+-}+setattr :: PyObject -- ^ Object to operate on+ -> String -- ^ Name of attribute+ -> PyObject -- ^ Set the attribute to this value+ -> IO ()+setattr pyo s setpyo =+ withPyObject pyo (\cpo ->+ withPyObject setpyo (\csetpyo ->+ withCString s (\cstr ->+ pyObject_SetAttrString cpo cstr csetpyo >>= checkCInt >> return ()+ )))++----------------------------------------------------------------------+-- Instances+----------------------------------------------------------------------++-- FIXME: ERROR CHECKING!++--------------------------------------------------+-- [PyObject] Lists++-- | Lists from a PyObject+instance ToPyObject [PyObject] where+ toPyObject mainlist =+ do l <- pyList_New 0+ mapM_ (\pyo -> withPyObject pyo (\x -> pyList_Append l x >>= checkCInt)) mainlist+ fromCPyObject l++-- | Tuples and Lists to [PyObject] lists+instance FromPyObject [PyObject] where+ fromPyObject x = + let worker cpyo =+ do islist <- pyList_Check cpyo >>= checkCInt+ istuple <- pyTuple_Check cpyo >>= checkCInt+ if islist /= 0+ then fromx pyList_Size pyList_GetItem cpyo+ else if istuple /= 0+ then fromx pyTuple_Size pyTuple_GetItem cpyo+ else fail "Error fromPyObject to [PyObject]: Passed object not a list or tuple."+ fromx sizefunc itemfunc cpyo = do size <- sizefunc cpyo+ fromx_worker 0 size itemfunc cpyo+ fromx_worker counter size itemfunc cpyo =+ if counter >= size + then return []+ else do thisitem <- itemfunc cpyo counter+ py_incref thisitem+ thisobj <- fromCPyObject thisitem+ {- This unsafeInterlaveIO caused segfaults. Theory:+ parent object would be deallocated before all+ items would be consumed. -}+ next <- {-unsafeInterleaveIO $-} fromx_worker (succ counter) size itemfunc cpyo+ return $ thisobj : next+ in+ withPyObject x worker++--------------------------------------------------+-- Association Lists++-- | Dicts from ALs+instance ToPyObject [(PyObject, PyObject)] where+ toPyObject mainlist =+ do d <- pyDict_New+ mapM_ (setitem d) mainlist+ fromCPyObject d+ where setitem l (key, value) =+ withPyObject key (\keyo ->+ withPyObject value (\valueo ->+ pyObject_SetItem l keyo valueo >>= checkCInt))++-- | ALs from Dicts+instance FromPyObject [(PyObject, PyObject)] where+ fromPyObject pydict = withPyObject pydict (\cpydict ->+ -- Type sigs here are for clarity only+ do -- This gives a PyObject+ items <- (pyMapping_Items cpydict >>= fromCPyObject):: IO PyObject+ -- Now, make a Haskell [[PyObject, PyObject]] list+ itemlist <- (fromPyObject items)::IO [[PyObject]]+ -- Finally, convert it to a list of tuples.+ return $ map list2tup itemlist+ )+ where list2tup x = case x of+ x1:x2:[] -> (x1, x2)+ _ -> error "Expected 2-tuples in fromPyObject dict"+ +-- | This is a common variant used for arg lists+instance ToPyObject a => ToPyObject [(a, PyObject)] where+ toPyObject mainlist =+ let conv (k, v) = do k1 <- toPyObject k+ return (k1, v)+ in mapM conv mainlist >>= toPyObject+instance FromPyObject a => FromPyObject [(a, PyObject)] where+ fromPyObject pyo =+ let conv (k, v) = do k1 <- fromPyObject k+ return (k1, v)+ in do list <- (fromPyObject pyo)::IO [(PyObject, PyObject)]+ mapM conv list+++-- | Dicts from Haskell objects+instance (ToPyObject a, ToPyObject b) => ToPyObject [(a, b)] where+ toPyObject mainlist =+ let convone (i1, i2) = do oi1 <- toPyObject i1+ oi2 <- toPyObject i2+ return (oi1, oi2)+ in do newl <- mapM convone mainlist+ toPyObject newl++-- | Dicts to Haskell objects+instance (FromPyObject a, FromPyObject b) => FromPyObject [(a, b)] where+ fromPyObject pydict =+ let conv (x, y) = do x1 <- fromPyObject x+ y1 <- fromPyObject y+ return (x1, y1)+ in do pyodict <- ((fromPyObject pydict)::IO [(PyObject, PyObject)])+ mapM conv pyodict++--------------------------------------------------+-- Strings++-- CStringLen to PyObject. Use CStringLen to handle embedded nulls.+instance ToPyObject CStringLen where+ toPyObject (x, len) = + pyString_FromStringAndSize x (fromIntegral len) >>= fromCPyObject++-- String to PyObject+instance ToPyObject String where+ toPyObject x = withCString x (\cstr -> toPyObject (cstr, length x))++-- PyObject to String+instance FromPyObject String where+ fromPyObject x = withPyObject x (\po ->+ alloca (\lenptr ->+ alloca (\strptr ->+ do pyString_AsStringAndSize po strptr lenptr+ len <- peek lenptr+ cstr <- peek strptr+ peekCStringLen (cstr, (fromIntegral) len)+ )+ )+ )++--------------------------------------------------+-- Numbers, Python Ints++-- Python ints are C longs+instance ToPyObject CLong where+ toPyObject x = pyInt_FromLong x >>= fromCPyObject++-- And convert back.+instance FromPyObject CLong where+ fromPyObject x = withPyObject x pyInt_AsLong++-- We'll also support CInts.+instance ToPyObject CInt where+ toPyObject x = toPyObject ((fromIntegral x)::CLong)++instance FromPyObject CInt where+ fromPyObject x = do y <- (fromPyObject x)::IO CLong+ return $ fromIntegral y++--------------------------------------------------+-- Numbers, Python Longs++instance ToPyObject Integer where+ toPyObject i = + -- Use strings here since no other C type supports+ -- unlimited precision.+ let repr = show i+ in withCString repr (\cstr -> + pyLong_FromString cstr nullPtr 10 >>= fromCPyObject)+ +instance FromPyObject Integer where+ fromPyObject pyo = + do longstr <- strOf pyo+ return $ read longstr++--------------------------------------------------+-- Numbers, anything else.+{- For these, we attempt to guess whether to handle it as an+int or a long. -}+{-+Disabled for now; this is a low-level interface, and it seems to be overly+complex for this.++instance Integral a => ToPyObject a where+ toPyObject x =+ let intval = toInteger x+ in+ if (intval < (toInteger (minBound::CLong)) ||+ intval > (toInteger (maxBound::CLong)))+ then toPyObject intval+ else toPyObject ((fromIntegral x)::CLong)++-- On the return conversion, we see what the bounds for+-- the desired type are, and treat it thusly.+instance (Bounded a, Integral a) => FromPyObject a where+ fromPyObject x =+ let minpyint = toInteger (minBound::CLong)+ maxpyint = toInteger (maxBound::CLong)+ minpassed = toInteger (minBound::a)+ maxpassed = toInteger (maxBound::a)+ in if (minpassed < minpyint || maxpassed > maxpyint)+ then do intval <- fromPyObject x+ return $ fromInteger intval+ else do longval <- ((fromPyObject x)::IO CLong)+ return $ fromIntegral longval++-}++--------------------------------------------------+-- Floating-Point Values++instance ToPyObject CDouble where+ toPyObject x = pyFloat_FromDouble x >>= fromCPyObject++instance FromPyObject CDouble where+ fromPyObject x = withPyObject x pyFloat_AsDouble++-- | Lists from anything else+instance ToPyObject a => ToPyObject [a] where+ toPyObject mainlist = + do newlist <- mapM toPyObject mainlist+ toPyObject newlist++instance FromPyObject a => FromPyObject [a] where+ fromPyObject pylistobj = + do pylist <- fromPyObject pylistobj+ mapM fromPyObject pylist++
+ src/Python/Objects/Dict.hs view
@@ -0,0 +1,137 @@+{-# LANGUAGE OverlappingInstances#-}++{- arch-tag: Python dict-like objects+Copyright (C) 2005 John Goerzen <jgoerzen@complete.org>++This program is free software; you can redistribute it and/or modify+it under the terms of the GNU General Public License as published by+the Free Software Foundation; either version 2 of the License, or+(at your option) any later version.++This program is distributed in the hope that it will be useful,+but WITHOUT ANY WARRANTY; without even the implied warranty of+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+GNU General Public License for more details.++You should have received a copy of the GNU General Public License+along with this program; if not, write to the Free Software+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+-}++{- |+ Module : Python.Objects.Dict+ Copyright : Copyright (C) 2005 John Goerzen+ License : GNU GPL, version 2 or above++ Maintainer : John Goerzen,+ Maintainer : jgoerzen\@complete.org+ Stability : provisional+ Portability: portable++Python dict-like objects++Written by John Goerzen, jgoerzen\@complete.org++This module can be used to access Python dicts and dict-like objects such as+dbm databases. For a higher-level interface to creating and working with these+dbm interfaces, please see the functions in "MissingPy.AnyDBM". Also,+for functions that use this, please see "Database.AnyDBM".++-}++module Python.Objects.Dict (PyDict,+ mkPyDict,+ fromPyDict)+where+import Python.ForeignImports (pyObject_SetItem, pyObject_DelItem, pyObject_GetItem, pyErr_Clear, pyMapping_Keys)+import Python.Objects(+ toPyObject+ , fromPyObject+ , hasattr+ , noKwParms+ , noParms+ , runMethodHs+ , toPyObject+ )+import Python.Utils (withPyObject, checkCInt, fromCPyObject)+import Foreign (Ptr, nullPtr)+import Python.Exceptions (catchPy, exc2ioerror)+import Database.AnyDBM (AnyDBM (..))+import Python.Types (PyObject, CPyObject)++{- | The basic type for a Python dict or dict-like object. -}+newtype PyDict = PyDict + PyObject -- Main dict object++{- | Takes a 'PyObject' representing a Python dict or dict-like objext+and makes it into a 'PyDict'. -}+mkPyDict :: PyObject -> PyDict+mkPyDict o = PyDict o++{- | Takes a 'PyDict' and returns its internal 'PyObject'. -}+fromPyDict :: PyDict -> PyObject+fromPyDict (PyDict o) = o++{- | Wrap an operation, raising exceptions in the IO monad as appropriate. -}+pydwrap :: PyDict -> (PyObject -> IO a) -> IO a+pydwrap (PyDict pyobj) func = catchPy (func pyobj) exc2ioerror++{- | Give it a CPyObject instead. -}+cpydwrap :: PyDict -> (Ptr CPyObject -> IO a) -> IO a+cpydwrap x func = pydwrap x (\y -> withPyObject y func)++instance AnyDBM PyDict where+ insertA h k v = + do ko <- toPyObject k+ kv <- toPyObject v+ withPyObject ko (\ck ->+ withPyObject kv (\cv ->+ cpydwrap h (\cdict ->+ pyObject_SetItem cdict ck cv >>= checkCInt >> return()+ )+ )+ )+ deleteA h k = + do ko <- toPyObject k+ withPyObject ko (\ck ->+ cpydwrap h (\cdict ->+ pyObject_DelItem cdict ck >>= checkCInt >> return ()))+ lookupA h k =+ do ko <- toPyObject k+ withPyObject ko (\ck ->+ cpydwrap h (\cdict ->+ do r <- pyObject_GetItem cdict ck+ if r == nullPtr+ then do pyErr_Clear -- Ignore this exception+ return Nothing+ else do retval <- fromCPyObject r >>= fromPyObject+ return $ Just retval+ ))+ {-+ toListA h =+ This used to be:+ pydwrap h fromPyObject+ but some *dbm's are incompatible with that. Sigh. -}++ keysA h =+ cpydwrap h (\ch ->+ do keysobj <- pyMapping_Keys ch >>= fromCPyObject+ keys <- (fromPyObject keysobj)::IO [String]+ return keys+ )++ flushA h = pydwrap h (\pyo -> do h <- hasattr pyo "sync"+ if h + then runMethodHs pyo "sync" noParms noKwParms+ else return ()+ )++ closeA h = pydwrap h (\pyo -> do h <- hasattr pyo "close"+ if h+ then runMethodHs pyo "close" noParms noKwParms+ else return ()+ )++ + +
+ src/Python/Objects/File.hs view
@@ -0,0 +1,213 @@+{-# LANGUAGE OverlappingInstances#-}++{- arch-tag: Python file-like objects+Copyright (C) 2005 John Goerzen <jgoerzen@complete.org>++This program is free software; you can redistribute it and/or modify+it under the terms of the GNU General Public License as published by+the Free Software Foundation; either version 2 of the License, or+(at your option) any later version.++This program is distributed in the hope that it will be useful,+but WITHOUT ANY WARRANTY; without even the implied warranty of+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+GNU General Public License for more details.++You should have received a copy of the GNU General Public License+along with this program; if not, write to the Free Software+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+-}++{- |+ Module : Python.Objects.File+ Copyright : Copyright (C) 2005 John Goerzen+ License : GNU GPL, version 2 or above++ Maintainer : John Goerzen,+ Maintainer : jgoerzen\@complete.org+ Stability : provisional+ Portability: portable++Python file-like objects++Written by John Goerzen, jgoerzen\@complete.org++This module provides a Haskell interface to work with Python file-like objects.+The Haskell interface is a "System.IO.HVIO" interface, which is similar+in concept to the Python file-like object system.++You can create such objects by using 'openPyFile' from this module, or+'MissingPy.FileArchive.GZip.openGz' or 'MissingPy.FileArchive.BZip2.openBz2'.++Functions that you can use to operate on these objects are defined at+"System.IO.HVIO".+-}++module Python.Objects.File (-- * PyFile Objects+ PyFile,+ mkPyFile,+ fromPyFile,+ openPyFile,+ pyfwrap,+ openModeConv+ )+where+import Python.Objects ( PyObject(..)+ , callMethodHs+ , fromPyObject+ , getattr+ , hasattr+ , noKwParms+ , noParms+ , runMethodHs+ , showPyObject+ , toPyObject+ )+import Python.Interpreter (callByName)+import System.IO (IOMode(..), SeekMode(..))+import System.IO.Error (eofErrorType)+import System.IO.Unsafe (unsafeInterleaveIO)+import Python.Exceptions (catchPy, exc2ioerror)+import System.IO.HVIO (HVIO(..))+import Foreign.C.Types (CInt, CLong)++{- | The basic type for a Python file or file-like object.++'PyFile's are a member of System.IO.HVIO and can be used as any other+Haskell HVFS object such as a Handle.++'PyFile' objects cannot reliably detect EOF when asked by 'vIsEOF', but+can detect it and raise the appropriate IOError when it is reached.+Also, 'PyFile' objects cannot determine if they are readable, writable,+or seekable in advance.+ -}+newtype PyFile = PyFile PyObject++{- | Takes a 'PyObject' representing a Python file or file-like object+and makes it into a 'PyFile'. -}+mkPyFile :: PyObject -> PyFile+mkPyFile o = PyFile o++{- | Extracts the 'PyObject' representing this 'PyFile'. -}+fromPyFile :: PyFile -> PyObject+fromPyFile (PyFile o) = o++{- | Convert a Haskell open mode to a Python mode string -}+openModeConv ReadMode = "r"+openModeConv WriteMode = "w"+openModeConv AppendMode = "a"+openModeConv ReadWriteMode = "w+"++{- | Open a file on disk and return a 'PyFile'. -}+openPyFile :: FilePath -> IOMode -> IO PyFile+openPyFile fp mode =+ do parms1 <- toPyObject [fp]+ parms2 <- toPyObject [openModeConv mode]+ obj <- callByName "open" [parms1, parms2] []+ return $ mkPyFile obj++------------------------------------------------------------+-- HVIO+------------------------------------------------------------++instance Show PyFile where+ show _ = "<Python File Object>"++{- | Wrap an operation, raising exceptions in the IO monad as appropriate. -}+pyfwrap :: PyFile -> (PyObject -> IO a) -> IO a+pyfwrap (PyFile pyobj) func = catchPy (func pyobj) exc2ioerror++raiseEOF :: PyFile -> IO a+raiseEOF h = vThrow h eofErrorType++instance HVIO PyFile where+ vClose pyf = pyfwrap pyf (\pyo -> runMethodHs pyo "close" noParms noKwParms)+ + vIsClosed pyf = pyfwrap pyf (\pyo ->+ do h <- hasattr pyo "closed"+ if h then+ do v <- (getattr pyo "closed" >>= fromPyObject)::IO CInt+ if v == 0+ then return False+ else return True+ else return False -- Don't know; fake it.+ )++ vGetContents pyf = do vTestOpen pyf+ vTestEOF pyf+ pyfwrap pyf (\pyo ->+ let loop = unsafeInterleaveIO $+ do block <- callMethodHs pyo "read" + [4096::CLong] noKwParms+ case block of+ [] -> do vClose pyf+ return []+ x -> do next <- loop+ return $ x : next+ in do c <- loop+ return $ concat c+ )+++ -- Have to fake it. We have no EOF indication.+ vIsEOF pyf = return False++ vShow pyf = pyfwrap pyf showPyObject++ vGetChar pyf = do vTestOpen pyf+ pyfwrap pyf (\pyo ->+ do c <- callMethodHs pyo "read" [1::CInt] noKwParms+ case c of + [] -> raiseEOF pyf+ [x] -> return x+ )++ vGetLine pyf = do vTestOpen pyf+ pyfwrap pyf (\pyo ->+ do line <- callMethodHs pyo "readline" noParms noKwParms+ case reverse line of+ [] -> raiseEOF pyf+ '\n':xs -> return $ reverse xs+ x -> return line+ )++ vPutChar pyf c = vPutStr pyf [c]++ {- Python strings are non-lazy, so process these in chunks. -}+ vPutStr pyf [] = vTestOpen pyf >> return ()+ vPutStr pyf s = let (this, next) = (splitAt 4096 s)::(String, String)+ in do vTestOpen pyf+ pyfwrap pyf (\pyo ->+ runMethodHs pyo "write" [this] noKwParms)+ vPutStr pyf next++ vFlush pyf = pyfwrap pyf (\pyo ->+ do vTestOpen pyf+ h <- hasattr pyo "flush"+ if h then runMethodHs pyo "flush" noParms noKwParms+ else return ()+ )++ {- Some file-like objects don't take an offset. Sigh. -}+ vSeek pyf sm offset =+ let seekint = case sm of+ AbsoluteSeek -> 0::CLong+ RelativeSeek -> 1+ SeekFromEnd -> 2+ in do vTestOpen pyf+ pyfwrap pyf (\pyo -> + case sm of+ AbsoluteSeek -> runMethodHs pyo "seek" + [(fromIntegral offset)::CLong]+ noKwParms+ _ -> runMethodHs pyo "seek" [(fromIntegral offset), + seekint] noKwParms+ )++ vTell pyf = pyfwrap pyf (\pyo ->+ vTestOpen pyf >> callMethodHs pyo "tell" noParms noKwParms)++ vIsSeekable _ = return True -- fake it+ vIsWritable _ = return True -- fake it+ vIsReadable _ = return True -- fake it+
+ src/Python/Types.hs view
@@ -0,0 +1,93 @@+{-# LANGUAGE CPP #-}+{- arch-tag: Python types+Copyright (C) 2005 John Goerzen <jgoerzen@complete.org>++This program is free software; you can redistribute it and/or modify+it under the terms of the GNU General Public License as published by+the Free Software Foundation; either version 2 of the License, or+(at your option) any later version.++This program is distributed in the hope that it will be useful,+but WITHOUT ANY WARRANTY; without even the implied warranty of+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+GNU General Public License for more details.++You should have received a copy of the GNU General Public License+along with this program; if not, write to the Free Software+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+-}++{- |+ Module : Python.Types+ Copyright : Copyright (C) 2005 John Goerzen+ License : GNU GPL, version 2 or above++ Maintainer : John Goerzen,+ Maintainer : jgoerzen\@complete.org+ Stability : provisional+ Portability: portable++Interfaces to low-level Python types. You should probably not use this module+directly. You probably want "Python.Objects" instead.++You'll only need this module directly if you are importing new functions+from the Python C API.++Written by John Goerzen, jgoerzen\@complete.org+-}++module Python.Types (+ PyObject(..),+ CPyObject,+ PyException(..),+ StartFrom(..)+#ifndef PYTHON_PRE_2_3+ ,PyGILState(..)+ ,CPyGILState+#endif+ )+where++import Foreign (ForeignPtr)+import Data.Typeable (+ TyCon+ , mkTyConApp+ , mkTyCon3+ , Typeable(..)+ )+import Control.Exception (Exception)++type CPyObject = ()++-- | The type of Python objects.+newtype PyObject = PyObject (ForeignPtr CPyObject)+ deriving (Eq, Show)++#ifndef PYTHON_PRE_2_3+type CPyGILState = ()+newtype PyGILState = PyGILState (ForeignPtr CPyGILState)+ deriving (Eq, Show)+#endif++-- | The type of Python exceptions.+data PyException = PyException {excType :: PyObject, -- ^ Exception type+ excValue :: PyObject, -- ^ Exception value+ excTraceBack :: PyObject, -- ^ Traceback+ excFormatted :: String -- ^ Formatted for display+ }+instance Show PyException where+ show = excFormatted++pyExceptionTc :: TyCon+pyExceptionTc = mkTyCon3 "MissingPy" "Python.Types" "PyException"++instance Typeable PyException where+ typeOf _ = mkTyConApp pyExceptionTc []++instance Exception PyException++{- | How to interpret a snippet of Python code. -}+data StartFrom = Py_eval_input+ | Py_file_input+ | Py_single_input+
+ src/Python/Utils.hs view
@@ -0,0 +1,159 @@+{- arch-tag: Python low-level utilities+Copyright (C) 2005 John Goerzen <jgoerzen@complete.org>++This program is free software; you can redistribute it and/or modify+it under the terms of the GNU General Public License as published by+the Free Software Foundation; either version 2 of the License, or+(at your option) any later version.++This program is distributed in the hope that it will be useful,+but WITHOUT ANY WARRANTY; without even the implied warranty of+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+GNU General Public License for more details.++You should have received a copy of the GNU General Public License+along with this program; if not, write to the Free Software+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+-}++{- |+ Module : Python.Utils+ Copyright : Copyright (C) 2005 John Goerzen+ License : GNU GPL, version 2 or above++ Maintainer : John Goerzen,+ Maintainer : jgoerzen\@complete.org+ Stability : provisional+ Portability: portable++Python low-level utilities++Written by John Goerzen, jgoerzen\@complete.org++Please use sparingly and with caution. The documentation for their behavior+should be considered to be the source code.+-}++module Python.Utils (-- * Objects+ fromCPyObject,+ withPyObject,+ maybeWithPyObject,+ -- * Exceptions+ raisePyException,+ checkCInt,+ -- * Environment+ getDefaultGlobals,+ pyImport_AddModule,+ pyModule_GetDict,+ py_incref+ )+ where+import Python.Types (+ CPyObject(..)+ , PyObject(..)+ , PyException(excType, excValue, excTraceBack, excFormatted, PyException)+ )+import Python.ForeignImports (+ cNone+ , cpyImport_AddModule+ , cpyModule_GetDict+ , pyErr_Clear+ , pyErr_Fetch+ , pyErr_NormalizeException+ , py_decref+ , py_incref+ , py_incref+ )++import Foreign.C.Types (CInt)+import Foreign.C (withCString)+import Foreign (peek, Ptr, newForeignPtr, nullPtr, alloca, withForeignPtr)+import Control.Exception (throw)++{- | Convert a Ptr 'CPyObject' to a 'PyObject'. -}+fromCPyObject :: Ptr CPyObject -> IO PyObject+fromCPyObject po =+ if po == nullPtr+ then raisePyException+ else do fp <- newForeignPtr py_decref po+ return $ PyObject fp++{- | Called to make sure the passed CInt isn't -1. Raise an exception if+it is. -}+checkCInt :: CInt -> IO CInt+checkCInt x = + if x == (-1)+ then raisePyException+ else return x++{- | Called when a Python exception has been detected. It will raise+the exception in Haskell. -}+raisePyException :: IO a+raisePyException =+ let noneorptr cval = if cval == nullPtr+ then do p <- cNone+ fromCPyObject p+ else fromCPyObject cval+ in alloca (\typeptr -> alloca (\valptr -> alloca (\tbptr ->+ do pyErr_Fetch typeptr valptr tbptr+ pyErr_NormalizeException typeptr valptr tbptr+ ctype <- peek typeptr+ cval <- peek valptr+ ctb <- peek tbptr+ otype <- noneorptr ctype+ oval <- noneorptr cval+ otb <- noneorptr ctb+ --seq otype $ return ()+ --seq oval $ return ()+ --seq otb $ return ()+ let exc = PyException {excType = otype, excValue = oval,+ excTraceBack = otb,+ excFormatted = ""}+ pyErr_Clear+ throw exc+ )))+{-+ do cpy <- getexc+ let (exc, val, tb) = cpy+ --pyErr_Print+ fail "Python Error!"+ where getexc = do cexc <- hspy_getexc+ exc <- peekArray 3 cexc+ exc2 <- mapM fromCPyObject exc+ case exc2 of+ [x, y, z] -> return (x, y, z)+ _ -> fail "Got unexpected number of elements"+-} + +{- | Uses a 'PyObject' in a function that needs Ptr 'CPyObject'. -}+withPyObject :: PyObject -> (Ptr CPyObject -> IO b) -> IO b+withPyObject (PyObject x) = withForeignPtr x ++{- | Same as 'withPyObject', but uses nullPtr if the input is Nothing. -}+maybeWithPyObject :: Maybe PyObject -> (Ptr CPyObject -> IO b) -> IO b+maybeWithPyObject Nothing func = func nullPtr+maybeWithPyObject (Just x) y = withPyObject x y++{- | Returns the default globals environment. -}+getDefaultGlobals :: IO PyObject+getDefaultGlobals = + do m <- pyImport_AddModule "__main__"+ pyModule_GetDict m+ +{- | Wrapper around C PyImport_AddModule, which looks up an existing module -}+pyImport_AddModule :: String -> IO PyObject+pyImport_AddModule x =+ withCString x (\cstr -> + do r <- cpyImport_AddModule cstr+ py_incref r+ fromCPyObject r+ )++{- | Gets the dict associated with a module. -}+pyModule_GetDict :: PyObject -> IO PyObject+pyModule_GetDict x =+ withPyObject x (\cpyo -> + do r <- cpyModule_GetDict cpyo+ py_incref r+ fromCPyObject r)+
+ testfiles/bz2files/empty.bz2 view
binary file changed (absent → 14 bytes)
+ testfiles/bz2files/t1.bz2 view
binary file changed (absent → 48 bytes)
+ testfiles/bz2files/t2.bz2 view
binary file changed (absent → 52 bytes)
+ testfiles/bz2files/zeros.bz2 view
binary file changed (absent → 49 bytes)
+ testfiles/gzfiles/empty.gz view
binary file changed (absent → 26 bytes)
+ testfiles/gzfiles/t1.gz view
binary file changed (absent → 26 bytes)
+ testfiles/gzfiles/t1bad.gz view
binary file changed (absent → 26 bytes)
+ testfiles/gzfiles/t2.gz view
binary file changed (absent → 55 bytes)
+ testfiles/gzfiles/zeros.gz view
binary file changed (absent → 10214 bytes)