diff --git a/COPYING b/COPYING new file mode 100644 --- /dev/null +++ b/COPYING @@ -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. + + + Copyright (C) + + 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. + + , 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 + diff --git a/COPYRIGHT b/COPYRIGHT new file mode 100644 --- /dev/null +++ b/COPYRIGHT @@ -0,0 +1,24 @@ +MissingPy: Haskell Python Interface libraries +Copyright (C) 2004 - 2008 John Goerzen + +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. diff --git a/INSTALL b/INSTALL new file mode 100644 --- /dev/null +++ b/INSTALL @@ -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) diff --git a/MissingPy.md b/MissingPy.md new file mode 100644 --- /dev/null +++ b/MissingPy.md @@ -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 . + +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. + diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,32 @@ +# missing-py2 [![Build Status](https://travis-ci.org/domdere/missing-py2.png?branch=master)](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" diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -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 + } diff --git a/genexceptions.hs b/genexceptions.hs new file mode 100644 --- /dev/null +++ b/genexceptions.hs @@ -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 " + 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", + ".", + "", + "Please note that windowsError is available only on Microsoft platforms.", + "", + "Written by John Goerzen, jgoerzen\\@complete.org", + "-}", + "#include ", + "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 diff --git a/glue/excglue.c b/glue/excglue.c new file mode 100644 --- /dev/null +++ b/glue/excglue.c @@ -0,0 +1,59 @@ +/* NOTICE -- THIS FILE IS AUTO-GENERATED -- DO NOT EDIT +MissingPy: Haskell Python Interface libraries +Copyright (C) 2004 - 2005 John Goerzen + +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 +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 + diff --git a/glue/excglue.h b/glue/excglue.h new file mode 100644 --- /dev/null +++ b/glue/excglue.h @@ -0,0 +1,59 @@ +/* NOTICE -- THIS FILE IS AUTO-GENERATED -- DO NOT EDIT +MissingPy: Haskell Python Interface libraries +Copyright (C) 2004 - 2005 John Goerzen + +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 +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 + diff --git a/glue/glue.c b/glue/glue.c new file mode 100644 --- /dev/null +++ b/glue/glue.c @@ -0,0 +1,63 @@ +/* arch-tag: Python Utility Functions +Copyright (C) 2005 John Goerzen + +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 + +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); +} diff --git a/glue/glue.h b/glue/glue.h new file mode 100644 --- /dev/null +++ b/glue/glue.h @@ -0,0 +1,29 @@ +/* arch-tag: Python Utility Functions, header file +Copyright (C) 2005 John Goerzen + +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 +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); diff --git a/missing-py2.cabal b/missing-py2.cabal new file mode 100644 --- /dev/null +++ b/missing-py2.cabal @@ -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 diff --git a/originaltests/AnyDBMPytest.hs b/originaltests/AnyDBMPytest.hs new file mode 100644 --- /dev/null +++ b/originaltests/AnyDBMPytest.hs @@ -0,0 +1,41 @@ +{- arch-tag: AnyDBM tests for Python +Copyright (C) 2004-2005 John Goerzen + +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") + ] + + + + diff --git a/originaltests/AnyDBMtest.hs b/originaltests/AnyDBMtest.hs new file mode 100644 --- /dev/null +++ b/originaltests/AnyDBMtest.hs @@ -0,0 +1,137 @@ +{- arch-tag: AnyDBM tests main file +Copyright (C) 2004-2005 John Goerzen + +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) + ] + + + diff --git a/originaltests/BZip2test.hs b/originaltests/BZip2test.hs new file mode 100644 --- /dev/null +++ b/originaltests/BZip2test.hs @@ -0,0 +1,89 @@ +{- arch-tag: BZip2 tests main file +Copyright (C) 2005 John Goerzen + +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) + ] diff --git a/originaltests/Dicttest.hs b/originaltests/Dicttest.hs new file mode 100644 --- /dev/null +++ b/originaltests/Dicttest.hs @@ -0,0 +1,110 @@ +{- arch-tag: AnyDBM/Dict Python Tests Main File +Copyright (C) 2004-2005 John Goerzen + +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) + ] diff --git a/originaltests/Exceptionstest.hs b/originaltests/Exceptionstest.hs new file mode 100644 --- /dev/null +++ b/originaltests/Exceptionstest.hs @@ -0,0 +1,57 @@ +{- arch-tag: Exceptions tests main file +Copyright (C) 2005 John Goerzen + +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) + ] diff --git a/originaltests/GZiptest.hs b/originaltests/GZiptest.hs new file mode 100644 --- /dev/null +++ b/originaltests/GZiptest.hs @@ -0,0 +1,85 @@ +{- arch-tag: GZip tests main file +Copyright (C) 2005-2008 John Goerzen + +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 : 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) + ] diff --git a/originaltests/Interpretertest.hs b/originaltests/Interpretertest.hs new file mode 100644 --- /dev/null +++ b/originaltests/Interpretertest.hs @@ -0,0 +1,78 @@ +{- arch-tag: Interpreter tests main file +Copyright (C) 2005 John Goerzen + +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) + ] diff --git a/originaltests/Main.hs b/originaltests/Main.hs new file mode 100644 --- /dev/null +++ b/originaltests/Main.hs @@ -0,0 +1,36 @@ +{- arch-tag: Test runner +Copyright (C) 2004 John Goerzen + +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) + diff --git a/originaltests/Objectstest.hs b/originaltests/Objectstest.hs new file mode 100644 --- /dev/null +++ b/originaltests/Objectstest.hs @@ -0,0 +1,182 @@ +{- arch-tag: Object tests main file +Copyright (C) 2005 John Goerzen + +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 ": 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) "" + , 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) + ] diff --git a/originaltests/Tests.hs b/originaltests/Tests.hs new file mode 100644 --- /dev/null +++ b/originaltests/Tests.hs @@ -0,0 +1,44 @@ +{- arch-tag: Tests main file +Copyright (C) 2004 - 2005 John Goerzen + +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 + ] + + + diff --git a/originaltests/Testutil.hs b/originaltests/Testutil.hs new file mode 100644 --- /dev/null +++ b/originaltests/Testutil.hs @@ -0,0 +1,55 @@ +{- arch-tag: Test utilities +Copyright (C) 2004 John Goerzen + +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 diff --git a/src/MissingPy/AnyDBM.hs b/src/MissingPy/AnyDBM.hs new file mode 100644 --- /dev/null +++ b/src/MissingPy/AnyDBM.hs @@ -0,0 +1,98 @@ +{-# LANGUAGE OverlappingInstances#-} + +{- arch-tag: Interface to anydbm.py +Copyright (C) 2005 John Goerzen + +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 diff --git a/src/MissingPy/FileArchive/BZip2.hs b/src/MissingPy/FileArchive/BZip2.hs new file mode 100644 --- /dev/null +++ b/src/MissingPy/FileArchive/BZip2.hs @@ -0,0 +1,71 @@ +{-# LANGUAGE OverlappingInstances#-} + +{- arch-tag: BZip2 files +Copyright (C) 2005 John Goerzen + +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 diff --git a/src/MissingPy/FileArchive/GZip.hs b/src/MissingPy/FileArchive/GZip.hs new file mode 100644 --- /dev/null +++ b/src/MissingPy/FileArchive/GZip.hs @@ -0,0 +1,68 @@ +{-# LANGUAGE OverlappingInstances#-} + +{- arch-tag: GZip files +Copyright (C) 2005 John Goerzen + +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 diff --git a/src/Python/Exceptions.hs b/src/Python/Exceptions.hs new file mode 100644 --- /dev/null +++ b/src/Python/Exceptions.hs @@ -0,0 +1,111 @@ +{- arch-tag: Python low-level exception handling +Copyright (C) 2005 John Goerzen + +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 + diff --git a/src/Python/Exceptions/ExcTypes.hsc b/src/Python/Exceptions/ExcTypes.hsc new file mode 100644 --- /dev/null +++ b/src/Python/Exceptions/ExcTypes.hsc @@ -0,0 +1,273 @@ +{- NOTICE -- THIS FILE IS AUTO-GENERATED -- DO NOT EDIT +MissingPy: Haskell Python Interface libraries +Copyright (C) 2004 - 2005 John Goerzen + +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 +. + +Please note that windowsError is available only on Microsoft platforms. + +Written by John Goerzen, jgoerzen\@complete.org +-} +#include +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 + diff --git a/src/Python/ForeignImports.hsc b/src/Python/ForeignImports.hsc new file mode 100644 --- /dev/null +++ b/src/Python/ForeignImports.hsc @@ -0,0 +1,215 @@ +{- arch-tag: Python foreign imports +Copyright (C) 2005 John Goerzen + +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 + diff --git a/src/Python/Interpreter.hs b/src/Python/Interpreter.hs new file mode 100644 --- /dev/null +++ b/src/Python/Interpreter.hs @@ -0,0 +1,255 @@ +{-# LANGUAGE CPP, OverlappingInstances #-} + +{- arch-tag: Python interpreter module +Copyright (C) 2005 John Goerzen + +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 + diff --git a/src/Python/Objects.hs b/src/Python/Objects.hs new file mode 100644 --- /dev/null +++ b/src/Python/Objects.hs @@ -0,0 +1,506 @@ +{-# LANGUAGE OverlappingInstances#-} + +{- arch-tag: Python type instances +Copyright (C) 2005 John Goerzen + +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 + + diff --git a/src/Python/Objects/Dict.hs b/src/Python/Objects/Dict.hs new file mode 100644 --- /dev/null +++ b/src/Python/Objects/Dict.hs @@ -0,0 +1,137 @@ +{-# LANGUAGE OverlappingInstances#-} + +{- arch-tag: Python dict-like objects +Copyright (C) 2005 John Goerzen + +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 () + ) + + + + diff --git a/src/Python/Objects/File.hs b/src/Python/Objects/File.hs new file mode 100644 --- /dev/null +++ b/src/Python/Objects/File.hs @@ -0,0 +1,213 @@ +{-# LANGUAGE OverlappingInstances#-} + +{- arch-tag: Python file-like objects +Copyright (C) 2005 John Goerzen + +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 _ = "" + +{- | 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 + diff --git a/src/Python/Types.hs b/src/Python/Types.hs new file mode 100644 --- /dev/null +++ b/src/Python/Types.hs @@ -0,0 +1,93 @@ +{-# LANGUAGE CPP #-} +{- arch-tag: Python types +Copyright (C) 2005 John Goerzen + +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 + diff --git a/src/Python/Utils.hs b/src/Python/Utils.hs new file mode 100644 --- /dev/null +++ b/src/Python/Utils.hs @@ -0,0 +1,159 @@ +{- arch-tag: Python low-level utilities +Copyright (C) 2005 John Goerzen + +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) + diff --git a/testfiles/bz2files/empty.bz2 b/testfiles/bz2files/empty.bz2 new file mode 100644 Binary files /dev/null and b/testfiles/bz2files/empty.bz2 differ diff --git a/testfiles/bz2files/t1.bz2 b/testfiles/bz2files/t1.bz2 new file mode 100644 Binary files /dev/null and b/testfiles/bz2files/t1.bz2 differ diff --git a/testfiles/bz2files/t2.bz2 b/testfiles/bz2files/t2.bz2 new file mode 100644 Binary files /dev/null and b/testfiles/bz2files/t2.bz2 differ diff --git a/testfiles/bz2files/zeros.bz2 b/testfiles/bz2files/zeros.bz2 new file mode 100644 Binary files /dev/null and b/testfiles/bz2files/zeros.bz2 differ diff --git a/testfiles/gzfiles/empty.gz b/testfiles/gzfiles/empty.gz new file mode 100644 Binary files /dev/null and b/testfiles/gzfiles/empty.gz differ diff --git a/testfiles/gzfiles/t1.gz b/testfiles/gzfiles/t1.gz new file mode 100644 Binary files /dev/null and b/testfiles/gzfiles/t1.gz differ diff --git a/testfiles/gzfiles/t1bad.gz b/testfiles/gzfiles/t1bad.gz new file mode 100644 Binary files /dev/null and b/testfiles/gzfiles/t1bad.gz differ diff --git a/testfiles/gzfiles/t2.gz b/testfiles/gzfiles/t2.gz new file mode 100644 Binary files /dev/null and b/testfiles/gzfiles/t2.gz differ diff --git a/testfiles/gzfiles/zeros.gz b/testfiles/gzfiles/zeros.gz new file mode 100644 Binary files /dev/null and b/testfiles/gzfiles/zeros.gz differ