├── .gitignore ├── .travis.yml ├── README.md ├── Setup.hs ├── cbits ├── hscpython-shim.c └── hscpython-shim.h ├── changelog.md ├── configure ├── configure.ac ├── cpython.buildinfo.in ├── cpython.cabal ├── flake.lock ├── flake.nix ├── lib ├── CPython.chs └── CPython │ ├── Constants.chs │ ├── Internal.chs │ ├── Protocols │ ├── Iterator.chs │ ├── Mapping.chs │ ├── Number.chs │ ├── Object.chs │ ├── Object │ │ └── Enums.chs │ └── Sequence.chs │ ├── Reflection.chs │ ├── Simple.hs │ ├── Simple │ └── Instances.hs │ ├── System.chs │ ├── Types.hs │ └── Types │ ├── ByteArray.chs │ ├── Bytes.chs │ ├── Capsule.chs │ ├── Cell.chs │ ├── Code.chs │ ├── Complex.chs │ ├── Dictionary.chs │ ├── Exception.chs │ ├── Float.chs │ ├── Function.chs │ ├── InstanceMethod.chs │ ├── Integer.chs │ ├── Iterator.chs │ ├── List.chs │ ├── Method.chs │ ├── Module.chs │ ├── Set.chs │ ├── Slice.chs │ ├── Tuple.chs │ ├── Type.chs │ ├── Unicode.chs │ └── WeakReference.chs ├── license.txt ├── stack.yaml └── tests └── Tests.hs /.gitignore: -------------------------------------------------------------------------------- 1 | dist-newstyle 2 | **/.stack-work 3 | 4 | *.swo 5 | *.swp 6 | *.swn 7 | 8 | stack.yaml.lock 9 | 10 | *.m4 11 | autom4te* -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | # This is the complex Travis configuration, which is intended for use 2 | # on open source libraries which need compatibility across multiple GHC 3 | # versions, must work with cabal-install, and should be 4 | # cross-platform. For more information and other options, see: 5 | # 6 | # https://docs.haskellstack.org/en/stable/travis_ci/ 7 | # 8 | # Copy these contents into the root directory of your Github project in a file 9 | # named .travis.yml 10 | 11 | # Do not choose a language; we provide our own build tools. 12 | # NOTE the above pertains to the GHC build tools, not the python build tools. 13 | language: python 14 | 15 | # Use new container infrastructure to enable caching 16 | sudo: required 17 | 18 | dist: xenial 19 | 20 | # Caching so the next build will be fast too. 21 | cache: 22 | directories: 23 | - $HOME/.ghc 24 | - $HOME/.cabal 25 | - $HOME/.stack 26 | - $TRAVIS_BUILD_DIR/.stack-work 27 | 28 | # The different configurations we want to test. We have BUILD=cabal which uses 29 | # cabal-install, and BUILD=stack which uses Stack. More documentation on each 30 | # of those below. 31 | # 32 | # We set the compiler values here to tell Travis to use a different 33 | # cache file per set of arguments. 34 | # 35 | # If you need to have different apt packages for each combination in the 36 | # matrix, you can use a line such as: 37 | # addons: {apt: {packages: [libfcgi-dev,libgmp-dev]}} 38 | matrix: 39 | include: 40 | # The Stack builds. We can pass in arbitrary Stack arguments via the ARGS 41 | # variable, such as using --stack-yaml to point to a different file. 42 | - env: BUILD=stack ARGS="" 43 | python: 3.8 44 | compiler: ": #stack default" 45 | addons: {apt: {packages: [ pkg-config]}} 46 | 47 | - env: BUILD=stack ARGS="" 48 | python: 3.9 49 | compiler: ": #stack default" 50 | addons: {apt: {packages: [ pkg-config]}} 51 | 52 | - env: BUILD=stack ARGS="--resolver lts-9" 53 | python: 3.9 54 | compiler: ": #stack 8.0.2" 55 | addons: {apt: {packages: [ pkg-config]}} 56 | 57 | - env: BUILD=stack ARGS="--resolver lts-11" 58 | python: 3.9 59 | compiler: ": #stack 8.2.2" 60 | addons: {apt: {packages: [ pkg-config]}} 61 | 62 | - env: BUILD=stack ARGS="--resolver lts-12" 63 | python: 3.9 64 | compiler: ": #stack 8.4.3" 65 | addons: {apt: {packages: [ pkg-config]}} 66 | 67 | - env: BUILD=stack ARGS="--resolver nightly" 68 | python: 3.9 69 | compiler: ": #stack nightly" 70 | addons: {apt: {packages: [ pkg-config]}} 71 | 72 | allow_failures: 73 | - env: BUILD=stack ARGS="--resolver nightly" 74 | 75 | before_install: 76 | # Using compiler above sets CC to an invalid value, so unset it 77 | - unset CC 78 | 79 | # We want to always allow newer versions of packages when building on GHC HEAD 80 | - CABALARGS="" 81 | - if [ "x$GHCVER" = "xhead" ]; then CABALARGS=--allow-newer; fi 82 | 83 | # Download and unpack the stack executable 84 | - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$HOME/.local/bin:/opt/alex/$ALEXVER/bin:/opt/happy/$HAPPYVER/bin:$HOME/.cabal/bin:$PATH 85 | - mkdir -p ~/.local/bin 86 | - | 87 | if [ `uname` = "Darwin" ] 88 | then 89 | travis_retry curl --insecure -L https://get.haskellstack.org/stable/osx-x86_64.tar.gz | tar xz --strip-components=1 --include '*/stack' -C ~/.local/bin 90 | else 91 | travis_retry curl -L https://get.haskellstack.org/stable/linux-x86_64.tar.gz | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack' 92 | fi 93 | 94 | # Use the more reliable S3 mirror of Hackage 95 | mkdir -p $HOME/.cabal 96 | echo 'remote-repo: hackage.haskell.org:http://hackage.fpcomplete.com/' > $HOME/.cabal/config 97 | echo 'remote-repo-cache: $HOME/.cabal/packages' >> $HOME/.cabal/config 98 | 99 | 100 | install: 101 | - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]" 102 | - if [ -f configure.ac ]; then autoreconf -i; fi 103 | - | 104 | stack --no-terminal --install-ghc $ARGS test --bench --only-dependencies 105 | 106 | 107 | script: 108 | - | 109 | PKG_CONFIG_PATH="${VIRTUAL_ENV}/lib/pkgconfig:${PKG_CONFIG_PATH}" 110 | PKG_CONFIG_PATH=$(python-config --prefix)/lib/pkgconfig:${PKG_CONFIG_PATH} 111 | echo $PKG_CONFIG_PATH 112 | export PKG_CONFIG_PATH 113 | stack --no-terminal $ARGS test --bench --no-run-benchmarks --haddock --no-haddock-deps 114 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Haskell CPython C bindings [![Build Status](https://travis-ci.org/zsedem/haskell-cpython.svg?branch=main)](https://travis-ci.org/zsedem/haskell-cpython) 2 | 3 | This library provides C bindings to more or less all of the python3 C API. 4 | 5 | > WARNING: Note that the python 3 C API might be quite stable, BUT the [ABI](https://docs.python.org/3/c-api/stable.html) is not, which 6 | means if you compiled with a certain minor version (3.7.1) you should run your program 7 | with the same minor version (3.7.x). (Using docker or nix to package your program is enough 8 | to avoid this problem) 9 | 10 | ## Writing a Haskell wrapper over a Python module 11 | 12 | The easiest way to get started is to `import CPython.Simple` 13 | 14 | The `Simple` API surface is fairly small, so if you're doing something fancy you may need to dip into other parts of `CPython` 15 | 16 | ### General Info 17 | 18 | `initialize :: IO ()` kicks off talking to Python, and will need to be called before using other functions. 19 | 20 | The `ToPy` and `FromPy` instances are what let us convert Haskell values to and from the corresponding Python values. There are `easyToPy` and `easyFromPy` helpers to help you easily write your own instances in common cases. If you find an instance for some common Haskell type is missing, please submit a PR! 21 | 22 | `Arg` is a type representing an argument to a Python function, which lets us use various Haskell types in the same list of arguments. 23 | 24 | ```haskell 25 | sampleArgs :: [Arg] 26 | sampleArgs = 27 | [ arg (7 :: Integer) 28 | , arg ("hello" :: Text) 29 | ] 30 | ``` 31 | 32 | ### Calling Functions 33 | 34 | The most common use case is to call some Python function, which we can do with `call` 35 | 36 | ```haskell 37 | call 38 | :: FromPy a 39 | => Text -- ^ module name 40 | -> Text -- ^ function name 41 | -> [Arg] -- ^ args 42 | -> [(Text, Arg)] -- ^ keyword args 43 | -> IO a 44 | ``` 45 | 46 | For example, if we wanted to wrap Python's `random.randint(low, high)`, we could write this: 47 | 48 | ```haskell 49 | randint :: Integer -> Integer -> IO Integer 50 | randint low high = 51 | call "random" "randint" [arg low, arg high] [] 52 | ``` 53 | 54 | Because of the `FromPy` instance in `call`'s type signature, we can infer what to do to convert a Python value back into Haskell, if given the type 55 | 56 | ```haskell 57 | uniform :: Integer -> Integer -> IO Double 58 | uniform low high = 59 | call "random" "uniform" [arg low, arg high] [] 60 | ``` 61 | 62 | We can also use the `TypeApplications` language extension to do this, if needed 63 | 64 | ```haskell 65 | call @Double "random" "uniform" [arg low, arg high] [] 66 | ``` 67 | 68 | Calling a function with mixed positional and keyword arguments is also fairly straightforward: 69 | 70 | ```haskell 71 | moveToDuration :: Integer -> Integer -> Double -> IO () 72 | moveToDuration x y seconds = 73 | call "pyautogui" "moveTo" [arg x, arg y] [("duration", arg seconds)] 74 | ``` 75 | 76 | ### Getting and Setting Attributes 77 | 78 | `getAttribute` lets us get the value of an attribute of some Python module 79 | 80 | ```haskell 81 | getAttribute 82 | :: FromPy a 83 | => Text -- ^ module name 84 | -> Text -- ^ attribute name 85 | -> IO a 86 | ``` 87 | 88 | Here, we get the value of `random.BPF` 89 | 90 | ```haskell 91 | getBpf :: IO Integer 92 | getBpf = getAttribute "random" "BPF" 93 | ``` 94 | 95 | Likewise, `setAttribute` lets us set the value of an attribute 96 | 97 | ```haskell 98 | setAttribute 99 | :: ToPy a 100 | => Text -- ^ module name 101 | -> Text -- ^ attribute name 102 | -> a -- ^ value to set attribute to 103 | -> IO () 104 | ``` 105 | 106 | Here's how we can set `random.BPF` to some given number `n` 107 | 108 | ```haskell 109 | setBpf :: Integer -> IO () 110 | setBpf n = setAttribute "random" "BPF" n 111 | ``` 112 | 113 | ## Using the Low Level API 114 | 115 | Sometimes it might be useful to use the less simpler API, especially if you are 116 | already familiar with the [CPython C API](https://docs.python.org/3/c-api/index.html). 117 | This API comes with one-on-one connections between the C API methods and the Haskell methods, 118 | but you won't have to write FFI code directly (like calling incref/decref for Python GC). 119 | 120 | After you are familiar with the concepts from the C API, you can search for 121 | methods in the [API docs](http://hackage.haskell.org/package/cpython-3.5.0) on hackage 122 | 123 | These examples below should help you start with using the API, by showing the 124 | equivalent haskell code to implement the same as the python example. 125 | 126 | ### Using `builtins.sum` function 127 | ```haskell 128 | sumWithPy :: [Integer] -> IO Int 129 | sumWithPy intlist = do 130 | testList <- traverse toObj intlist >>= PyList.toList >>= (return . Py.toObject) 131 | builtinsModule <- Py.importModule "builtins" 132 | sumFunc <- PyUnicode.toUnicode "sum" >>= Py.getAttribute builtinsModule 133 | args <- PyTuple.toTuple [testList] 134 | kwargs <- PyDict.new 135 | Py.call sumFunc args kwargs >>= castToNumber >>= Py.toInteger >>= PyInt.fromInteger 136 | where 137 | castToNumber obj = do x <- Py.castToNumber obj 138 | return $ fromMaybe (error "not a number returned from the sum") x 139 | toObj integer = fmap Py.toObject $ PyInt.toInteger integer 140 | ``` 141 | This example should show you how different it is to call python from strongly typed code, because you have to 142 | handle every bit of the errors, like getting an attribute of a module or just creating new python objects. 143 | 144 | ```python 145 | intlist = [1, 10, 100, 42] 146 | sum(intlist) 147 | ``` 148 | ### Printing traceback from python 149 | This example is an approach to handle python exceptions, like python would do it, so if an exception comes, we print a traceback 150 | ```haskell 151 | {-# LANGUAGE OverloadedStrings #-} 152 | module Main 153 | ( main ) where 154 | 155 | import qualified CPython as Py 156 | import qualified CPython.Types.Module as Py 157 | import qualified CPython.Types.Dictionary as PyDict 158 | import qualified CPython.Types.List as PyList 159 | import qualified CPython.Types.Tuple as PyTuple 160 | import qualified CPython.Types.Unicode as PyUnicode 161 | import qualified CPython.Types.Exception as PyExc 162 | import Data.Text() 163 | import Control.Exception(handle) 164 | 165 | main :: IO () 166 | main = handle pyExceptionHandler $ do 167 | Py.initialize 168 | callingSomePython 169 | Py.finalize 170 | where 171 | pyExceptionHandler :: PyExc.Exception -> IO () 172 | pyExceptionHandler exception = handle pyExceptionHandlerWithoutPythonTraceback $ do 173 | tracebackModule <- Py.importModule "traceback" 174 | print_exc <- PyUnicode.toUnicode "print_exception" >>= Py.getAttribute tracebackModule 175 | kwargs <- PyDict.new 176 | args <- case PyExc.exceptionTraceback exception of 177 | Just tb -> PyTuple.toTuple [PyExc.exceptionType exception, PyExc.exceptionValue exception, tb] 178 | _ -> PyTuple.toTuple [PyExc.exceptionType exception, PyExc.exceptionValue exception] 179 | _ <- Py.call print_exc args kwargs 180 | return () 181 | pyExceptionHandlerWithoutPythonTraceback :: PyExc.Exception -> IO () 182 | pyExceptionHandlerWithoutPythonTraceback exception = do 183 | print exception 184 | putStrLn "Unexpected Python exception (Please report a bug)" 185 | 186 | callingSomePython :: IO () 187 | callingSomePython = do ... 188 | ``` 189 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMainWithHooks autoconfUserHooks 3 | -------------------------------------------------------------------------------- /cbits/hscpython-shim.c: -------------------------------------------------------------------------------- 1 | /** 2 | * Copyright (C) 2009 John Millikin 3 | * 4 | * This program is free software: you can redistribute it and/or modify 5 | * it under the terms of the GNU General Public License as published by 6 | * the Free Software Foundation, either version 3 of the License, or 7 | * any later version. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU General Public License for more details. 13 | * 14 | * You should have received a copy of the GNU General Public License 15 | * along with this program. If not, see . 16 | **/ 17 | 18 | #include 19 | 20 | /* Initialization helpers */ 21 | static wchar_t *program_name = NULL; 22 | static wchar_t *python_home = NULL; 23 | 24 | static wchar_t *hscpython_wcsdup(wchar_t *s) 25 | { 26 | size_t len = 0; 27 | wchar_t *orig = s, *new, *new0; 28 | 29 | if (!s) { 30 | return s; 31 | } 32 | 33 | while (*(s++)) { 34 | len++; 35 | } 36 | 37 | new = new0 = malloc(sizeof(wchar_t) * len); 38 | s = orig; 39 | while (*(new++) = *(s++)) { 40 | } 41 | return new0; 42 | } 43 | 44 | void hscpython_SetProgramName(wchar_t *s) 45 | { 46 | free(program_name); 47 | program_name = hscpython_wcsdup(s); 48 | Py_SetProgramName(program_name); 49 | } 50 | 51 | void hscpython_SetPythonHome(wchar_t *s) 52 | { 53 | free(python_home); 54 | python_home = hscpython_wcsdup(s); 55 | Py_SetPythonHome(python_home); 56 | } 57 | 58 | /* Object */ 59 | void hscpython_Py_INCREF(PyObject *o) 60 | { Py_INCREF(o); } 61 | 62 | void hscpython_Py_DECREF(PyObject *o) 63 | { Py_DECREF(o); } 64 | 65 | int hscpython_PyObject_DelAttr(PyObject *o, PyObject *name) 66 | { return PyObject_DelAttr(o, name); } 67 | 68 | int hscpython_PyObject_TypeCheck(PyObject *o, PyTypeObject *type) 69 | { return PyObject_TypeCheck(o, type); } 70 | 71 | int hscpython_PyIter_Check(PyObject *o) 72 | { return PyIter_Check(o); } 73 | 74 | /* Types */ 75 | PyTypeObject *hscpython_PyType_Type() 76 | { return &PyType_Type; } 77 | 78 | PyTypeObject *hscpython_PyTuple_Type() 79 | { return &PyTuple_Type; } 80 | 81 | PyTypeObject *hscpython_PyList_Type() 82 | { return &PyList_Type; } 83 | 84 | PyTypeObject *hscpython_PyDict_Type() 85 | { return &PyDict_Type; } 86 | 87 | PyTypeObject *hscpython_PyLong_Type() 88 | { return &PyLong_Type; } 89 | 90 | PyTypeObject *hscpython_PyFloat_Type() 91 | { return &PyFloat_Type; } 92 | 93 | PyTypeObject *hscpython_PyComplex_Type() 94 | { return &PyComplex_Type; } 95 | 96 | PyTypeObject *hscpython_PyUnicode_Type() 97 | { return &PyUnicode_Type; } 98 | 99 | PyTypeObject *hscpython_PyBytes_Type() 100 | { return &PyBytes_Type; } 101 | 102 | PyTypeObject *hscpython_PyByteArray_Type() 103 | { return &PyByteArray_Type; } 104 | 105 | PyTypeObject *hscpython_PyCell_Type() 106 | { return &PyCell_Type; } 107 | 108 | PyTypeObject *hscpython_PyCode_Type() 109 | { return &PyCode_Type; } 110 | 111 | PyTypeObject *hscpython_PyFunction_Type() 112 | { return &PyFunction_Type; } 113 | 114 | PyTypeObject *hscpython_PyInstanceMethod_Type() 115 | { return &PyInstanceMethod_Type; } 116 | 117 | PyTypeObject *hscpython_PyMethod_Type() 118 | { return &PyMethod_Type; } 119 | 120 | PyTypeObject *hscpython_PySet_Type() 121 | { return &PySet_Type; } 122 | 123 | PyTypeObject *hscpython_PyFrozenSet_Type() 124 | { return &PyFrozenSet_Type; } 125 | 126 | PyTypeObject *hscpython_PySeqIter_Type() 127 | { return &PySeqIter_Type; } 128 | 129 | PyTypeObject *hscpython_PyCallIter_Type() 130 | { return &PyCallIter_Type; } 131 | 132 | PyTypeObject *hscpython_PySlice_Type() 133 | { return &PySlice_Type; } 134 | 135 | PyTypeObject *hscpython_PyModule_Type() 136 | { return &PyModule_Type; } 137 | 138 | PyTypeObject *hscpython_PyCapsule_Type() 139 | { return &PyCapsule_Type; } 140 | 141 | /* Constants */ 142 | PyObject *hscpython_Py_None() 143 | { return Py_None; } 144 | 145 | PyObject *hscpython_Py_True() 146 | { return Py_True; } 147 | 148 | PyObject *hscpython_Py_False() 149 | { return Py_False; } 150 | 151 | /* Unicode */ 152 | Py_ssize_t hscpython_PyUnicode_GetSize(PyObject *o) 153 | { return PyUnicode_GET_LENGTH(o); } 154 | 155 | wchar_t *hscpython_PyUnicode_AsUnicode(PyObject *o) 156 | { wchar_t *wstr; 157 | Py_ssize_t actual_size; 158 | actual_size = PyUnicode_AsWideChar(o, NULL, 0); 159 | wstr = malloc(actual_size); 160 | PyUnicode_AsWideChar(o, wstr, actual_size); 161 | return wstr; 162 | } 163 | 164 | PyObject *hscpython_PyUnicode_FromUnicode(const wchar_t *u, Py_ssize_t size) 165 | { return PyUnicode_FromWideChar(u, size); } 166 | 167 | PyObject *hscpython_PyUnicode_FromEncodedObject(PyObject *o, const char *enc, const char *err) 168 | { return PyUnicode_FromEncodedObject(o, enc, err); } 169 | 170 | PyObject *hscpython_PyUnicode_AsEncodedString(PyObject *o, const char *enc, const char *err) 171 | { return PyUnicode_AsEncodedString(o, enc, err); } 172 | 173 | PyObject *hscpython_PyUnicode_FromObject(PyObject *o) 174 | { return PyUnicode_FromObject(o); } 175 | 176 | PyObject *hscpython_PyUnicode_Decode(const char *s, Py_ssize_t len, const char *enc, const char *err) 177 | { return PyUnicode_Decode(s, len, enc, err); } 178 | 179 | PyObject *hscpython_PyUnicode_Concat(PyObject *l, PyObject *r) 180 | { return PyUnicode_Concat(l, r); } 181 | 182 | PyObject *hscpython_PyUnicode_Split(PyObject *s, PyObject *sep, Py_ssize_t max) 183 | { return PyUnicode_Split(s, sep, max); } 184 | 185 | PyObject *hscpython_PyUnicode_Splitlines(PyObject *s, int keep) 186 | { return PyUnicode_Splitlines(s, keep); } 187 | 188 | PyObject *hscpython_PyUnicode_Translate(PyObject *str, PyObject *table, const char *err) 189 | { return PyUnicode_Translate(str, table, err); } 190 | 191 | PyObject *hscpython_PyUnicode_Join(PyObject *sep, PyObject *seq) 192 | { return PyUnicode_Join(sep, seq); } 193 | 194 | int hscpython_PyUnicode_Tailmatch(PyObject *str, PyObject *substr, Py_ssize_t start, Py_ssize_t end, int dir) 195 | { return PyUnicode_Tailmatch(str, substr, start, end, dir); } 196 | 197 | Py_ssize_t hscpython_PyUnicode_Find(PyObject *str, PyObject *substr, Py_ssize_t start, Py_ssize_t end, int dir) 198 | { return PyUnicode_Find(str, substr, start, end, dir); } 199 | 200 | Py_ssize_t hscpython_PyUnicode_Count(PyObject *str, PyObject *substr, Py_ssize_t start, Py_ssize_t end) 201 | { return PyUnicode_Count(str, substr, start, end); } 202 | 203 | PyObject *hscpython_PyUnicode_Replace(PyObject *str, PyObject *substr, PyObject *replstr, Py_ssize_t max) 204 | { return PyUnicode_Replace(str, substr, replstr, max); } 205 | 206 | PyObject *hscpython_PyUnicode_Format(PyObject *format, PyObject *args) 207 | { return PyUnicode_Format(format, args); } 208 | 209 | int hscpython_PyUnicode_Contains(PyObject *a, PyObject *b) 210 | { return PyUnicode_Contains(a, b); } 211 | 212 | /* Lists */ 213 | void hscpython_peek_list(PyObject *list, Py_ssize_t size, PyObject **objs) 214 | { 215 | Py_ssize_t ii; 216 | 217 | for (ii = 0; ii < size; ii++) { 218 | objs[ii] = PyList_GET_ITEM(list, ii); 219 | } 220 | } 221 | 222 | PyObject *hscpython_poke_list(size_t count, PyObject **objs) 223 | { 224 | PyObject *list; 225 | size_t ii; 226 | 227 | if (!(list = PyList_New(count))) { 228 | return NULL; 229 | } 230 | 231 | for (ii = 0; ii < count; ii++) { 232 | Py_INCREF(objs[ii]); 233 | PyList_SET_ITEM(list, ii, objs[ii]); 234 | } 235 | return list; 236 | } 237 | 238 | /* Tuples */ 239 | void hscpython_peek_tuple(PyObject *tuple, Py_ssize_t size, PyObject **objs) 240 | { 241 | Py_ssize_t ii; 242 | 243 | for (ii = 0; ii < size; ii++) { 244 | objs[ii] = PyTuple_GET_ITEM(tuple, ii); 245 | } 246 | } 247 | 248 | PyObject *hscpython_poke_tuple(size_t count, PyObject **objs) 249 | { 250 | PyObject *tuple; 251 | size_t ii; 252 | 253 | if (!(tuple = PyTuple_New(count))) { 254 | return NULL; 255 | } 256 | 257 | for (ii = 0; ii < count; ii++) { 258 | Py_INCREF(objs[ii]); 259 | PyTuple_SET_ITEM(tuple, ii, objs[ii]); 260 | } 261 | return tuple; 262 | } 263 | -------------------------------------------------------------------------------- /cbits/hscpython-shim.h: -------------------------------------------------------------------------------- 1 | #ifndef HSCPYTHON_SHIM_H 2 | #define HSCPYTHON_SHIM_H 3 | 4 | #include 5 | 6 | /* Initialization helpers */ 7 | void hscpython_SetProgramName(wchar_t *); 8 | void hscpython_SetPythonHome(wchar_t *); 9 | 10 | /* Object */ 11 | void hscpython_Py_INCREF(PyObject *); 12 | void hscpython_Py_DECREF(PyObject *); 13 | int hscpython_PyObject_DelAttr(PyObject *, PyObject *); 14 | int hscpython_PyObject_TypeCheck(PyObject *, PyTypeObject *); 15 | int hscpython_PyIter_Check(PyObject *); 16 | 17 | enum HSCPythonComparisonEnum 18 | { HSCPYTHON_LT = Py_LT 19 | , HSCPYTHON_LE = Py_LE 20 | , HSCPYTHON_EQ = Py_EQ 21 | , HSCPYTHON_NE = Py_NE 22 | , HSCPYTHON_GT = Py_GT 23 | , HSCPYTHON_GE = Py_GE 24 | }; 25 | 26 | /* Types */ 27 | PyTypeObject *hscpython_PyType_Type(); 28 | PyTypeObject *hscpython_PyTuple_Type(); 29 | PyTypeObject *hscpython_PyList_Type(); 30 | PyTypeObject *hscpython_PyDict_Type(); 31 | PyTypeObject *hscpython_PyLong_Type(); 32 | PyTypeObject *hscpython_PyFloat_Type(); 33 | PyTypeObject *hscpython_PyComplex_Type(); 34 | PyTypeObject *hscpython_PyUnicode_Type(); 35 | PyTypeObject *hscpython_PyBytes_Type(); 36 | PyTypeObject *hscpython_PyByteArray_Type(); 37 | PyTypeObject *hscpython_PyCell_Type(); 38 | PyTypeObject *hscpython_PyCode_Type(); 39 | PyTypeObject *hscpython_PyFunction_Type(); 40 | PyTypeObject *hscpython_PyInstanceMethod_Type(); 41 | PyTypeObject *hscpython_PyMethod_Type(); 42 | PyTypeObject *hscpython_PySet_Type(); 43 | PyTypeObject *hscpython_PyFrozenSet_Type(); 44 | PyTypeObject *hscpython_PySeqIter_Type(); 45 | PyTypeObject *hscpython_PyCallIter_Type(); 46 | PyTypeObject *hscpython_PySlice_Type(); 47 | PyTypeObject *hscpython_PyModule_Type(); 48 | PyTypeObject *hscpython_PyCapsule_Type(); 49 | 50 | /* Constants */ 51 | PyObject *hscpython_Py_None(); 52 | PyObject *hscpython_Py_True(); 53 | PyObject *hscpython_Py_False(); 54 | 55 | /* Unicode */ 56 | Py_ssize_t hscpython_PyUnicode_GetSize(PyObject *); 57 | wchar_t *hscpython_PyUnicode_AsUnicode(PyObject *); 58 | PyObject *hscpython_PyUnicode_FromUnicode(const wchar_t *, Py_ssize_t); 59 | PyObject *hscpython_PyUnicode_FromEncodedObject(PyObject *, const char *, const char *); 60 | PyObject *hscpython_PyUnicode_AsEncodedString(PyObject *, const char *, const char *); 61 | PyObject *hscpython_PyUnicode_FromObject(PyObject *); 62 | PyObject *hscpython_PyUnicode_Decode(const char *, Py_ssize_t, const char *, const char *); 63 | PyObject *hscpython_PyUnicode_Concat(PyObject *, PyObject *); 64 | PyObject *hscpython_PyUnicode_Split(PyObject *, PyObject *, Py_ssize_t); 65 | PyObject *hscpython_PyUnicode_Splitlines(PyObject *, int); 66 | PyObject *hscpython_PyUnicode_Translate(PyObject *, PyObject *, const char *); 67 | PyObject *hscpython_PyUnicode_Join(PyObject *, PyObject *); 68 | int hscpython_PyUnicode_Tailmatch(PyObject *, PyObject *, Py_ssize_t, Py_ssize_t, int); 69 | Py_ssize_t hscpython_PyUnicode_Find(PyObject *, PyObject *, Py_ssize_t, Py_ssize_t, int); 70 | Py_ssize_t hscpython_PyUnicode_Count(PyObject *, PyObject *, Py_ssize_t, Py_ssize_t); 71 | PyObject *hscpython_PyUnicode_Replace(PyObject *, PyObject *, PyObject *, Py_ssize_t); 72 | PyObject *hscpython_PyUnicode_Format(PyObject *, PyObject *); 73 | int hscpython_PyUnicode_Contains(PyObject *, PyObject *); 74 | 75 | /* Lists */ 76 | void hscpython_peek_list(PyObject *, Py_ssize_t, PyObject **); 77 | PyObject *hscpython_poke_list(size_t, PyObject **); 78 | 79 | /* Tuples */ 80 | void hscpython_peek_tuple(PyObject *, Py_ssize_t, PyObject **); 81 | PyObject *hscpython_poke_tuple(size_t, PyObject **); 82 | 83 | #endif 84 | -------------------------------------------------------------------------------- /changelog.md: -------------------------------------------------------------------------------- 1 | # 3.5.1 2 | 3 | * add new API for simple usage (See readme for details) 4 | * improve hackage page 5 | 6 | # 3.5.0 7 | 8 | * made the compilation compatible with different python3 versions 9 | * fix a bug, which caused various garbage collection calls to result in SEGEGV 10 | * cabal metadata changes 11 | 12 | ## Moved from [jmillikin/haskell-cpython](https://github.com/jmillikin/haskell-cpython) to [zsedem/haskell-cpython](https://github.com/zsedem/haskell-cpython) 13 | -------------------------------------------------------------------------------- /configure.ac: -------------------------------------------------------------------------------- 1 | # Meta information about package to configure 2 | AC_INIT([cpython], [3.5.1], [phillip.seeber@uni-jena.de]) 3 | 4 | # Check for the cpython.cabal file to be sure we are in the correct directory 5 | AC_CONFIG_SRCDIR([cpython.cabal]) 6 | 7 | # Verify we have a working C-compiler available 8 | AC_PROG_CC 9 | 10 | # Check for Python3 libraries and headers 11 | AM_PATH_PYTHON([3.8]) 12 | 13 | # Get linking for an embedded python interpreter via `python-config`. Required 14 | # for correct linking 15 | AC_MSG_CHECKING([for Python libs]) 16 | AS_IF([$PYTHON-config --libs --embed], 17 | [ PYTHON_LIBS=$($PYTHON-config --libs --embed) ], 18 | [AC_MSG_ERROR([Python libs not found])] 19 | ) 20 | # Now, actually add the libraries returned by python-config to a CUSTOM_LIBS set. 21 | # We can not use LIBS, as this will ruin M4 macros such as AC_SEARCH_LIBS if we 22 | # interfere with LIBS manually. 23 | PY_LIBS=(${PYTHON_LIBS// / }) 24 | for LIB in "${PY_LIBS@<:@@@:>@}"; do 25 | [[ "${LIB:0:2}" == "-l" ]] && CUSTOM_LIBS="$CUSTOM_LIBS $LIB" 26 | done 27 | 28 | # From LIBS and CUSTOM_LIBS strip "-l" to obtain a cabal-compatible list of 29 | # library names 30 | LIBARR=(${CUSTOM_LIBS//-l/ }) 31 | for LIB in "${LIBARR@<:@@@:>@}"; do 32 | CUSTOM_LIBS_NAMES="$CUSTOM_LIBS_NAMES ${LIB#-l}" 33 | done 34 | LIBARR=(${LIBS//-l/ }) 35 | for LIB in "${LIBARR@<:@@@:>@}"; do 36 | LIBS_NAMES="$LIBS_NAMES ${LIB#-l}" 37 | done 38 | 39 | # Output file to create from its corresponding *.in file, in which @VARIABLES@ 40 | # will be substituted 41 | AC_SUBST(LIBS_NAMES, $LIBS_NAMES) 42 | AC_SUBST(CUSTOM_LIBS_NAMES, $CUSTOM_LIBS_NAMES) 43 | AC_CONFIG_FILES([cpython.buildinfo]) 44 | AC_OUTPUT -------------------------------------------------------------------------------- /cpython.buildinfo.in: -------------------------------------------------------------------------------- 1 | cc-options: 2 | extra-libraries: @LIBS_NAMES@ @CUSTOM_LIBS_NAMES@ -------------------------------------------------------------------------------- /cpython.cabal: -------------------------------------------------------------------------------- 1 | name: cpython 2 | version: 3.9.0 3 | license: GPL-3 4 | license-file: license.txt 5 | author: John Millikin 6 | maintainer: Adam Zsigmond 7 | build-type: Configure 8 | cabal-version: 1.18 9 | category: Foreign 10 | homepage: https://github.com/zsedem/haskell-cpython 11 | extra-doc-files: 12 | changelog.md 13 | README.md 14 | synopsis: Bindings for libpython 15 | description: 16 | These bindings allow Haskell code to call CPython code. It is not 17 | currently possible to call Haskell code from CPython, but this feature 18 | is planned. 19 | 20 | extra-tmp-files: 21 | cpython.buildinfo 22 | 23 | extra-source-files: 24 | license.txt 25 | configure 26 | cpython.buildinfo.in 27 | 28 | source-repository head 29 | type: git 30 | location: https://github.com/zsedem/haskell-cpython 31 | 32 | library 33 | ghc-options: -Wall -O2 -fno-warn-orphans 34 | cc-options: -fPIC 35 | hs-source-dirs: lib 36 | 37 | build-depends: 38 | base >= 4.0 && < 5.0 39 | , bytestring >= 0.11.5 && < 0.13 40 | , text >= 2.0.2 && < 2.2 41 | 42 | build-tools: 43 | c2hs >= 0.15 44 | 45 | includes: 46 | cbits/hscpython-shim.h 47 | install-includes: 48 | cbits/hscpython-shim.h 49 | exposed-modules: 50 | CPython 51 | CPython.Types 52 | CPython.Types.ByteArray 53 | CPython.Types.Bytes 54 | CPython.Types.Capsule 55 | CPython.Types.Cell 56 | CPython.Types.Code 57 | CPython.Types.Complex 58 | CPython.Types.Dictionary 59 | CPython.Types.Exception 60 | CPython.Types.Float 61 | CPython.Types.Function 62 | CPython.Types.InstanceMethod 63 | CPython.Types.Integer 64 | CPython.Types.Iterator 65 | CPython.Types.List 66 | CPython.Types.Method 67 | CPython.Types.Module 68 | CPython.Types.Set 69 | CPython.Types.Slice 70 | CPython.Types.Tuple 71 | CPython.Types.Type 72 | CPython.Types.Unicode 73 | CPython.Types.WeakReference 74 | CPython.Protocols.Iterator 75 | CPython.Protocols.Mapping 76 | CPython.Protocols.Number 77 | CPython.Protocols.Object 78 | CPython.Protocols.Object.Enums 79 | CPython.Protocols.Sequence 80 | CPython.Constants 81 | CPython.Reflection 82 | CPython.Simple 83 | CPython.Simple.Instances 84 | CPython.System 85 | 86 | other-modules: 87 | CPython.Internal 88 | 89 | c-sources: cbits/hscpython-shim.c 90 | include-dirs: cbits 91 | pkgconfig-depends: python3 92 | default-language: Haskell2010 93 | 94 | test-suite cpython-testsuite 95 | type: exitcode-stdio-1.0 96 | main-is: Tests.hs 97 | ghc-options: -Wall -fno-warn-orphans 98 | hs-source-dirs: tests 99 | 100 | build-depends: 101 | base > 4.0 && < 5.0 102 | , text 103 | , cpython 104 | pkgconfig-depends: python3 105 | default-language: Haskell2010 106 | -------------------------------------------------------------------------------- /flake.lock: -------------------------------------------------------------------------------- 1 | { 2 | "nodes": { 3 | "flake-utils": { 4 | "inputs": { 5 | "systems": "systems" 6 | }, 7 | "locked": { 8 | "lastModified": 1731533236, 9 | "narHash": "sha256-l0KFg5HjrsfsO/JpG+r7fRrqm12kzFHyUHqHCVpMMbI=", 10 | "owner": "numtide", 11 | "repo": "flake-utils", 12 | "rev": "11707dc2f618dd54ca8739b309ec4fc024de578b", 13 | "type": "github" 14 | }, 15 | "original": { 16 | "owner": "numtide", 17 | "repo": "flake-utils", 18 | "type": "github" 19 | } 20 | }, 21 | "nixpkgs": { 22 | "locked": { 23 | "lastModified": 1737110817, 24 | "narHash": "sha256-DSenga8XjPaUV5KUFW/i3rNkN7jm9XmguW+qQ1ZJTR4=", 25 | "owner": "nixos", 26 | "repo": "nixpkgs", 27 | "rev": "041c867bad68dfe34b78b2813028a2e2ea70a23c", 28 | "type": "github" 29 | }, 30 | "original": { 31 | "owner": "nixos", 32 | "ref": "nixpkgs-unstable", 33 | "repo": "nixpkgs", 34 | "type": "github" 35 | } 36 | }, 37 | "root": { 38 | "inputs": { 39 | "flake-utils": "flake-utils", 40 | "nixpkgs": "nixpkgs" 41 | } 42 | }, 43 | "systems": { 44 | "locked": { 45 | "lastModified": 1681028828, 46 | "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=", 47 | "owner": "nix-systems", 48 | "repo": "default", 49 | "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e", 50 | "type": "github" 51 | }, 52 | "original": { 53 | "owner": "nix-systems", 54 | "repo": "default", 55 | "type": "github" 56 | } 57 | } 58 | }, 59 | "root": "root", 60 | "version": 7 61 | } 62 | -------------------------------------------------------------------------------- /flake.nix: -------------------------------------------------------------------------------- 1 | { 2 | description = "Haskell CPython C bindings"; 3 | 4 | inputs = { 5 | nixpkgs.url = "github:nixos/nixpkgs/nixpkgs-unstable"; 6 | flake-utils.url = "github:numtide/flake-utils"; 7 | }; 8 | 9 | outputs = { self, nixpkgs, flake-utils }: 10 | let 11 | overlay = final: prev: { 12 | haskell = prev.haskell // { 13 | packageOverrides = hfinal: hprev: 14 | prev.haskell.packageOverrides hfinal hprev // ({ 15 | cpython = prev.haskell.lib.overrideCabal (hfinal.callCabal2nix "cpython" ./. { }) (old: { 16 | buildTools = with final; [ autoconf automake ]; 17 | preCompileBuildDriver = "autoreconf"; 18 | }); 19 | }); 20 | }; 21 | }; 22 | in 23 | flake-utils.lib.eachDefaultSystem 24 | (system: 25 | let 26 | 27 | pkgs = import nixpkgs { 28 | inherit system; 29 | overlays = [ overlay ]; 30 | }; 31 | in 32 | { 33 | packages.default = pkgs.haskellPackages.cpython; 34 | 35 | devShells.default = pkgs.haskellPackages.shellFor { 36 | withHoogle = true; 37 | packages = p: with p; [ cpython ]; 38 | buildInputs = (with pkgs; [ 39 | cabal-install 40 | haskell-language-server 41 | hlint 42 | pkg-config 43 | ]); 44 | shellHook = pkgs.haskellPackages.cpython.preCompileBuildDriver; 45 | }; 46 | } 47 | ) // { 48 | overlays.default = overlay; 49 | }; 50 | 51 | } 52 | -------------------------------------------------------------------------------- /lib/CPython.chs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ForeignFunctionInterface #-} 2 | 3 | -- Copyright (C) 2009 John Millikin 4 | -- 5 | -- This program is free software: you can redistribute it and/or modify 6 | -- it under the terms of the GNU General Public License as published by 7 | -- the Free Software Foundation, either version 3 of the License, or 8 | -- any later version. 9 | -- 10 | -- This program is distributed in the hope that it will be useful, 11 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | -- GNU General Public License for more details. 14 | -- 15 | -- You should have received a copy of the GNU General Public License 16 | -- along with this program. If not, see . 17 | 18 | module CPython 19 | ( initialize 20 | , isInitialized 21 | , finalize 22 | , newInterpreter 23 | , endInterpreter 24 | , getProgramName 25 | , setProgramName 26 | , getPrefix 27 | , getExecPrefix 28 | , getProgramFullPath 29 | , getPath 30 | , getVersion 31 | , getPlatform 32 | , getCopyright 33 | , getCompiler 34 | , getBuildInfo 35 | , setArgv 36 | , getPythonHome 37 | , setPythonHome 38 | ) where 39 | 40 | #include 41 | 42 | import Data.Text (Text) 43 | 44 | import CPython.Internal 45 | 46 | -- | Initialize the Python interpreter. In an application embedding Python, 47 | -- this should be called before using any other Python/C API computations; 48 | -- with the exception of 'setProgramName', 'initThreads', 49 | -- 'releaseLock', and 'acquireLock'. This initializes the table 50 | -- of loaded modules (@sys.modules@), and creates the fundamental modules 51 | -- @builtins@, @__main__@ and @sys@. It also initializes the module search 52 | -- path (@sys.path@). It does not set @sys.argv@; use 'setArgv' for that. This 53 | -- is a no-op when called for a second time (without calling 'finalize' 54 | -- first). There is no return value; it is a fatal error if the initialization 55 | -- fails. 56 | {# fun Py_Initialize as initialize 57 | {} -> `()' id #} 58 | 59 | -- | Return 'True' when the Python interpreter has been initialized, 'False' 60 | -- if not. After 'finalize' is called, this returns 'False' until 61 | -- 'initialize' is called again. 62 | {# fun Py_IsInitialized as isInitialized 63 | {} -> `Bool' #} 64 | 65 | -- | Undo all initializations made by 'initialize' and subsequent use of 66 | -- Python/C API computations, and destroy all sub-interpreters (see 67 | -- 'newInterpreter' below) that were created and not yet destroyed since the 68 | -- last call to 'initialize'. Ideally, this frees all memory allocated by the 69 | -- Python interpreter. This is a no-op when called for a second time (without 70 | -- calling 'initialize' again first). There is no return value; errors during 71 | -- finalization are ignored. 72 | -- 73 | -- This computation is provided for a number of reasons. An embedding 74 | -- application might want to restart Python without having to restart the 75 | -- application itself. An application that has loaded the Python interpreter 76 | -- from a dynamically loadable library (or DLL) might want to free all memory 77 | -- allocated by Python before unloading the DLL. During a hunt for memory 78 | -- leaks in an application a developer might want to free all memory 79 | -- allocated by Python before exiting from the application. 80 | -- 81 | -- /Bugs and caveats/: The destruction of modules and objects in modules is 82 | -- done in arbitrary order; this may cause destructors (@__del__()@ methods) 83 | -- to fail when they depend on other objects (even functions) or modules. 84 | -- Dynamically loaded extension modules loaded by Python are not unloaded. 85 | -- Small amounts of memory allocated by the Python interpreter may not be 86 | -- freed (if you find a leak, please report it). Memory tied up in circular 87 | -- references between objects is not freed. Some memory allocated by extension 88 | -- modules may not be freed. Some extensions may not work properly if their 89 | -- initialization routine is called more than once; this can happen if an 90 | -- application calls 'initialize' and 'finalize' more than once. 91 | {# fun Py_Finalize as finalize 92 | {} -> `()' id #} 93 | 94 | newtype ThreadState = ThreadState (Ptr ThreadState) 95 | 96 | -- | Create a new sub-interpreter. This is an (almost) totally separate 97 | -- environment for the execution of Python code. In particular, the new 98 | -- interpreter has separate, independent versions of all imported modules, 99 | -- including the fundamental modules @builtins@, @__main__@ and @sys@. The 100 | -- table of loaded modules (@sys.modules@) and the module search path 101 | -- (@sys.path@) are also separate. The new environment has no @sys.argv@ 102 | -- variable. It has new standard I/O stream file objects @sys.stdin@, 103 | -- @sys.stdout@ and @sys.stderr@ (however these refer to the same underlying 104 | -- @FILE@ structures in the C library). 105 | -- 106 | -- The return value points to the first thread state created in the new 107 | -- sub-interpreter. This thread state is made in the current thread state. 108 | -- Note that no actual thread is created; see the discussion of thread states 109 | -- below. If creation of the new interpreter is unsuccessful, 'Nothing' is 110 | -- returned; no exception is set since the exception state is stored in the 111 | -- current thread state and there may not be a current thread state. (Like 112 | -- all other Python/C API computations, the global interpreter lock must be 113 | -- held before calling this computation and is still held when it returns; 114 | -- however, unlike most other Python/C API computations, there 115 | -- needn’t be a current thread state on entry.) 116 | -- 117 | -- Extension modules are shared between (sub-)interpreters as follows: the 118 | -- first time a particular extension is imported, it is initialized normally, 119 | -- and a (shallow) copy of its module’s dictionary is squirreled away. 120 | -- When the same extension is imported by another (sub-)interpreter, a new 121 | -- module is initialized and filled with the contents of this copy; the 122 | -- extension’s @init@ procedure is not called. Note that this is 123 | -- different from what happens when an extension is imported after the 124 | -- interpreter has been completely re-initialized by calling 'finalize' and 125 | -- 'initialize'; in that case, the extension’s @init/module/@ 126 | -- procedure is called again. 127 | -- 128 | -- /Bugs and caveats/: Because sub-interpreters (and the main interpreter) 129 | -- are part of the same process, the insulation between them isn’t 130 | -- perfect — for example, using low-level file operations like 131 | -- @os.close()@ they can (accidentally or maliciously) affect each 132 | -- other’s open files. Because of the way extensions are shared 133 | -- between (sub-)interpreters, some extensions may not work properly; this 134 | -- is especially likely when the extension makes use of (static) global 135 | -- variables, or when the extension manipulates its module’s 136 | -- dictionary after its initialization. It is possible to insert objects 137 | -- created in one sub-interpreter into a namespace of another 138 | -- sub-interpreter; this should be done with great care to avoid sharing 139 | -- user-defined functions, methods, instances or classes between 140 | -- sub-interpreters, since import operations executed by such objects may 141 | -- affect the wrong (sub-)interpreter’s dictionary of loaded modules. 142 | -- (XXX This is a hard-to-fix bug that will be addressed in a future release.) 143 | -- 144 | -- Also note that the use of this functionality is incompatible with 145 | -- extension modules such as PyObjC and ctypes that use the @PyGILState_*()@ 146 | -- APIs (and this is inherent in the way the @PyGILState_*()@ procedures 147 | -- work). Simple things may work, but confusing behavior will always be near. 148 | newInterpreter :: IO (Maybe ThreadState) 149 | newInterpreter = do 150 | ptr <- {# call Py_NewInterpreter as ^ #} 151 | return $ if ptr == nullPtr 152 | then Nothing 153 | else Just $ ThreadState $ castPtr ptr 154 | 155 | -- | Destroy the (sub-)interpreter represented by the given thread state. 156 | -- The given thread state must be the current thread state. See the 157 | -- discussion of thread states below. When the call returns, the current 158 | -- thread state is @NULL@. All thread states associated with this 159 | -- interpreter are destroyed. (The global interpreter lock must be held 160 | -- before calling this computation and is still held when it returns.) 161 | -- 'finalize' will destroy all sub-interpreters that haven’t been 162 | -- explicitly destroyed at that point. 163 | endInterpreter :: ThreadState -> IO () 164 | endInterpreter (ThreadState ptr) = 165 | {# call Py_EndInterpreter as ^ #} $ castPtr ptr 166 | 167 | -- | Return the program name set with 'setProgramName', or the default. 168 | getProgramName :: IO Text 169 | getProgramName = pyGetProgramName >>= peekTextW 170 | 171 | foreign import ccall safe "hscpython-shim.h Py_GetProgramName" 172 | pyGetProgramName :: IO CWString 173 | 174 | -- | This computation should be called before 'initialize' is called for the 175 | -- first time, if it is called at all. It tells the interpreter the value of 176 | -- the @argv[0]@ argument to the @main@ procedure of the program. This is 177 | -- used by 'getPath' and some other computations below to find the Python 178 | -- run-time libraries relative to the interpreter executable. The default 179 | -- value is @\"python\"@. No code in the Python interpreter will change the 180 | -- program name. 181 | setProgramName :: Text -> IO () 182 | setProgramName name = withTextW name cSetProgramName 183 | 184 | foreign import ccall safe "hscpython-shim.h hscpython_SetProgramName" 185 | cSetProgramName :: CWString -> IO () 186 | 187 | -- | Return the prefix for installed platform-independent files. This is 188 | -- derived through a number of complicated rules from the program name set 189 | -- with 'setProgramName' and some environment variables; for example, if the 190 | -- program name is @\"\/usr\/local\/bin\/python\"@, the prefix is 191 | -- @\"\/usr\/local\"@. This corresponds to the @prefix@ variable in the 192 | -- top-level Makefile and the /--prefix/ argument to the @configure@ script 193 | -- at build time. The value is available to Python code as @sys.prefix@. It 194 | -- is only useful on UNIX. See also 'getExecPrefix'. 195 | getPrefix :: IO Text 196 | getPrefix = pyGetPrefix >>= peekTextW 197 | 198 | foreign import ccall safe "hscpython-shim.h Py_GetPrefix" 199 | pyGetPrefix :: IO CWString 200 | 201 | -- | Return the /exec-prefix/ for installed platform-/dependent/ files. This 202 | -- is derived through a number of complicated rules from the program name 203 | -- set with setProgramName' and some environment variables; for example, if 204 | -- the program name is @\"\/usr\/local\/bin\/python\"@, the exec-prefix is 205 | -- @\"\/usr\/local\"@. This corresponds to the @exec_prefix@ variable in the 206 | -- top-level Makefile and the /--exec-prefix/ argument to the @configure@ 207 | -- script at build time. The value is available to Python code as 208 | -- @sys.exec_prefix@. It is only useful on UNIX. 209 | -- 210 | -- Background: The exec-prefix differs from the prefix when platform 211 | -- dependent files (such as executables and shared libraries) are installed 212 | -- in a different directory tree. In a typical installation, platform 213 | -- dependent files may be installed in the @\/usr\/local\/plat@ subtree while 214 | -- platform independent may be installed in @\/usr\/local@. 215 | -- 216 | -- Generally speaking, a platform is a combination of hardware and software 217 | -- families, e.g. Sparc machines running the Solaris 2.x operating system 218 | -- are considered the same platform, but Intel machines running Solaris 219 | -- 2.x are another platform, and Intel machines running Linux are yet 220 | -- another platform. Different major revisions of the same operating system 221 | -- generally also form different platforms. Non-UNIX operating systems are a 222 | -- different story; the installation strategies on those systems are so 223 | -- different that the prefix and exec-prefix are meaningless, and set to the 224 | -- empty string. Note that compiled Python bytecode files are platform 225 | -- independent (but not independent from the Python version by which they 226 | -- were compiled!). 227 | -- 228 | -- System administrators will know how to configure the @mount@ or @automount@ 229 | -- programs to share @\/usr\/local@ between platforms while having 230 | -- @\/usr\/local\/plat@ be a different filesystem for each platform. 231 | getExecPrefix :: IO Text 232 | getExecPrefix = pyGetExecPrefix >>= peekTextW 233 | 234 | foreign import ccall safe "hscpython-shim.h Py_GetExecPrefix" 235 | pyGetExecPrefix :: IO CWString 236 | 237 | -- | Return the full program name of the Python executable; this is computed 238 | -- as a side-effect of deriving the default module search path from the 239 | -- program name (set by 'setProgramName' above). The value is available to 240 | -- Python code as @sys.executable@. 241 | getProgramFullPath :: IO Text 242 | getProgramFullPath = pyGetProgramFullPath >>= peekTextW 243 | 244 | foreign import ccall safe "hscpython-shim.h Py_GetProgramFullPath" 245 | pyGetProgramFullPath :: IO CWString 246 | 247 | -- | Return the default module search path; this is computed from the 248 | -- program name (set by 'setProgramName' above) and some environment 249 | -- variables. The returned string consists of a series of directory names 250 | -- separated by a platform dependent delimiter character. The delimiter 251 | -- character is @\':\'@ on Unix and Mac OS X, @\';\'@ on Windows. The value 252 | -- is available to Python code as the list @sys.path@, which may be modified 253 | -- to change the future search path for loaded modules. 254 | getPath :: IO Text 255 | getPath = pyGetPath >>= peekTextW 256 | 257 | foreign import ccall safe "hscpython-shim.h Py_GetPath" 258 | pyGetPath :: IO CWString 259 | 260 | -- | Return the version of this Python interpreter. This is a string that 261 | -- looks something like 262 | -- 263 | -- @ 264 | -- \"3.0a5+ (py3k:63103M, May 12 2008, 00:53:55) \\n[GCC 4.2.3]\" 265 | -- @ 266 | -- 267 | -- The first word (up to the first space character) is the current Python 268 | -- version; the first three characters are the major and minor version 269 | -- separated by a period. The value is available to Python code as 270 | -- @sys.version@. 271 | {# fun Py_GetVersion as getVersion 272 | {} -> `Text' peekText* #} 273 | 274 | -- | Return the platform identifier for the current platform. On Unix, this 275 | -- is formed from the “official” name of the operating system, 276 | -- converted to lower case, followed by the major revision number; e.g., for 277 | -- Solaris 2.x, which is also known as SunOS 5.x, the value is @\"sunos5\"@. 278 | -- On Mac OS X, it is @\"darwin\"@. On Windows, it is @\"win\"@. The value 279 | -- is available to Python code as @sys.platform@. 280 | {# fun Py_GetPlatform as getPlatform 281 | {} -> `Text' peekText* #} 282 | 283 | -- | Return the official copyright string for the current Python version, 284 | -- for example 285 | -- 286 | -- @ 287 | -- \"Copyright 1991-1995 Stichting Mathematisch Centrum, Amsterdam\" 288 | -- @ 289 | -- 290 | -- The value is available to Python code as @sys.copyright@. 291 | {# fun Py_GetCopyright as getCopyright 292 | {} -> `Text' peekText* #} 293 | 294 | -- | Return an indication of the compiler used to build the current Python 295 | -- version, in square brackets, for example: 296 | -- 297 | -- @ 298 | -- \"[GCC 2.7.2.2]\" 299 | -- @ 300 | -- 301 | -- The value is available to Python code as part of the variable 302 | -- @sys.version@. 303 | {# fun Py_GetCompiler as getCompiler 304 | {} -> `Text' peekText* #} 305 | 306 | -- | Return information about the sequence number and build date and time of 307 | -- the current Python interpreter instance, for example 308 | -- 309 | -- @ 310 | -- \"#67, Aug 1 1997, 22:34:28\" 311 | -- @ 312 | -- 313 | -- The value is available to Python code as part of the variable 314 | -- @sys.version@. 315 | {# fun Py_GetBuildInfo as getBuildInfo 316 | {} -> `Text' peekText* #} 317 | 318 | -- | Set @sys.argv@. The first parameter is similar to the result of 319 | -- 'getProgName', with the difference that it should refer to the script 320 | -- file to be executed rather than the executable hosting the Python 321 | -- interpreter. If there isn’t a script that will be run, the first 322 | -- parameter can be an empty string. If this function fails to initialize 323 | -- @sys.argv@, a fatal condition is signalled using @Py_FatalError()@. 324 | -- 325 | -- This function also prepends the executed script’s path to 326 | -- @sys.path@. If no script is executed (in the case of calling @python -c@ 327 | -- or just the interactive interpreter), the empty string is used instead. 328 | setArgv :: Text -> [Text] -> IO () 329 | setArgv argv0 argv = 330 | mapWith withTextW (argv0 : argv) $ \textPtrs -> 331 | let argc = fromIntegral $ length textPtrs in 332 | withArray textPtrs $ pySetArgv argc 333 | 334 | foreign import ccall safe "hscpython-shim.h PySys_SetArgv" 335 | pySetArgv :: CInt -> Ptr CWString -> IO () 336 | 337 | -- | Return the default “home”, that is, the value set by a 338 | -- previous call to 'setPythonHome', or the value of the @PYTHONHOME@ 339 | -- environment variable if it is set. 340 | getPythonHome :: IO (Maybe Text) 341 | getPythonHome = pyGetPythonHome >>= peekMaybeTextW 342 | 343 | foreign import ccall safe "hscpython-shim.h Py_GetPythonHome" 344 | pyGetPythonHome :: IO CWString 345 | 346 | -- | Set the default “home” directory, that is, the location 347 | -- of the standard Python libraries. The libraries are searched in 348 | -- @/home/\/lib\//python version/@ and @/home/\/lib\//python version/@. No 349 | -- code in the Python interpreter will change the Python home. 350 | setPythonHome :: Maybe Text -> IO () 351 | setPythonHome name = withMaybeTextW name cSetPythonHome 352 | 353 | foreign import ccall safe "hscpython-shim.h hscpython_SetPythonHome" 354 | cSetPythonHome :: CWString -> IO () 355 | -------------------------------------------------------------------------------- /lib/CPython/Constants.chs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ForeignFunctionInterface #-} 2 | 3 | -- Copyright (C) 2009 John Millikin 4 | -- 5 | -- This program is free software: you can redistribute it and/or modify 6 | -- it under the terms of the GNU General Public License as published by 7 | -- the Free Software Foundation, either version 3 of the License, or 8 | -- any later version. 9 | -- 10 | -- This program is distributed in the hope that it will be useful, 11 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | -- GNU General Public License for more details. 14 | -- 15 | -- You should have received a copy of the GNU General Public License 16 | -- along with this program. If not, see . 17 | 18 | module CPython.Constants 19 | ( none 20 | , true 21 | , false 22 | , isNone 23 | , isTrue 24 | , isFalse 25 | ) where 26 | 27 | #include 28 | 29 | import CPython.Internal 30 | 31 | -- | The Python @None@ object, denoting lack of value. 32 | {# fun unsafe hscpython_Py_None as none 33 | {} -> `SomeObject' peekObject* #} 34 | 35 | -- | The Python @True@ object. 36 | {# fun unsafe hscpython_Py_True as true 37 | {} -> `SomeObject' peekObject* #} 38 | 39 | -- | The Python @False@ object. 40 | {# fun unsafe hscpython_Py_False as false 41 | {} -> `SomeObject' peekObject* #} 42 | 43 | {# fun pure unsafe hscpython_Py_None as rawNone 44 | {} -> `Ptr ()' id #} 45 | 46 | {# fun pure unsafe hscpython_Py_True as rawTrue 47 | {} -> `Ptr ()' id #} 48 | 49 | {# fun pure unsafe hscpython_Py_False as rawFalse 50 | {} -> `Ptr ()' id #} 51 | 52 | isNone :: SomeObject -> IO Bool 53 | isNone obj = withObject obj $ \ptr -> return $ ptr == rawNone 54 | 55 | isTrue :: SomeObject -> IO Bool 56 | isTrue obj = withObject obj $ \ptr -> return $ ptr == rawTrue 57 | 58 | isFalse :: SomeObject -> IO Bool 59 | isFalse obj = withObject obj $ \ptr -> return $ ptr == rawFalse 60 | -------------------------------------------------------------------------------- /lib/CPython/Internal.chs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable #-} 2 | {-# LANGUAGE ExistentialQuantification #-} 3 | {-# LANGUAGE ForeignFunctionInterface #-} 4 | 5 | -- Copyright (C) 2009 John Millikin 6 | -- 7 | -- This program is free software: you can redistribute it and/or modify 8 | -- it under the terms of the GNU General Public License as published by 9 | -- the Free Software Foundation, either version 3 of the License, or 10 | -- any later version. 11 | -- 12 | -- This program is distributed in the hope that it will be useful, 13 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | -- GNU General Public License for more details. 16 | -- 17 | -- You should have received a copy of the GNU General Public License 18 | -- along with this program. If not, see . 19 | 20 | module CPython.Internal 21 | ( 22 | -- * FFI support 23 | module Foreign 24 | , module Foreign.C 25 | , cToBool 26 | , cFromBool 27 | , peekText 28 | , peekTextW 29 | , peekMaybeTextW 30 | , withText 31 | , withTextW 32 | , withMaybeTextW 33 | , mapWith 34 | , unsafePerformIO 35 | 36 | -- * Fundamental types 37 | , SomeObject (..) 38 | , Type (..) 39 | , Dictionary (..) 40 | , List (..) 41 | , Tuple (..) 42 | 43 | -- * Objects 44 | , Object (..) 45 | , Concrete (..) 46 | , withObject 47 | , peekObject 48 | , peekStaticObject 49 | , stealObject 50 | , incref 51 | , decref 52 | , callObjectRaw 53 | , unsafeCast 54 | 55 | -- * Exceptions 56 | , Exception (..) 57 | , exceptionIf 58 | , checkStatusCode 59 | , checkBoolReturn 60 | , checkIntReturn 61 | 62 | -- * Other classes 63 | -- ** Mapping 64 | , Mapping (..) 65 | , SomeMapping (..) 66 | , unsafeCastToMapping 67 | 68 | -- ** Sequence 69 | , Sequence (..) 70 | , SomeSequence (..) 71 | , unsafeCastToSequence 72 | 73 | -- ** Iterator 74 | , Iterator (..) 75 | , SomeIterator (..) 76 | , unsafeCastToIterator 77 | ) where 78 | 79 | #include 80 | 81 | import qualified Control.Exception as E 82 | import qualified Data.Text as T 83 | import Data.Typeable (Typeable) 84 | import Foreign hiding (newForeignPtr, newForeignPtr_) 85 | import Foreign.C 86 | import Foreign.Concurrent(newForeignPtr) 87 | import System.IO.Unsafe (unsafePerformIO) 88 | 89 | cToBool :: CInt -> Bool 90 | cToBool = (/= 0) 91 | 92 | cFromBool :: Bool -> CInt 93 | cFromBool x = if x then 1 else 0 94 | 95 | peekText :: CString -> IO T.Text 96 | peekText = fmap T.pack . peekCString 97 | 98 | peekTextW :: CWString -> IO T.Text 99 | peekTextW = fmap T.pack . peekCWString 100 | 101 | peekMaybeTextW :: CWString -> IO (Maybe T.Text) 102 | peekMaybeTextW = maybePeek peekTextW 103 | 104 | withText :: T.Text -> (CString -> IO a) -> IO a 105 | withText = withCString . T.unpack 106 | 107 | withTextW :: T.Text -> (CWString -> IO a) -> IO a 108 | withTextW = withCWString . T.unpack 109 | 110 | withMaybeTextW :: Maybe T.Text -> (CWString -> IO a) -> IO a 111 | withMaybeTextW = maybeWith withTextW 112 | 113 | mapWith :: (a -> (b -> IO c) -> IO c) -> [a] -> ([b] -> IO c) -> IO c 114 | mapWith with' = step [] where 115 | step acc [] io = io acc 116 | step acc (x:xs) io = with' x $ \y -> step (acc ++ [y]) xs io 117 | 118 | data SomeObject = forall a. (Object a) => SomeObject (ForeignPtr a) 119 | 120 | class Object a where 121 | toObject :: a -> SomeObject 122 | fromForeignPtr :: ForeignPtr a -> a 123 | 124 | class Object a => Concrete a where 125 | concreteType :: a -> Type 126 | 127 | instance Object SomeObject where 128 | toObject = id 129 | fromForeignPtr = SomeObject 130 | 131 | newtype Type = Type (ForeignPtr Type) 132 | instance Object Type where 133 | toObject (Type x) = SomeObject x 134 | fromForeignPtr = Type 135 | 136 | newtype Dictionary = Dictionary (ForeignPtr Dictionary) 137 | instance Object Dictionary where 138 | toObject (Dictionary x) = SomeObject x 139 | fromForeignPtr = Dictionary 140 | 141 | newtype List = List (ForeignPtr List) 142 | instance Object List where 143 | toObject (List x) = SomeObject x 144 | fromForeignPtr = List 145 | 146 | newtype Tuple = Tuple (ForeignPtr Tuple) 147 | instance Object Tuple where 148 | toObject (Tuple x) = SomeObject x 149 | fromForeignPtr = Tuple 150 | 151 | withObject :: Object obj => obj -> (Ptr a -> IO b) -> IO b 152 | withObject obj io = case toObject obj of 153 | SomeObject ptr -> withForeignPtr ptr (io . castPtr) 154 | 155 | peekObject :: Object obj => Ptr a -> IO obj 156 | peekObject ptr = E.bracketOnError incPtr decref mkObj where 157 | incPtr = incref ptr >> return ptr 158 | mkObj _ = fromForeignPtr <$> newForeignPtr (castPtr ptr) (decref ptr) 159 | 160 | peekStaticObject :: Object obj => Ptr a -> IO obj 161 | peekStaticObject ptr = fromForeignPtr <$> newForeignPtr_ (castPtr ptr) 162 | where 163 | newForeignPtr_ p = newForeignPtr p (return ()) 164 | 165 | 166 | 167 | unsafeStealObject :: Object obj => Ptr a -> IO obj 168 | unsafeStealObject ptr = fromForeignPtr <$> newForeignPtr (castPtr ptr) (decref ptr) 169 | 170 | stealObject :: Object obj => Ptr a -> IO obj 171 | stealObject ptr = exceptionIf (ptr == nullPtr) >> unsafeStealObject ptr 172 | 173 | {# fun hscpython_Py_INCREF as incref 174 | { castPtr `Ptr a' 175 | } -> `()' id #} 176 | 177 | {# fun hscpython_Py_DECREF as decref 178 | { castPtr `Ptr a' 179 | } -> `()' id #} 180 | 181 | {# fun PyObject_CallObject as callObjectRaw 182 | `(Object self, Object args)' => 183 | { withObject* `self' 184 | , withObject* `args' 185 | } -> `SomeObject' stealObject* #} 186 | 187 | unsafeCast :: (Object a, Object b) => a -> b 188 | unsafeCast a = case toObject a of 189 | SomeObject ptr -> fromForeignPtr (castForeignPtr ptr) 190 | 191 | data Exception = Exception 192 | { exceptionType :: SomeObject 193 | , exceptionValue :: SomeObject 194 | , exceptionTraceback :: Maybe SomeObject 195 | } 196 | deriving (Typeable) 197 | 198 | instance Show Exception where 199 | show _ = "" 200 | 201 | instance E.Exception Exception 202 | 203 | exceptionIf :: Bool -> IO () 204 | exceptionIf False = return () 205 | exceptionIf True = 206 | alloca $ \pType -> 207 | alloca $ \pValue -> 208 | alloca $ \pTrace -> do 209 | {# call PyErr_Fetch as ^ #} pType pValue pTrace 210 | {# call PyErr_NormalizeException as ^ #} pType pValue pTrace 211 | eType <- unsafeStealObject =<< peek pType 212 | eValue <- unsafeStealObject =<< peek pValue 213 | eTrace <- maybePeek unsafeStealObject =<< peek pTrace 214 | E.throwIO $ Exception eType eValue eTrace 215 | 216 | checkStatusCode :: CInt -> IO () 217 | checkStatusCode = exceptionIf . (== -1) 218 | 219 | checkBoolReturn :: CInt -> IO Bool 220 | checkBoolReturn x = do 221 | exceptionIf $ x == -1 222 | return $ x /= 0 223 | 224 | checkIntReturn :: Integral a => a -> IO Integer 225 | checkIntReturn x = do 226 | exceptionIf $ x == -1 227 | return $ toInteger x 228 | 229 | data SomeMapping = forall a. (Mapping a) => SomeMapping (ForeignPtr a) 230 | 231 | class Object a => Mapping a where 232 | toMapping :: a -> SomeMapping 233 | 234 | instance Object SomeMapping where 235 | toObject (SomeMapping x) = SomeObject x 236 | fromForeignPtr = SomeMapping 237 | 238 | instance Mapping SomeMapping where 239 | toMapping = id 240 | 241 | unsafeCastToMapping :: Object a => a -> SomeMapping 242 | unsafeCastToMapping x = case toObject x of 243 | SomeObject ptr -> let 244 | ptr' = castForeignPtr ptr :: ForeignPtr SomeMapping 245 | in SomeMapping ptr' 246 | 247 | data SomeSequence = forall a. (Sequence a) => SomeSequence (ForeignPtr a) 248 | 249 | class Object a => Sequence a where 250 | toSequence :: a -> SomeSequence 251 | 252 | instance Object SomeSequence where 253 | toObject (SomeSequence x) = SomeObject x 254 | fromForeignPtr = SomeSequence 255 | 256 | instance Sequence SomeSequence where 257 | toSequence = id 258 | 259 | unsafeCastToSequence :: Object a => a -> SomeSequence 260 | unsafeCastToSequence x = case toObject x of 261 | SomeObject ptr -> let 262 | ptr' = castForeignPtr ptr :: ForeignPtr SomeSequence 263 | in SomeSequence ptr' 264 | 265 | data SomeIterator = forall a. (Iterator a) => SomeIterator (ForeignPtr a) 266 | 267 | class Object a => Iterator a where 268 | toIterator :: a -> SomeIterator 269 | 270 | instance Object SomeIterator where 271 | toObject (SomeIterator x) = SomeObject x 272 | fromForeignPtr = SomeIterator 273 | 274 | instance Iterator SomeIterator where 275 | toIterator = id 276 | 277 | unsafeCastToIterator :: Object a => a -> SomeIterator 278 | unsafeCastToIterator x = case toObject x of 279 | SomeObject ptr -> let 280 | ptr' = castForeignPtr ptr :: ForeignPtr SomeIterator 281 | in SomeIterator ptr' 282 | -------------------------------------------------------------------------------- /lib/CPython/Protocols/Iterator.chs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ForeignFunctionInterface #-} 2 | 3 | -- Copyright (C) 2009 John Millikin 4 | -- 5 | -- This program is free software: you can redistribute it and/or modify 6 | -- it under the terms of the GNU General Public License as published by 7 | -- the Free Software Foundation, either version 3 of the License, or 8 | -- any later version. 9 | -- 10 | -- This program is distributed in the hope that it will be useful, 11 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | -- GNU General Public License for more details. 14 | -- 15 | -- You should have received a copy of the GNU General Public License 16 | -- along with this program. If not, see . 17 | 18 | module CPython.Protocols.Iterator 19 | ( Iterator (..) 20 | , SomeIterator 21 | , castToIterator 22 | , next 23 | ) where 24 | 25 | #include 26 | 27 | import CPython.Internal 28 | 29 | -- | Attempt to convert an object to a generic 'Iterator'. If the object does 30 | -- not implement the iterator protocol, returns 'Nothing'. 31 | castToIterator :: Object a => a -> IO (Maybe SomeIterator) 32 | castToIterator obj = 33 | withObject obj $ \objPtr -> do 34 | isIter <- fmap cToBool $ {# call hscpython_PyIter_Check as ^ #} objPtr 35 | return $ if isIter 36 | then Just $ unsafeCastToIterator obj 37 | else Nothing 38 | 39 | -- | Return the next value from the iteration, or 'Nothing' if there are no 40 | -- remaining items. 41 | next :: Iterator iter => iter -> IO (Maybe SomeObject) 42 | next iter = 43 | withObject iter $ \iterPtr -> do 44 | raw <- {# call PyIter_Next as ^ #} iterPtr 45 | if raw == nullPtr 46 | then do 47 | err <- {# call PyErr_Occurred as ^ #} 48 | exceptionIf $ err /= nullPtr 49 | return Nothing 50 | else fmap Just $ stealObject raw 51 | -------------------------------------------------------------------------------- /lib/CPython/Protocols/Mapping.chs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ForeignFunctionInterface #-} 2 | 3 | -- Copyright (C) 2009 John Millikin 4 | -- 5 | -- This program is free software: you can redistribute it and/or modify 6 | -- it under the terms of the GNU General Public License as published by 7 | -- the Free Software Foundation, either version 3 of the License, or 8 | -- any later version. 9 | -- 10 | -- This program is distributed in the hope that it will be useful, 11 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | -- GNU General Public License for more details. 14 | -- 15 | -- You should have received a copy of the GNU General Public License 16 | -- along with this program. If not, see . 17 | 18 | module CPython.Protocols.Mapping 19 | ( Mapping (..) 20 | , SomeMapping 21 | , castToMapping 22 | , getItem 23 | , setItem 24 | , deleteItem 25 | , size 26 | , hasKey 27 | , keys 28 | , values 29 | , items 30 | ) where 31 | 32 | #include 33 | 34 | import CPython.Internal 35 | 36 | instance Mapping Dictionary where 37 | toMapping = unsafeCastToMapping 38 | 39 | castToMapping :: Object a => a -> IO (Maybe SomeMapping) 40 | castToMapping obj = 41 | withObject obj $ \objPtr -> do 42 | isMapping <- fmap cToBool $ {# call PyMapping_Check as ^ #} objPtr 43 | return $ if isMapping 44 | then Just $ unsafeCastToMapping obj 45 | else Nothing 46 | 47 | {# fun PyObject_GetItem as getItem 48 | `(Mapping self, Object key)' => 49 | { withObject* `self' 50 | , withObject* `key' 51 | } -> `SomeObject' stealObject* #} 52 | 53 | {# fun PyObject_SetItem as setItem 54 | `(Mapping self, Object key, Object value)' => 55 | { withObject* `self' 56 | , withObject* `key' 57 | , withObject* `value' 58 | } -> `()' checkStatusCode* #} 59 | 60 | {# fun PyObject_DelItem as deleteItem 61 | `(Mapping self, Object key)' => 62 | { withObject* `self' 63 | , withObject* `key' 64 | } -> `()' checkStatusCode* #} 65 | 66 | {# fun PyMapping_Size as size 67 | `Mapping self' => 68 | { withObject* `self' 69 | } -> `Integer' checkIntReturn* #} 70 | 71 | {# fun PyMapping_HasKey as hasKey 72 | `(Mapping self, Object key)' => 73 | { withObject* `self' 74 | , withObject* `key' 75 | } -> `Bool' #} 76 | 77 | {# fun PyMapping_Keys as keys 78 | `Mapping self' => 79 | { withObject* `self' 80 | } -> `List' stealObject* #} 81 | 82 | {# fun PyMapping_Values as values 83 | `Mapping self' => 84 | { withObject* `self' 85 | } -> `List' stealObject* #} 86 | 87 | {# fun PyMapping_Items as items 88 | `Mapping self' => 89 | { withObject* `self' 90 | } -> `List' stealObject* #} 91 | -------------------------------------------------------------------------------- /lib/CPython/Protocols/Number.chs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ForeignFunctionInterface #-} 2 | {-# LANGUAGE ExistentialQuantification #-} 3 | 4 | -- Copyright (C) 2009 John Millikin 5 | -- 6 | -- This program is free software: you can redistribute it and/or modify 7 | -- it under the terms of the GNU General Public License as published by 8 | -- the Free Software Foundation, either version 3 of the License, or 9 | -- any later version. 10 | -- 11 | -- This program is distributed in the hope that it will be useful, 12 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | -- GNU General Public License for more details. 15 | -- 16 | -- You should have received a copy of the GNU General Public License 17 | -- along with this program. If not, see . 18 | 19 | module CPython.Protocols.Number 20 | ( Number (..) 21 | , SomeNumber 22 | , castToNumber 23 | , add 24 | , subtract 25 | , multiply 26 | , floorDivide 27 | , trueDivide 28 | , remainder 29 | , divmod 30 | , power 31 | , negative 32 | , positive 33 | , absolute 34 | , invert 35 | , shiftL 36 | , shiftR 37 | , and 38 | , xor 39 | , or 40 | , inPlaceAdd 41 | , inPlaceSubtract 42 | , inPlaceMultiply 43 | , inPlaceFloorDivide 44 | , inPlaceTrueDivide 45 | , inPlaceRemainder 46 | , inPlacePower 47 | , inPlaceShiftL 48 | , inPlaceShiftR 49 | , inPlaceAnd 50 | , inPlaceXor 51 | , inPlaceOr 52 | , toInteger 53 | , toFloat 54 | , toBase 55 | ) where 56 | 57 | #include 58 | 59 | import Prelude hiding (Integer, Float, subtract, and, or, toInteger) 60 | import qualified Prelude as Prelude 61 | 62 | import CPython.Constants (none) 63 | import CPython.Internal hiding (xor, shiftR, shiftL) 64 | import CPython.Types.Complex (Complex) 65 | import CPython.Types.Float (Float) 66 | import CPython.Types.Integer (Integer) 67 | import CPython.Types.Set (Set, FrozenSet) 68 | import CPython.Types.Unicode (Unicode) 69 | 70 | data SomeNumber = forall a. (Number a) => SomeNumber (ForeignPtr a) 71 | 72 | class Object a => Number a where 73 | toNumber :: a -> SomeNumber 74 | 75 | instance Object SomeNumber where 76 | toObject (SomeNumber x) = SomeObject x 77 | fromForeignPtr = SomeNumber 78 | 79 | instance Number SomeNumber where 80 | toNumber = id 81 | 82 | instance Number Integer where 83 | toNumber = unsafeCastToNumber 84 | 85 | instance Number Float where 86 | toNumber = unsafeCastToNumber 87 | 88 | instance Number Complex where 89 | toNumber = unsafeCastToNumber 90 | 91 | -- lol wut 92 | instance Number Set where 93 | toNumber = unsafeCastToNumber 94 | 95 | instance Number FrozenSet where 96 | toNumber = unsafeCastToNumber 97 | 98 | unsafeCastToNumber :: Object a => a -> SomeNumber 99 | unsafeCastToNumber x = case toObject x of 100 | SomeObject ptr -> let 101 | ptr' = castForeignPtr ptr :: ForeignPtr SomeNumber 102 | in SomeNumber ptr' 103 | 104 | castToNumber :: Object a => a -> IO (Maybe SomeNumber) 105 | castToNumber obj = 106 | withObject obj $ \objPtr -> do 107 | isNumber <- fmap cToBool $ {# call PyNumber_Check as ^ #} objPtr 108 | return $ if isNumber 109 | then Just $ unsafeCastToNumber obj 110 | else Nothing 111 | 112 | add :: (Number a, Number b) => a -> b -> IO SomeNumber 113 | add = c_add 114 | 115 | -- c2hs won't accept functions named "add" any more, so have it generate 116 | -- c_add and then wrap that manually. 117 | {# fun PyNumber_Add as c_add 118 | `(Number a, Number b)' => 119 | { withObject* `a' 120 | , withObject* `b' 121 | } -> `SomeNumber' stealObject* #} 122 | 123 | {# fun PyNumber_Subtract as subtract 124 | `(Number a, Number b)' => 125 | { withObject* `a' 126 | , withObject* `b' 127 | } -> `SomeNumber' stealObject* #} 128 | 129 | {# fun PyNumber_Multiply as multiply 130 | `(Number a, Number b)' => 131 | { withObject* `a' 132 | , withObject* `b' 133 | } -> `SomeNumber' stealObject* #} 134 | 135 | {# fun PyNumber_FloorDivide as floorDivide 136 | `(Number a, Number b)' => 137 | { withObject* `a' 138 | , withObject* `b' 139 | } -> `SomeNumber' stealObject* #} 140 | 141 | {# fun PyNumber_TrueDivide as trueDivide 142 | `(Number a, Number b)' => 143 | { withObject* `a' 144 | , withObject* `b' 145 | } -> `SomeNumber' stealObject* #} 146 | 147 | {# fun PyNumber_Remainder as remainder 148 | `(Number a, Number b)' => 149 | { withObject* `a' 150 | , withObject* `b' 151 | } -> `SomeNumber' stealObject* #} 152 | 153 | {# fun PyNumber_Divmod as divmod 154 | `(Number a, Number b)' => 155 | { withObject* `a' 156 | , withObject* `b' 157 | } -> `SomeNumber' stealObject* #} 158 | 159 | power :: (Number a, Number b, Number c) => a -> b -> Maybe c -> IO SomeNumber 160 | power a b mc = 161 | withObject a $ \aPtr -> 162 | withObject b $ \bPtr -> 163 | maybe none (return . toObject) mc >>= \c -> 164 | withObject c $ \cPtr -> 165 | {# call PyNumber_Power as ^ #} aPtr bPtr cPtr 166 | >>= stealObject 167 | 168 | {# fun PyNumber_Negative as negative 169 | `Number a' => 170 | { withObject* `a' 171 | } -> `SomeNumber' stealObject* #} 172 | 173 | {# fun PyNumber_Positive as positive 174 | `Number a' => 175 | { withObject* `a' 176 | } -> `SomeNumber' stealObject* #} 177 | 178 | {# fun PyNumber_Absolute as absolute 179 | `Number a' => 180 | { withObject* `a' 181 | } -> `SomeNumber' stealObject* #} 182 | 183 | {# fun PyNumber_Invert as invert 184 | `Number a' => 185 | { withObject* `a' 186 | } -> `SomeNumber' stealObject* #} 187 | 188 | {# fun PyNumber_Lshift as shiftL 189 | `(Number a, Number b)' => 190 | { withObject* `a' 191 | , withObject* `b' 192 | } -> `SomeNumber' stealObject* #} 193 | 194 | {# fun PyNumber_Rshift as shiftR 195 | `(Number a, Number b)' => 196 | { withObject* `a' 197 | , withObject* `b' 198 | } -> `SomeNumber' stealObject* #} 199 | 200 | {# fun PyNumber_And as and 201 | `(Number a, Number b)' => 202 | { withObject* `a' 203 | , withObject* `b' 204 | } -> `SomeNumber' stealObject* #} 205 | 206 | {# fun PyNumber_Xor as xor 207 | `(Number a, Number b)' => 208 | { withObject* `a' 209 | , withObject* `b' 210 | } -> `SomeNumber' stealObject* #} 211 | 212 | {# fun PyNumber_Or as or 213 | `(Number a, Number b)' => 214 | { withObject* `a' 215 | , withObject* `b' 216 | } -> `SomeNumber' stealObject* #} 217 | 218 | {# fun PyNumber_InPlaceAdd as inPlaceAdd 219 | `(Number a, Number b)' => 220 | { withObject* `a' 221 | , withObject* `b' 222 | } -> `SomeNumber' stealObject* #} 223 | 224 | {# fun PyNumber_InPlaceSubtract as inPlaceSubtract 225 | `(Number a, Number b)' => 226 | { withObject* `a' 227 | , withObject* `b' 228 | } -> `SomeNumber' stealObject* #} 229 | 230 | {# fun PyNumber_InPlaceMultiply as inPlaceMultiply 231 | `(Number a, Number b)' => 232 | { withObject* `a' 233 | , withObject* `b' 234 | } -> `SomeNumber' stealObject* #} 235 | 236 | {# fun PyNumber_InPlaceFloorDivide as inPlaceFloorDivide 237 | `(Number a, Number b)' => 238 | { withObject* `a' 239 | , withObject* `b' 240 | } -> `SomeNumber' stealObject* #} 241 | 242 | {# fun PyNumber_InPlaceTrueDivide as inPlaceTrueDivide 243 | `(Number a, Number b)' => 244 | { withObject* `a' 245 | , withObject* `b' 246 | } -> `SomeNumber' stealObject* #} 247 | 248 | {# fun PyNumber_InPlaceRemainder as inPlaceRemainder 249 | `(Number a, Number b)' => 250 | { withObject* `a' 251 | , withObject* `b' 252 | } -> `SomeNumber' stealObject* #} 253 | 254 | inPlacePower ::(Number a, Number b, Number c) => a -> b -> Maybe c -> IO SomeNumber 255 | inPlacePower a b mc = 256 | withObject a $ \aPtr -> 257 | withObject b $ \bPtr -> 258 | maybe none (return . toObject) mc >>= \c -> 259 | withObject c $ \cPtr -> 260 | {# call PyNumber_InPlacePower as ^ #} aPtr bPtr cPtr 261 | >>= stealObject 262 | 263 | {# fun PyNumber_InPlaceLshift as inPlaceShiftL 264 | `(Number a, Number b)' => 265 | { withObject* `a' 266 | , withObject* `b' 267 | } -> `SomeNumber' stealObject* #} 268 | 269 | {# fun PyNumber_InPlaceRshift as inPlaceShiftR 270 | `(Number a, Number b)' => 271 | { withObject* `a' 272 | , withObject* `b' 273 | } -> `SomeNumber' stealObject* #} 274 | 275 | {# fun PyNumber_InPlaceAnd as inPlaceAnd 276 | `(Number a, Number b)' => 277 | { withObject* `a' 278 | , withObject* `b' 279 | } -> `SomeNumber' stealObject* #} 280 | 281 | {# fun PyNumber_InPlaceXor as inPlaceXor 282 | `(Number a, Number b)' => 283 | { withObject* `a' 284 | , withObject* `b' 285 | } -> `SomeNumber' stealObject* #} 286 | 287 | {# fun PyNumber_InPlaceOr as inPlaceOr 288 | `(Number a, Number b)' => 289 | { withObject* `a' 290 | , withObject* `b' 291 | } -> `SomeNumber' stealObject* #} 292 | 293 | {# fun PyNumber_Long as toInteger 294 | `Number a' => 295 | { withObject* `a' 296 | } -> `Integer' stealObject* #} 297 | 298 | {# fun PyNumber_Float as toFloat 299 | `Number a' => 300 | { withObject* `a' 301 | } -> `Float' stealObject* #} 302 | 303 | {# fun PyNumber_ToBase as toBase 304 | `Number a' => 305 | { withObject* `a' 306 | , fromIntegral `Prelude.Integer' 307 | } -> `Unicode' stealObject* #} 308 | -------------------------------------------------------------------------------- /lib/CPython/Protocols/Object.chs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ForeignFunctionInterface #-} 2 | 3 | -- Copyright (C) 2009 John Millikin 4 | -- 5 | -- This program is free software: you can redistribute it and/or modify 6 | -- it under the terms of the GNU General Public License as published by 7 | -- the Free Software Foundation, either version 3 of the License, or 8 | -- any later version. 9 | -- 10 | -- This program is distributed in the hope that it will be useful, 11 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | -- GNU General Public License for more details. 14 | -- 15 | -- You should have received a copy of the GNU General Public License 16 | -- along with this program. If not, see . 17 | 18 | module CPython.Protocols.Object 19 | ( Object 20 | , Concrete 21 | , SomeObject 22 | 23 | -- * Types and casting 24 | , getType 25 | , isInstance 26 | , isSubclass 27 | , toObject 28 | , cast 29 | 30 | -- * Attributes 31 | , hasAttribute 32 | , getAttribute 33 | , setAttribute 34 | , deleteAttribute 35 | 36 | -- * Display and debugging 37 | , print 38 | , repr 39 | , ascii 40 | , string 41 | , bytes 42 | 43 | -- * Callables 44 | , callable 45 | , call 46 | , callArgs 47 | , callMethod 48 | , callMethodArgs 49 | 50 | -- * Misc 51 | , Comparison (..) 52 | , richCompare 53 | , toBool 54 | , hash 55 | , dir 56 | , getIterator 57 | ) where 58 | 59 | #include 60 | 61 | import Prelude hiding (Ordering (..), print) 62 | import qualified Data.Text as T 63 | import System.IO (Handle, hPutStrLn) 64 | 65 | import CPython.Internal hiding (toBool) 66 | import CPython.Protocols.Object.Enums 67 | import qualified CPython.Types.Bytes as B 68 | import qualified CPython.Types.Dictionary as D 69 | import qualified CPython.Types.Tuple as Tuple 70 | import qualified CPython.Types.Unicode as U 71 | 72 | -- | Returns a 'Type' object corresponding to the object type of /self/. On 73 | -- failure, throws @SystemError@. This is equivalent to the Python expression 74 | -- @type(o)@. 75 | {# fun PyObject_Type as getType 76 | `Object self' => 77 | { withObject* `self' 78 | } -> `Type' stealObject* #} 79 | 80 | -- | Returns 'True' if /inst/ is an instance of the class /cls/ or a 81 | -- subclass of /cls/, or 'False' if not. On error, throws an exception. 82 | -- If /cls/ is a type object rather than a class object, 'isInstance' 83 | -- returns 'True' if /inst/ is of type /cls/. If /cls/ is a tuple, the check 84 | -- will be done against every entry in /cls/. The result will be 'True' when 85 | -- at least one of the checks returns 'True', otherwise it will be 'False'. If 86 | -- /inst/ is not a class instance and /cls/ is neither a type object, nor a 87 | -- class object, nor a tuple, /inst/ must have a @__class__@ attribute ߞ 88 | -- the class relationship of the value of that attribute with /cls/ will be 89 | -- used to determine the result of this function. 90 | -- 91 | -- Subclass determination is done in a fairly straightforward way, but 92 | -- includes a wrinkle that implementors of extensions to the class system 93 | -- may want to be aware of. If A and B are class objects, B is a subclass of 94 | -- A if it inherits from A either directly or indirectly. If either is not a 95 | -- class object, a more general mechanism is used to determine the class 96 | -- relationship of the two objects. When testing if B is a subclass of A, if 97 | -- A is B, 'isSubclass' returns 'True'. If A and B are different objects, 98 | -- Bߢs @__bases__@ attribute is searched in a depth-first fashion for 99 | -- A ߞ the presence of the @__bases__@ attribute is considered 100 | -- sufficient for this determination. 101 | {# fun PyObject_IsInstance as isInstance 102 | `(Object self, Object cls)' => 103 | { withObject* `self' 104 | , withObject* `cls' 105 | } -> `Bool' checkBoolReturn* #} 106 | 107 | -- | Returns 'True' if the class /derived/ is identical to or derived from 108 | -- the class /cls/, otherwise returns 'False'. In case of an error, throws 109 | -- an exception. If /cls/ is a tuple, the check will be done against every 110 | -- entry in /cls/. The result will be 'True' when at least one of the checks 111 | -- returns 'True', otherwise it will be 'False'. If either /derived/ or /cls/ 112 | -- is not an actual class object (or tuple), this function uses the generic 113 | -- algorithm described above. 114 | {# fun PyObject_IsSubclass as isSubclass 115 | `(Object derived, Object cls)' => 116 | { withObject* `derived' 117 | , withObject* `cls' 118 | } -> `Bool' checkBoolReturn* #} 119 | 120 | -- | Attempt to cast an object to some concrete class. If the object 121 | -- isn't an instance of the class or subclass, returns 'Nothing'. 122 | cast :: (Object a, Concrete b) => a -> IO (Maybe b) 123 | cast obj = let castObj = case toObject obj of SomeObject ptr -> fromForeignPtr $ castForeignPtr ptr 124 | in do 125 | validCast <- isInstance obj $ concreteType castObj 126 | return $ if validCast 127 | then Just castObj 128 | else Nothing 129 | 130 | -- | Returns 'True' if /self/ has an attribute with the given name, and 131 | -- 'False' otherwise. This is equivalent to the Python expression 132 | -- @hasattr(self, name)@ 133 | {# fun PyObject_HasAttr as hasAttribute 134 | `Object self' => 135 | { withObject* `self' 136 | , withObject* `U.Unicode' 137 | } -> `Bool' checkBoolReturn* #} 138 | 139 | -- | Retrieve an attribute with the given name from object /self/. Returns 140 | -- the attribute value on success, and throws an exception on failure. This 141 | -- is the equivalent of the Python expression @self.name@. 142 | {# fun PyObject_GetAttr as getAttribute 143 | `Object self' => 144 | { withObject* `self' 145 | , withObject* `U.Unicode' 146 | } -> `SomeObject' stealObject* #} 147 | 148 | -- | Set the value of the attribute with the given name, for object /self/, 149 | -- to the value /v/. THrows an exception on failure. This is the equivalent 150 | -- of the Python statement @self.name = v@. 151 | {# fun PyObject_SetAttr as setAttribute 152 | `(Object self, Object v)' => 153 | { withObject* `self' 154 | , withObject* `U.Unicode' 155 | , withObject* `v' 156 | } -> `()' checkStatusCode* #} 157 | 158 | -- | Delete an attribute with the given name, for object /self/. Throws an 159 | -- exception on failure. This is the equivalent of the Python statement 160 | -- @del self.name@. 161 | {# fun hscpython_PyObject_DelAttr as deleteAttribute 162 | `Object self' => 163 | { withObject* `self' 164 | , withObject* `U.Unicode' 165 | } -> `()' checkStatusCode* #} 166 | 167 | -- | Print @repr(self)@ to a handle. 168 | print :: Object self => self -> Handle -> IO () 169 | print obj h = repr obj >>= U.fromUnicode >>= (hPutStrLn h . T.unpack) 170 | 171 | -- | Compute a string representation of object /self/, or throw an exception 172 | -- on failure. This is the equivalent of the Python expression @repr(self)@. 173 | {# fun PyObject_Repr as repr 174 | `Object self' => 175 | { withObject* `self' 176 | } -> `U.Unicode' stealObject* #} 177 | 178 | -- \ As 'ascii', compute a string representation of object /self/, but escape 179 | -- the non-ASCII characters in the string returned by 'repr' with @\x@, @\u@ 180 | -- or @\U@ escapes. This generates a string similar to that returned by 181 | -- 'repr' in Python 2. 182 | {# fun PyObject_ASCII as ascii 183 | `Object self' => 184 | { withObject* `self' 185 | } -> `U.Unicode' stealObject* #} 186 | 187 | -- | Compute a string representation of object /self/, or throw an exception 188 | -- on failure. This is the equivalent of the Python expression @str(self)@. 189 | {# fun PyObject_Str as string 190 | `Object self' => 191 | { withObject* `self' 192 | } -> `U.Unicode' stealObject* #} 193 | 194 | -- | Compute a bytes representation of object /self/, or throw an exception 195 | -- on failure. This is equivalent to the Python expression @bytes(self)@. 196 | {# fun PyObject_Bytes as bytes 197 | `Object self' => 198 | { withObject* `self' 199 | } -> `B.Bytes' stealObject* #} 200 | 201 | -- | Determine if the object /self/ is callable. 202 | {# fun PyCallable_Check as callable 203 | `Object self' => 204 | { withObject* `self' 205 | } -> `Bool' checkBoolReturn* #} 206 | 207 | -- | Call a callable Python object /self/, with arguments given by the 208 | -- tuple and named arguments given by the dictionary. Returns the result of 209 | -- the call on success, or throws an exception on failure. This is the 210 | -- equivalent of the Python expression @self(*args, **kw)@. 211 | call :: Object self => self -> Tuple -> Dictionary -> IO SomeObject 212 | call self args kwargs = 213 | withObject self $ \selfPtr -> 214 | withObject args $ \argsPtr -> 215 | withObject kwargs $ \kwargsPtr -> 216 | {# call PyObject_Call as ^ #} selfPtr argsPtr kwargsPtr 217 | >>= stealObject 218 | 219 | -- | Call a callable Python object /self/, with arguments given by the list. 220 | callArgs :: Object self => self -> [SomeObject] -> IO SomeObject 221 | callArgs self args = do 222 | args' <- Tuple.toTuple args 223 | D.new >>= call self args' 224 | 225 | -- | Call the named method of object /self/, with arguments given by the 226 | -- tuple and named arguments given by the dictionary. Returns the result of 227 | -- the call on success, or throws an exception on failure. This is the 228 | -- equivalent of the Python expression @self.method(args)@. 229 | callMethod :: Object self => self -> T.Text -> Tuple -> Dictionary -> IO SomeObject 230 | callMethod self name args kwargs = do 231 | method <- getAttribute self =<< U.toUnicode name 232 | call method args kwargs 233 | 234 | -- | Call the named method of object /self/, with arguments given by the 235 | -- list. Returns the result of the call on success, or throws an exception 236 | -- on failure. This is the equivalent of the Python expression 237 | -- @self.method(args)@. 238 | callMethodArgs :: Object self => self -> T.Text -> [SomeObject] -> IO SomeObject 239 | callMethodArgs self name args = do 240 | args' <- Tuple.toTuple args 241 | D.new >>= callMethod self name args' 242 | 243 | data Comparison = LT | LE | EQ | NE | GT | GE 244 | deriving (Show) 245 | 246 | comparisonToInt :: Comparison -> CInt 247 | comparisonToInt = fromIntegral . fromEnum . enum where 248 | enum LT = HSCPYTHON_LT 249 | enum LE = HSCPYTHON_LE 250 | enum EQ = HSCPYTHON_EQ 251 | enum NE = HSCPYTHON_NE 252 | enum GT = HSCPYTHON_GT 253 | enum GE = HSCPYTHON_GE 254 | 255 | -- | Compare the values of /a/ and /b/ using the specified comparison. 256 | -- If an exception is raised, throws an exception. 257 | {# fun PyObject_RichCompareBool as richCompare 258 | `(Object a, Object b)' => 259 | { withObject* `a' 260 | , withObject* `b' 261 | , comparisonToInt `Comparison' 262 | } -> `Bool' checkBoolReturn* #} 263 | 264 | -- | Returns 'True' if the object /self/ is considered to be true, and 'False' 265 | -- otherwise. This is equivalent to the Python expression @not not self@. On 266 | -- failure, throws an exception. 267 | {# fun PyObject_IsTrue as toBool 268 | `Object self' => 269 | { withObject* `self' 270 | } -> `Bool' checkBoolReturn* #} 271 | 272 | -- | Compute and return the hash value of an object /self/. On failure, 273 | -- throws an exception. This is the equivalent of the Python expression 274 | -- @hash(self)@. 275 | {# fun PyObject_Hash as hash 276 | `Object self' => 277 | { withObject* `self' 278 | } -> `Integer' checkIntReturn* #} 279 | 280 | -- | This is equivalent to the Python expression @dir(self)@, returning a 281 | -- (possibly empty) list of strings appropriate for the object argument, 282 | -- or throws an exception if there was an error. 283 | {# fun PyObject_Dir as dir 284 | `Object self' => 285 | { withObject* `self' 286 | } -> `List' stealObject* #} 287 | 288 | -- | This is equivalent to the Python expression @iter(self)@. It returns a 289 | -- new iterator for the object argument, or the object itself if the object 290 | -- is already an iterator. Throws @TypeError@ if the object cannot be 291 | -- iterated. 292 | {# fun PyObject_GetIter as getIterator 293 | `Object self' => 294 | { withObject* `self' 295 | } -> `SomeObject' stealObject* #} 296 | -------------------------------------------------------------------------------- /lib/CPython/Protocols/Object/Enums.chs: -------------------------------------------------------------------------------- 1 | -- Copyright (C) 2009 John Millikin 2 | -- 3 | -- This program is free software: you can redistribute it and/or modify 4 | -- it under the terms of the GNU General Public License as published by 5 | -- the Free Software Foundation, either version 3 of the License, or 6 | -- any later version. 7 | -- 8 | -- This program is distributed in the hope that it will be useful, 9 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | -- GNU General Public License for more details. 12 | -- 13 | -- You should have received a copy of the GNU General Public License 14 | -- along with this program. If not, see . 15 | 16 | module CPython.Protocols.Object.Enums where 17 | 18 | #include 19 | 20 | {# enum HSCPythonComparisonEnum {} #} 21 | -------------------------------------------------------------------------------- /lib/CPython/Protocols/Sequence.chs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ForeignFunctionInterface #-} 2 | 3 | -- Copyright (C) 2009 John Millikin 4 | -- 5 | -- This program is free software: you can redistribute it and/or modify 6 | -- it under the terms of the GNU General Public License as published by 7 | -- the Free Software Foundation, either version 3 of the License, or 8 | -- any later version. 9 | -- 10 | -- This program is distributed in the hope that it will be useful, 11 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | -- GNU General Public License for more details. 14 | -- 15 | -- You should have received a copy of the GNU General Public License 16 | -- along with this program. If not, see . 17 | 18 | module CPython.Protocols.Sequence 19 | ( Sequence (..) 20 | , SomeSequence 21 | , castToSequence 22 | , length 23 | , append 24 | , repeat 25 | , inPlaceAppend 26 | , inPlaceRepeat 27 | , getItem 28 | , setItem 29 | , deleteItem 30 | , getSlice 31 | , setSlice 32 | , deleteSlice 33 | , count 34 | , contains 35 | , index 36 | , toList 37 | , toTuple 38 | , fast 39 | ) where 40 | 41 | #include 42 | 43 | import Prelude hiding (repeat, length) 44 | import Data.Text (Text) 45 | 46 | import CPython.Internal 47 | import CPython.Types.ByteArray (ByteArray) 48 | import CPython.Types.Bytes (Bytes) 49 | import CPython.Types.Unicode (Unicode) 50 | 51 | instance Sequence ByteArray where 52 | toSequence = unsafeCastToSequence 53 | 54 | instance Sequence Bytes where 55 | toSequence = unsafeCastToSequence 56 | 57 | instance Sequence List where 58 | toSequence = unsafeCastToSequence 59 | 60 | instance Sequence Tuple where 61 | toSequence = unsafeCastToSequence 62 | 63 | instance Sequence Unicode where 64 | toSequence = unsafeCastToSequence 65 | 66 | -- | Attempt to convert an object to a generic 'Sequence'. If the object does 67 | -- not implement the sequence protocol, returns 'Nothing'. 68 | castToSequence :: Object a => a -> IO (Maybe SomeSequence) 69 | castToSequence obj = 70 | withObject obj $ \objPtr -> do 71 | isSequence <- fmap cToBool $ {# call PySequence_Check as ^ #} objPtr 72 | return $ if isSequence 73 | then Just $ unsafeCastToSequence obj 74 | else Nothing 75 | 76 | {# fun PySequence_Size as length 77 | `Sequence self' => 78 | { withObject* `self' 79 | } -> `Integer' checkIntReturn* #} 80 | 81 | {# fun PySequence_Concat as append 82 | `(Sequence a, Sequence b)' => 83 | { withObject* `a' 84 | , withObject* `b' 85 | } -> `SomeSequence' stealObject* #} 86 | 87 | {# fun PySequence_Repeat as repeat 88 | `Sequence a' => 89 | { withObject* `a' 90 | , fromIntegral `Integer' 91 | } -> `a' stealObject* #} 92 | 93 | {# fun PySequence_InPlaceConcat as inPlaceAppend 94 | `(Sequence a, Sequence b)' => 95 | { withObject* `a' 96 | , withObject* `b' 97 | } -> `SomeSequence' stealObject* #} 98 | 99 | {# fun PySequence_InPlaceRepeat as inPlaceRepeat 100 | `Sequence a' => 101 | { withObject* `a' 102 | , fromIntegral `Integer' 103 | } -> `a' stealObject* #} 104 | 105 | {# fun PySequence_GetItem as getItem 106 | `Sequence self' => 107 | { withObject* `self' 108 | , fromIntegral `Integer' 109 | } -> `SomeObject' stealObject* #} 110 | 111 | {# fun PySequence_SetItem as setItem 112 | `(Sequence self, Object v)' => 113 | { withObject* `self' 114 | , fromIntegral `Integer' 115 | , withObject* `v' 116 | } -> `()' checkStatusCode* #} 117 | 118 | {# fun PySequence_DelItem as deleteItem 119 | `Sequence self' => 120 | { withObject* `self' 121 | , fromIntegral `Integer' 122 | } -> `()' checkStatusCode* #} 123 | 124 | {# fun PySequence_GetSlice as getSlice 125 | `Sequence self' => 126 | { withObject* `self' 127 | , fromIntegral `Integer' 128 | , fromIntegral `Integer' 129 | } -> `SomeObject' stealObject* #} 130 | 131 | {# fun PySequence_SetSlice as setSlice 132 | `(Sequence self, Object v)' => 133 | { withObject* `self' 134 | , fromIntegral `Integer' 135 | , fromIntegral `Integer' 136 | , withObject* `v' 137 | } -> `()' checkStatusCode* #} 138 | 139 | {# fun PySequence_DelSlice as deleteSlice 140 | `Sequence self' => 141 | { withObject* `self' 142 | , fromIntegral `Integer' 143 | , fromIntegral `Integer' 144 | } -> `()' checkStatusCode* #} 145 | 146 | {# fun PySequence_Count as count 147 | `(Sequence self, Object v)' => 148 | { withObject* `self' 149 | , withObject* `v' 150 | } -> `Integer' checkIntReturn* #} 151 | 152 | {# fun PySequence_Contains as contains 153 | `(Sequence self, Object v)' => 154 | { withObject* `self' 155 | , withObject* `v' 156 | } -> `Bool' checkBoolReturn* #} 157 | 158 | -- | Return the first index /i/ for which @self[i] == v@. This is equivalent 159 | -- to the Python expression @self.index(v)@. 160 | {# fun PySequence_Index as index 161 | `(Sequence self, Object v)' => 162 | { withObject* `self' 163 | , withObject* `v' 164 | } -> `Integer' checkIntReturn* #} 165 | 166 | -- | Return a list object with the same contents as the arbitrary sequence 167 | -- /seq/. The returned list is guaranteed to be new. 168 | {# fun PySequence_List as toList 169 | `Sequence seq' => 170 | { withObject* `seq' 171 | } -> `List' stealObject* #} 172 | 173 | -- | Return a tuple object with the same contents as the arbitrary sequence 174 | -- /seq/. If /seq/ is already a tuple, it is re-used rather than copied. 175 | {# fun PySequence_Tuple as toTuple 176 | `Sequence seq' => 177 | { withObject* `seq' 178 | } -> `Tuple' stealObject* #} 179 | 180 | -- | Returns the sequence /seq/ as a tuple, unless it is already a tuple or 181 | -- list, in which case /seq/ is returned. If an error occurs, throws 182 | -- @TypeError@ with the given text as the exception text. 183 | {# fun PySequence_Fast as fast 184 | `Sequence seq' => 185 | { withObject* `seq' 186 | , withText* `Text' 187 | } -> `SomeSequence' stealObject* #} 188 | -------------------------------------------------------------------------------- /lib/CPython/Reflection.chs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ForeignFunctionInterface #-} 2 | 3 | -- Copyright (C) 2009 John Millikin 4 | -- 5 | -- This program is free software: you can redistribute it and/or modify 6 | -- it under the terms of the GNU General Public License as published by 7 | -- the Free Software Foundation, either version 3 of the License, or 8 | -- any later version. 9 | -- 10 | -- This program is distributed in the hope that it will be useful, 11 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | -- GNU General Public License for more details. 14 | -- 15 | -- You should have received a copy of the GNU General Public License 16 | -- along with this program. If not, see . 17 | -- 18 | module CPython.Reflection 19 | ( getBuiltins 20 | , getLocals 21 | , getGlobals 22 | , getFrame 23 | , getFunctionName 24 | , getFunctionDescription 25 | ) where 26 | 27 | #include 28 | 29 | import Data.Text (Text) 30 | 31 | import CPython.Internal 32 | 33 | -- | Return a 'Dictionary' of the builtins in the current execution frame, 34 | -- or the interpreter of the thread state if no frame is currently executing. 35 | {# fun PyEval_GetBuiltins as getBuiltins 36 | {} -> `Dictionary' peekObject* #} 37 | 38 | -- | Return a 'Dictionary' of the local variables in the current execution 39 | -- frame, or 'Nothing' if no frame is currently executing. 40 | getLocals :: IO (Maybe Dictionary) 41 | getLocals = {# call PyEval_GetLocals as ^#} >>= maybePeek peekObject 42 | 43 | -- | Return a 'Dictionary' of the global variables in the current execution 44 | -- frame, or 'Nothing' if no frame is currently executing. 45 | getGlobals :: IO (Maybe Dictionary) 46 | getGlobals = {# call PyEval_GetGlobals as ^#} >>= maybePeek peekObject 47 | 48 | -- | Return the current thread state's frame, which is 'Nothing' if no frame 49 | -- is currently executing. 50 | getFrame :: IO (Maybe SomeObject) 51 | getFrame = {# call PyEval_GetFrame as ^#} >>= maybePeek peekObject 52 | 53 | -- | Return the name of /func/ if it is a function, class or instance object, 54 | -- else the name of /func/'s type. 55 | {# fun PyEval_GetFuncName as getFunctionName 56 | `Object func' => 57 | { withObject* `func' 58 | } -> `Text' peekText* #} 59 | 60 | -- | Return a description string, depending on the type of func. Return 61 | -- values include @\"()\"@ for functions and methods, @\"constructor\"@, 62 | -- @\"instance\"@, and @\"object\"@. Concatenated with the result of 63 | -- 'getFunctionName', the result will be a description of /func/. 64 | {# fun PyEval_GetFuncDesc as getFunctionDescription 65 | `Object func' => 66 | { withObject* `func' 67 | } -> `Text' peekText* #} 68 | -------------------------------------------------------------------------------- /lib/CPython/Simple.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ExistentialQuantification #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE ScopedTypeVariables #-} 4 | 5 | module CPython.Simple 6 | ( arg 7 | , FromPy(..) 8 | , PyCastException(..) 9 | , ToPy(..) 10 | , call 11 | , easyFromPy 12 | , easyToPy 13 | , getAttribute 14 | , importModule 15 | , initialize 16 | , setAttribute 17 | ) 18 | where 19 | 20 | import CPython.Simple.Instances 21 | 22 | import Control.Exception (catch, SomeException) 23 | import Data.Semigroup ((<>)) 24 | import Data.Text (Text) 25 | import qualified Data.Text as T 26 | 27 | import qualified CPython as Py 28 | import qualified CPython.Protocols.Object as Py 29 | import qualified CPython.Types as Py 30 | import qualified CPython.Types.Module as Py 31 | import qualified CPython.Types.Tuple as Py (toTuple) 32 | import qualified CPython.Types.Dictionary as PyDict 33 | 34 | -- | Representation of an argument to a Python function 35 | -- 36 | -- This lets us use various Haskell types in the same list of arguments. For example: 37 | -- 38 | -- @ 39 | -- sampleArgs :: [Arg] 40 | -- sampleArgs = 41 | -- [ arg (7 :: Integer) 42 | -- , arg ("hello" :: Text) 43 | -- ] 44 | -- @ 45 | data Arg = forall a. ToPy a => Arg a 46 | 47 | instance ToPy Arg where 48 | toPy (Arg a) = toPy a 49 | 50 | -- | Builds a Python argument from any Haskell type with a `ToPy` instance 51 | arg :: ToPy a => a -> Arg 52 | arg = Arg 53 | 54 | -- | Kicks off talking to Python, and will need to be called before using other functions 55 | initialize :: IO () 56 | initialize = Py.initialize 57 | 58 | -- | Given a Python module name as text, imports it as a `Py.Module` 59 | -- 60 | -- Throws an exception if e.g. the module name was misspelled, or isn't installed 61 | importModule :: Text -> IO Py.Module 62 | importModule module_ = Py.importModule module_ 63 | 64 | -- | The most common use case of `CPython.Simple` is calling some Python function 65 | -- 66 | -- For example, if we wanted to wrap Python's @random.randint(low, high)@, we could write this: 67 | -- 68 | -- @ 69 | -- randint :: Integer -> Integer -> IO Integer 70 | -- randint low high = 71 | -- call "random" "randint" [arg low, arg high] [] 72 | -- @ 73 | -- 74 | -- Because of the `FromPy` instance in `call`'s type signature, we can infer what to do to convert a Python value back into Haskell, if given the type. In this example using @random.uniform@, although we use a similar definition as for @randint@, we correct cast to `Double` instead of `Integer` 75 | -- 76 | -- @ 77 | -- uniform :: Integer -> Integer -> IO Double 78 | -- uniform low high = 79 | -- call "random" "uniform" [arg low, arg high] [] 80 | -- @ 81 | -- 82 | -- We can also use the `TypeApplications` language extension to tell `call` what type to use, if needed 83 | -- 84 | -- @ 85 | -- call @Double "random" "uniform" [arg low, arg high] [] 86 | -- @ 87 | -- 88 | -- Calling a function with mixed positional and keyword arguments is also fairly straightforward. 89 | -- 90 | -- The example is equivalent to calling @pyautogui.moveTo(x, y, duration=seconds)@ 91 | -- 92 | -- @ 93 | -- moveToDuration :: Integer -> Integer -> Double -> IO () 94 | -- moveToDuration x y seconds = 95 | -- call "pyautogui" "moveTo" [arg x, arg y] [("duration", arg seconds)] 96 | -- @ 97 | call 98 | :: FromPy a 99 | => Text -- ^ Python module name 100 | -> Text -- ^ Python function name 101 | -> [Arg] -- ^ Python function's arguments 102 | -> [(Text, Arg)] -- ^ Python function's keyword arguments (kwargs) as @(name, value)@ pairs 103 | -> IO a 104 | call moduleName func args kwargs = do 105 | module_ <- importModule moduleName 106 | pyFunc <- Py.getAttribute module_ =<< Py.toUnicode func 107 | pyArgs <- mapM toPy args 108 | pyArgsTuple <- Py.toTuple pyArgs 109 | pyKwargs <- toPyKwargs kwargs 110 | result <- Py.call pyFunc pyArgsTuple pyKwargs 111 | fromPy result 112 | where 113 | toPyKwargs :: [(Text, Arg)] -> IO Py.Dictionary 114 | toPyKwargs dict = do 115 | myDict <- PyDict.new 116 | mapM_ 117 | (\(k, v) -> do 118 | pyKey <- toPy k 119 | pyVal <- toPy v 120 | PyDict.setItem myDict pyKey pyVal) 121 | dict 122 | pure myDict 123 | 124 | -- | Set the value of an attribute of some Python module 125 | -- 126 | -- This example is equivalent to setting @random.BPF = n@ in Python 127 | -- 128 | -- @ 129 | -- setBpf :: Integer -> IO () 130 | -- setBpf n = setAttribute "random" \"BPF\" n 131 | -- @ 132 | setAttribute 133 | :: ToPy a 134 | => Text -- ^ module name 135 | -> Text -- ^ attribute name 136 | -> a -- ^ value to set attribute to 137 | -> IO () 138 | setAttribute moduleName name value = do 139 | module_ <- importModule moduleName 140 | pyName <- Py.toUnicode name 141 | pyValue <- toPy value 142 | Py.setAttribute module_ pyName pyValue 143 | 144 | -- | Get the value of an attribute of some Python module 145 | -- 146 | -- This example is equivalent to getting @random.BPF@ in Python 147 | -- 148 | -- @ 149 | -- getBpf :: IO Integer 150 | -- getBpf = getAttribute "random" \"BPF\" 151 | -- @ 152 | getAttribute 153 | :: FromPy a 154 | => Text -- ^ module name 155 | -> Text -- ^ attribute name 156 | -> IO a 157 | getAttribute moduleName name = do 158 | module_ <- importModule moduleName 159 | attr <- Py.getAttribute module_ =<< Py.toUnicode name 160 | fromPy attr 161 | -------------------------------------------------------------------------------- /lib/CPython/Simple/Instances.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances #-} 2 | {-# LANGUAGE LambdaCase #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | 5 | module CPython.Simple.Instances where 6 | 7 | import Control.Exception (Exception(..), throwIO) 8 | import Control.Monad ((<=<)) 9 | import Data.Text (Text) 10 | import qualified Data.Text as T 11 | import Data.Typeable 12 | 13 | import qualified CPython.Constants as Py 14 | import qualified CPython.Protocols.Object as Py 15 | import qualified CPython.Types as Py 16 | import qualified CPython.Types.Tuple as Py (fromTuple) 17 | 18 | -- | `ToPy` instances indicate that a type can be marshalled from Haskell to Python automatically 19 | -- 20 | -- For example, @ToPy Integer@ indicates that we know how to take a Haskell `Integer` and convert 21 | -- it into a Python `int` object 22 | class ToPy a where 23 | -- | Takes some Haskell type, and converts it to a Python object by going over FFI 24 | -- 25 | -- Generally you'll only need to call `toPy` manually on some type when writing your own `ToPy` instances for another type 26 | toPy :: a -> IO Py.SomeObject 27 | 28 | -- | `FromPy` instances indicate that a type can be marshalled from Python to Haskell automatically 29 | -- 30 | -- For example, @FromPy Integer@ indicates that we know how to take some Python object and convert 31 | -- it into a Haskell Integer. If the Python object is `int`, then we can cast properly. Failed casts throw a `PyCastException` 32 | class FromPy a where 33 | -- | Takes some Python object, and converts it to the corresponding Haskell type by going over FFI. Might throw a `PyCastException` 34 | -- 35 | -- Generally you'll only need to call `fromPy` manually on some type when writing your own `FromPy` instances for another type 36 | fromPy :: Py.SomeObject -> IO a 37 | 38 | -- | An exception representing a failed cast from a Python object to Haskell value, usually because the expected type of the Python object was not correct. 39 | -- 40 | -- Carries a `String` which represents the name of the expected Haskell type which caused a failed cast. If using `easyFromPy`, this `String` is found with `typeRep` 41 | data PyCastException = PyCastException String 42 | deriving (Show) 43 | 44 | instance Exception PyCastException where 45 | displayException (PyCastException typename) = 46 | "FromPy could not cast to " ++ typename 47 | 48 | -- | Helper that lets you convert a Haskell value to a Python object by providing both a Python conversion function (from the Haskell type, over FFI, to some Python Object) as well as the Haskell value 49 | -- 50 | -- Lets you define `toPy` with just a Python conversion function 51 | easyToPy 52 | :: Py.Object p 53 | => (h -> IO p) -- ^ python to- conversion, e.g. Py.toFloat 54 | -> h -- ^ haskell type being converted 55 | -> IO Py.SomeObject -- ^ Python object 56 | easyToPy convert = fmap Py.toObject . convert 57 | 58 | -- | Helper that takes a conversion function and a Python object, and casts the Python object 59 | -- into a Haskell value. 60 | -- 61 | -- Lets you define `fromPy` with just a Python conversion function 62 | -- 63 | -- We use `Proxy` to infer the type name for use in case of a failed cast. In the context of defining an instance, this type will be inferrable, so you can just provide a `Proxy` value 64 | easyFromPy 65 | :: (Py.Concrete p, Typeable h) 66 | => (p -> IO h) -- ^ python from- conversion, e.g. Py.fromFloat 67 | -> Proxy h -- ^ proxy for the type being converted to 68 | -> Py.SomeObject -- ^ python object to cast from 69 | -> IO h -- ^ Haskell value 70 | easyFromPy convert typename obj = do 71 | casted <- Py.cast obj 72 | case casted of 73 | Nothing -> throwIO $ PyCastException (show $ typeRep typename) 74 | Just x -> convert x 75 | 76 | instance ToPy Bool where 77 | toPy b = if b then Py.true else Py.false 78 | 79 | instance FromPy Bool where 80 | fromPy pyB = do 81 | isTrue <- Py.isTrue pyB 82 | isFalse <- Py.isFalse pyB 83 | case (isTrue, isFalse) of 84 | (True, False) -> pure True 85 | (False, True) -> pure False 86 | (False, False) -> throwIO . PyCastException . show $ typeRep (Proxy :: Proxy Bool) 87 | (True, True) -> throwIO . PyCastException $ (show $ typeRep (Proxy :: Proxy Bool)) ++ 88 | ". Python object was True and False at the same time. Should be impossible." 89 | 90 | instance ToPy Integer where 91 | toPy = easyToPy Py.toInteger 92 | 93 | instance FromPy Integer where 94 | fromPy = easyFromPy Py.fromInteger Proxy 95 | 96 | instance ToPy Double where 97 | toPy = easyToPy Py.toFloat 98 | 99 | instance FromPy Double where 100 | fromPy = easyFromPy Py.fromFloat Proxy 101 | 102 | instance ToPy Text where 103 | toPy = easyToPy Py.toUnicode 104 | 105 | instance FromPy Text where 106 | fromPy = easyFromPy Py.fromUnicode Proxy 107 | 108 | instance ToPy Char where 109 | toPy = easyToPy Py.toUnicode . T.singleton 110 | 111 | instance FromPy Char where 112 | fromPy c = T.head <$> easyFromPy Py.fromUnicode Proxy c 113 | 114 | instance ToPy String where 115 | toPy = easyToPy Py.toUnicode . T.pack 116 | 117 | instance FromPy String where 118 | fromPy s = T.unpack <$> easyFromPy Py.fromUnicode Proxy s 119 | 120 | instance (FromPy a, FromPy b) => FromPy (a, b) where 121 | fromPy val = do 122 | [pyA, pyB] <- easyFromPy Py.fromTuple Proxy val 123 | a <- fromPy pyA 124 | b <- fromPy pyB 125 | pure (a, b) 126 | 127 | instance (ToPy a, ToPy b) => ToPy (a, b) where 128 | toPy (a, b) = do 129 | pyA <- toPy a 130 | pyB <- toPy b 131 | easyToPy Py.toTuple [pyA, pyB] 132 | 133 | instance (FromPy a, FromPy b, FromPy c) => FromPy (a, b, c) where 134 | fromPy val = do 135 | [pyA, pyB, pyC] <- easyFromPy Py.fromTuple Proxy val 136 | a <- fromPy pyA 137 | b <- fromPy pyB 138 | c <- fromPy pyC 139 | pure (a, b, c) 140 | 141 | instance (ToPy a, ToPy b, ToPy c) => ToPy (a, b, c) where 142 | toPy (a, b, c) = do 143 | pyA <- toPy a 144 | pyB <- toPy b 145 | pyC <- toPy c 146 | easyToPy Py.toTuple [pyA, pyB, pyC] 147 | 148 | instance (FromPy a, FromPy b, FromPy c, FromPy d) => FromPy (a, b, c, d) where 149 | fromPy val = do 150 | [pyA, pyB, pyC, pyD] <- easyFromPy Py.fromTuple Proxy val 151 | a <- fromPy pyA 152 | b <- fromPy pyB 153 | c <- fromPy pyC 154 | d <- fromPy pyD 155 | pure (a, b, c, d) 156 | 157 | instance (ToPy a, ToPy b, ToPy c, ToPy d) => ToPy (a, b, c, d) where 158 | toPy (a, b, c, d) = do 159 | pyA <- toPy a 160 | pyB <- toPy b 161 | pyC <- toPy c 162 | pyD <- toPy d 163 | easyToPy Py.toTuple [pyA, pyB, pyC, pyD] 164 | 165 | instance FromPy a => FromPy (Maybe a) where 166 | fromPy val = do 167 | isNone <- Py.isNone val 168 | if isNone 169 | then pure Nothing 170 | else Just <$> fromPy val 171 | 172 | instance ToPy a => ToPy (Maybe a) where 173 | toPy Nothing = Py.none 174 | toPy (Just a) = toPy a 175 | 176 | instance FromPy a => FromPy [a] where 177 | fromPy val = do 178 | list <- easyFromPy Py.fromList Proxy val 179 | mapM fromPy list 180 | 181 | instance ToPy a => ToPy [a] where 182 | toPy val = do 183 | list <- mapM toPy val 184 | Py.toObject <$> Py.toList list 185 | 186 | instance FromPy () where 187 | fromPy _ = pure () 188 | -------------------------------------------------------------------------------- /lib/CPython/System.chs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ForeignFunctionInterface #-} 2 | 3 | -- Copyright (C) 2009 John Millikin 4 | -- 5 | -- This program is free software: you can redistribute it and/or modify 6 | -- it under the terms of the GNU General Public License as published by 7 | -- the Free Software Foundation, either version 3 of the License, or 8 | -- any later version. 9 | -- 10 | -- This program is distributed in the hope that it will be useful, 11 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | -- GNU General Public License for more details. 14 | -- 15 | -- You should have received a copy of the GNU General Public License 16 | -- along with this program. If not, see . 17 | 18 | module CPython.System 19 | ( getObject 20 | , setObject 21 | , deleteObject 22 | , resetWarnOptions 23 | , addWarnOption 24 | , setPath 25 | ) where 26 | 27 | #include 28 | 29 | import Data.Text (Text) 30 | 31 | import CPython.Internal 32 | 33 | -- | Return the object /name/ from the @sys@ module, or 'Nothing' if it does 34 | -- not exist. 35 | getObject :: Text -> IO (Maybe SomeObject) 36 | getObject name = 37 | withText name $ \cstr -> do 38 | raw <- {# call PySys_GetObject as ^ #} cstr 39 | maybePeek peekObject raw 40 | 41 | -- getFile 42 | 43 | -- | Set /name/ in the @sys@ module to a value. 44 | setObject :: Object a => Text -> a -> IO () 45 | setObject name v = 46 | withText name $ \cstr -> 47 | withObject v $ \vPtr -> 48 | {# call PySys_SetObject as ^ #} cstr vPtr 49 | >>= checkStatusCode 50 | 51 | -- | Delete /name/ from the @sys@ module. 52 | deleteObject :: Text -> IO () 53 | deleteObject name = 54 | withText name $ \cstr -> 55 | {# call PySys_SetObject as ^ #} cstr nullPtr 56 | >>= checkStatusCode 57 | 58 | -- | Reset @sys.warnoptions@ to an empty list. 59 | {# fun PySys_ResetWarnOptions as resetWarnOptions 60 | {} -> `()' id #} 61 | 62 | -- | Add an entry to @sys.warnoptions@. 63 | addWarnOption :: Text -> IO () 64 | addWarnOption str = withTextW str pySysAddWarnOption 65 | 66 | foreign import ccall safe "hscpython-shim.h PySys_AddWarnOption" 67 | pySysAddWarnOption :: CWString -> IO () 68 | 69 | -- | Set @sys.path@ to a list object of paths found in the parameter, which 70 | -- should be a list of paths separated with the platform's search path 71 | -- delimiter (@\':\'@ on Unix, @\';\'@ on Windows). 72 | setPath :: Text -> IO () 73 | setPath path = withTextW path pySysSetPath 74 | 75 | foreign import ccall safe "hscpython-shim.h PySys_SetPath" 76 | pySysSetPath :: CWString -> IO () 77 | -------------------------------------------------------------------------------- /lib/CPython/Types.hs: -------------------------------------------------------------------------------- 1 | -- Copyright (C) 2009 John Millikin 2 | -- 3 | -- This program is free software: you can redistribute it and/or modify 4 | -- it under the terms of the GNU General Public License as published by 5 | -- the Free Software Foundation, either version 3 of the License, or 6 | -- any later version. 7 | -- 8 | -- This program is distributed in the hope that it will be useful, 9 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | -- GNU General Public License for more details. 12 | -- 13 | -- You should have received a copy of the GNU General Public License 14 | -- along with this program. If not, see . 15 | 16 | module CPython.Types 17 | ( 18 | -- * Types and classes 19 | ByteArray 20 | , Bytes 21 | , Capsule 22 | , Cell 23 | , Code 24 | , Complex 25 | , Dictionary 26 | , Exception 27 | , CPython.Types.Float.Float 28 | , Function 29 | , InstanceMethod 30 | , CPython.Types.Integer.Integer 31 | , SequenceIterator 32 | , CallableIterator 33 | , List 34 | , Method 35 | , Module 36 | , AnySet 37 | , Set 38 | , FrozenSet 39 | , Slice 40 | , Tuple 41 | , Type 42 | , Unicode 43 | , Reference 44 | , Proxy 45 | 46 | -- * Python 'Type' values 47 | , byteArrayType 48 | , bytesType 49 | , capsuleType 50 | , cellType 51 | , codeType 52 | , complexType 53 | , dictionaryType 54 | , floatType 55 | , functionType 56 | , instanceMethodType 57 | , integerType 58 | , sequenceIteratorType 59 | , callableIteratorType 60 | , listType 61 | , methodType 62 | , moduleType 63 | , setType 64 | , frozenSetType 65 | , sliceType 66 | , tupleType 67 | , typeType 68 | , unicodeType 69 | 70 | -- * Building and parsing values 71 | , toByteArray 72 | , fromByteArray 73 | , toBytes 74 | , fromBytes 75 | , toComplex 76 | , fromComplex 77 | , toFloat 78 | , fromFloat 79 | , CPython.Types.Integer.toInteger 80 | , CPython.Types.Integer.fromInteger 81 | , toList 82 | , iterableToList 83 | , fromList 84 | , toSet 85 | , toFrozenSet 86 | , iterableToSet 87 | , iterableToFrozenSet 88 | , fromSet 89 | , CPython.Types.Tuple.toTuple 90 | , iterableToTuple 91 | , fromTuple 92 | , toUnicode 93 | , fromUnicode 94 | ) where 95 | 96 | import CPython.Types.ByteArray 97 | import CPython.Types.Bytes 98 | import CPython.Types.Capsule 99 | import CPython.Types.Cell 100 | import CPython.Types.Code 101 | import CPython.Types.Complex 102 | import CPython.Types.Dictionary 103 | import CPython.Types.Exception 104 | import CPython.Types.Float 105 | import CPython.Types.Function 106 | import CPython.Types.InstanceMethod 107 | import CPython.Types.Integer 108 | import CPython.Types.Iterator 109 | import CPython.Types.List 110 | import CPython.Types.Method 111 | import CPython.Types.Module 112 | import CPython.Types.Set 113 | import CPython.Types.Slice 114 | import CPython.Types.Tuple 115 | import CPython.Types.Type 116 | import CPython.Types.Unicode 117 | import CPython.Types.WeakReference 118 | -------------------------------------------------------------------------------- /lib/CPython/Types/ByteArray.chs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ForeignFunctionInterface #-} 2 | 3 | -- Copyright (C) 2009 John Millikin 4 | -- 5 | -- This program is free software: you can redistribute it and/or modify 6 | -- it under the terms of the GNU General Public License as published by 7 | -- the Free Software Foundation, either version 3 of the License, or 8 | -- any later version. 9 | -- 10 | -- This program is distributed in the hope that it will be useful, 11 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | -- GNU General Public License for more details. 14 | -- 15 | -- You should have received a copy of the GNU General Public License 16 | -- along with this program. If not, see . 17 | 18 | module CPython.Types.ByteArray 19 | ( ByteArray 20 | , byteArrayType 21 | , toByteArray 22 | , fromByteArray 23 | , fromObject 24 | , append 25 | , length 26 | , resize 27 | ) where 28 | 29 | #include 30 | 31 | import Prelude hiding (length) 32 | import qualified Data.ByteString as B 33 | import qualified Data.ByteString.Unsafe as B 34 | 35 | import CPython.Internal 36 | 37 | newtype ByteArray = ByteArray (ForeignPtr ByteArray) 38 | 39 | instance Object ByteArray where 40 | toObject (ByteArray x) = SomeObject x 41 | fromForeignPtr = ByteArray 42 | 43 | instance Concrete ByteArray where 44 | concreteType _ = byteArrayType 45 | 46 | {# fun pure unsafe hscpython_PyByteArray_Type as byteArrayType 47 | {} -> `Type' peekStaticObject* #} 48 | 49 | toByteArray :: B.ByteString -> IO ByteArray 50 | toByteArray bytes = let 51 | mkByteArray = {# call PyByteArray_FromStringAndSize as ^ #} 52 | in B.unsafeUseAsCStringLen bytes $ \(cstr, len) -> 53 | stealObject =<< mkByteArray cstr (fromIntegral len) 54 | 55 | fromByteArray :: ByteArray -> IO B.ByteString 56 | fromByteArray py = 57 | withObject py $ \pyPtr -> do 58 | size' <- {# call PyByteArray_Size as ^ #} pyPtr 59 | bytes <- {# call PyByteArray_AsString as ^ #} pyPtr 60 | B.packCStringLen (bytes, fromIntegral size') 61 | 62 | -- | Create a new byte array from any object which implements the buffer 63 | -- protocol. 64 | {# fun PyByteArray_FromObject as fromObject 65 | `Object self ' => 66 | { withObject* `self' 67 | } -> `ByteArray' stealObject* #} 68 | 69 | {# fun PyByteArray_Concat as append 70 | { withObject* `ByteArray' 71 | , withObject* `ByteArray' 72 | } -> `ByteArray' stealObject* #} 73 | 74 | {# fun PyByteArray_Size as length 75 | { withObject* `ByteArray' 76 | } -> `Integer' checkIntReturn* #} 77 | 78 | {# fun PyByteArray_Resize as resize 79 | { withObject* `ByteArray' 80 | , fromIntegral `Integer' 81 | } -> `()' checkStatusCode* #} 82 | -------------------------------------------------------------------------------- /lib/CPython/Types/Bytes.chs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ForeignFunctionInterface #-} 2 | 3 | -- Copyright (C) 2009 John Millikin 4 | -- 5 | -- This program is free software: you can redistribute it and/or modify 6 | -- it under the terms of the GNU General Public License as published by 7 | -- the Free Software Foundation, either version 3 of the License, or 8 | -- any later version. 9 | -- 10 | -- This program is distributed in the hope that it will be useful, 11 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | -- GNU General Public License for more details. 14 | -- 15 | -- You should have received a copy of the GNU General Public License 16 | -- along with this program. If not, see . 17 | 18 | module CPython.Types.Bytes 19 | ( Bytes 20 | , bytesType 21 | , toBytes 22 | , fromBytes 23 | , fromObject 24 | , length 25 | , append 26 | ) where 27 | 28 | #include 29 | 30 | import Prelude hiding (length) 31 | import qualified Data.ByteString as B 32 | import qualified Data.ByteString.Unsafe as B 33 | 34 | import CPython.Internal 35 | 36 | newtype Bytes = Bytes (ForeignPtr Bytes) 37 | 38 | instance Object Bytes where 39 | toObject (Bytes x) = SomeObject x 40 | fromForeignPtr = Bytes 41 | 42 | instance Concrete Bytes where 43 | concreteType _ = bytesType 44 | 45 | {# fun pure unsafe hscpython_PyBytes_Type as bytesType 46 | {} -> `Type' peekStaticObject* #} 47 | 48 | toBytes :: B.ByteString -> IO Bytes 49 | toBytes bytes = let 50 | mkBytes = {# call PyBytes_FromStringAndSize as ^ #} 51 | in B.unsafeUseAsCStringLen bytes $ \(cstr, len) -> 52 | stealObject =<< mkBytes cstr (fromIntegral len) 53 | 54 | fromBytes :: Bytes -> IO B.ByteString 55 | fromBytes py = 56 | alloca $ \bytesPtr -> 57 | alloca $ \lenPtr -> 58 | withObject py $ \pyPtr -> 59 | do 60 | {# call PyBytes_AsStringAndSize as ^ #} pyPtr bytesPtr lenPtr >>= checkStatusCode 61 | bytes <- peek bytesPtr 62 | len <- peek lenPtr 63 | B.packCStringLen (bytes, fromIntegral len) 64 | 65 | -- | Create a new byte string from any object which implements the buffer 66 | -- protocol. 67 | {# fun PyBytes_FromObject as fromObject 68 | `Object self ' => 69 | { withObject* `self' 70 | } -> `Bytes' stealObject* #} 71 | 72 | {# fun PyBytes_Size as length 73 | { withObject* `Bytes' 74 | } -> `Integer' checkIntReturn* #} 75 | 76 | append :: Bytes -> Bytes -> IO Bytes 77 | append self next = 78 | alloca $ \tempPtr -> 79 | do 80 | withObject self $ \selfPtr -> 81 | do incref selfPtr 82 | poke tempPtr selfPtr 83 | withObject next $ \nextPtr -> 84 | do 85 | {# call PyBytes_Concat as ^ #} tempPtr nextPtr 86 | newSelf <- peek tempPtr 87 | stealObject newSelf 88 | -------------------------------------------------------------------------------- /lib/CPython/Types/Capsule.chs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ForeignFunctionInterface #-} 2 | 3 | -- Copyright (C) 2009 John Millikin 4 | -- 5 | -- This program is free software: you can redistribute it and/or modify 6 | -- it under the terms of the GNU General Public License as published by 7 | -- the Free Software Foundation, either version 3 of the License, or 8 | -- any later version. 9 | -- 10 | -- This program is distributed in the hope that it will be useful, 11 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | -- GNU General Public License for more details. 14 | -- 15 | -- You should have received a copy of the GNU General Public License 16 | -- along with this program. If not, see . 17 | 18 | module CPython.Types.Capsule 19 | ( Capsule 20 | , capsuleType 21 | --, new 22 | , getPointer 23 | --, getDestructor 24 | , getContext 25 | , getName 26 | , importNamed 27 | , isValid 28 | , setPointer 29 | --, setDestructor 30 | , setContext 31 | --, setName 32 | ) where 33 | 34 | #include 35 | 36 | import Data.Text (Text) 37 | 38 | import CPython.Internal hiding (new) 39 | 40 | -- type Destructor = Ptr () -> IO () 41 | newtype Capsule = Capsule (ForeignPtr Capsule) 42 | 43 | instance Object Capsule where 44 | toObject (Capsule x) = SomeObject x 45 | fromForeignPtr = Capsule 46 | 47 | instance Concrete Capsule where 48 | concreteType _ = capsuleType 49 | 50 | {# fun pure unsafe hscpython_PyCapsule_Type as capsuleType 51 | {} -> `Type' peekStaticObject* #} 52 | 53 | -- new :: Ptr () -> Maybe Text -> Destructor -> IO Capsule 54 | -- new = undefined 55 | 56 | -- | Retrieve the pointer stored in the capsule. On failure, throws an 57 | -- exception. 58 | -- 59 | -- The name parameter must compare exactly to the name stored in the capsule. 60 | -- If the name stored in the capsule is 'Nothing', the name passed in must 61 | -- also be 'Nothing'. Python uses the C function strcmp() to compare capsule 62 | -- names. 63 | getPointer :: Capsule -> Maybe Text -> IO (Ptr ()) 64 | getPointer py name = 65 | withObject py $ \pyPtr -> 66 | maybeWith withText name $ \namePtr -> 67 | {# call PyCapsule_GetPointer as ^ #} pyPtr namePtr 68 | 69 | -- getDestructor :: Capsule -> IO (Maybe Destructor) 70 | -- getDestructor = undefined 71 | 72 | -- | Return the current context stored in the capsule, which might be @NULL@. 73 | getContext :: Capsule -> IO (Ptr ()) 74 | getContext py = 75 | withObject py $ \pyPtr -> do 76 | {# call PyErr_Clear as ^ #} 77 | ptr <- {# call PyCapsule_GetContext as ^ #} pyPtr 78 | if ptr /= nullPtr 79 | then return ptr 80 | else do 81 | exc <- {# call PyErr_Occurred as ^ #} 82 | exceptionIf $ exc /= nullPtr 83 | return ptr 84 | 85 | -- | Return the current name stored in the capsule, which might be 'Nothing'. 86 | getName :: Capsule -> IO (Maybe Text) 87 | getName py = 88 | withObject py $ \pyPtr -> do 89 | {# call PyErr_Clear as ^ #} 90 | ptr <- {# call PyCapsule_GetName as ^ #} pyPtr 91 | if ptr /= nullPtr 92 | then Just `fmap` peekText ptr 93 | else do 94 | exc <- {# call PyErr_Occurred as ^ #} 95 | exceptionIf $ exc /= nullPtr 96 | return Nothing 97 | 98 | -- | Import a pointer to a C object from a capsule attribute in a module. 99 | -- The name parameter should specify the full name to the attribute, as in 100 | -- @\"module.attribute\"@. The name stored in the capsule must match this 101 | -- string exactly. If the second parameter is 'False', import the module 102 | -- without blocking (using @PyImport_ImportModuleNoBlock()@). Otherwise, 103 | -- imports the module conventionally (using @PyImport_ImportModule()@). 104 | -- 105 | -- Return the capsule’s internal pointer on success. On failure, throw 106 | -- an exception. If the module could not be imported, and if importing in 107 | -- non-blocking mode, returns 'Nothing'. 108 | importNamed :: Text -> Bool -> IO (Maybe (Ptr ())) 109 | importNamed name block = 110 | withText name $ \namePtr -> 111 | let noBlock = cFromBool (not block) in do 112 | {# call PyErr_Clear as ^ #} 113 | ptr <- {# call PyCapsule_Import as ^ #} namePtr noBlock 114 | if ptr /= nullPtr 115 | then return $ Just ptr 116 | else do 117 | exc <- {# call PyErr_Occurred as ^ #} 118 | exceptionIf $ exc /= nullPtr 119 | return Nothing 120 | 121 | -- | Determines whether or not a capsule is valid. A valid capsule's type is 122 | -- 'capsuleType', has a non-NULL pointer stored in it, and its internal name 123 | -- matches the name parameter. (See 'getPointer' for information on how 124 | -- capsule names are compared.) 125 | -- 126 | -- In other words, if 'isValid' returns 'True', calls to any of the 127 | -- accessors (any function starting with @get@) are guaranteed to succeed. 128 | isValid :: Capsule -> Maybe Text -> IO Bool 129 | isValid py name = 130 | withObject py $ \pyPtr -> 131 | maybeWith withText name $ \namePtr -> 132 | {# call PyCapsule_IsValid as ^ #} pyPtr namePtr 133 | >>= checkBoolReturn 134 | 135 | -- | Set the void pointer inside the capsule. The pointer may not be @NULL@. 136 | {# fun PyCapsule_SetPointer as setPointer 137 | { withObject* `Capsule' 138 | , id `Ptr ()' 139 | } -> `()' checkStatusCode* #} 140 | 141 | -- setDestructor :: Capsule -> Maybe Destructor -> IO () 142 | -- setDestructor = undefined 143 | 144 | -- | Set the context pointer inside the capsule. 145 | {# fun PyCapsule_SetContext as setContext 146 | { withObject* `Capsule' 147 | , id `Ptr ()' 148 | } -> `()' checkStatusCode* #} 149 | 150 | -- setName :: Capsule -> Maybe Text -> IO () 151 | -- setName = undefined 152 | -------------------------------------------------------------------------------- /lib/CPython/Types/Cell.chs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ForeignFunctionInterface #-} 2 | 3 | -- Copyright (C) 2009 John Millikin 4 | -- 5 | -- This program is free software: you can redistribute it and/or modify 6 | -- it under the terms of the GNU General Public License as published by 7 | -- the Free Software Foundation, either version 3 of the License, or 8 | -- any later version. 9 | -- 10 | -- This program is distributed in the hope that it will be useful, 11 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | -- GNU General Public License for more details. 14 | -- 15 | -- You should have received a copy of the GNU General Public License 16 | -- along with this program. If not, see . 17 | 18 | module CPython.Types.Cell 19 | ( Cell 20 | , cellType 21 | , new 22 | , get 23 | , set 24 | ) where 25 | 26 | #include 27 | 28 | import CPython.Internal hiding (new) 29 | 30 | newtype Cell = Cell (ForeignPtr Cell) 31 | 32 | instance Object Cell where 33 | toObject (Cell x) = SomeObject x 34 | fromForeignPtr = Cell 35 | 36 | instance Concrete Cell where 37 | concreteType _ = cellType 38 | 39 | {# fun pure unsafe hscpython_PyCell_Type as cellType 40 | {} -> `Type' peekStaticObject* #} 41 | 42 | -- | Create and return a new cell containing the value /obj/. 43 | new :: Object obj => Maybe obj -> IO Cell 44 | new obj = 45 | maybeWith withObject obj $ \objPtr -> 46 | {# call PyCell_New as ^ #} objPtr 47 | >>= stealObject 48 | 49 | -- | Return the contents of a cell. 50 | get :: Cell -> IO (Maybe SomeObject) 51 | get cell = 52 | withObject cell $ \cellPtr -> 53 | {# call PyCell_Get as ^ #} cellPtr 54 | >>= maybePeek stealObject 55 | 56 | -- | Set the contents of a cell to /obj/. This releases the reference to any 57 | -- current content of the cell. 58 | set :: Object obj => Cell -> Maybe obj -> IO () 59 | set cell obj = 60 | withObject cell $ \cellPtr -> 61 | maybeWith withObject obj $ \objPtr -> 62 | {# call PyCell_Set as ^ #} cellPtr objPtr 63 | >>= checkStatusCode 64 | -------------------------------------------------------------------------------- /lib/CPython/Types/Code.chs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ForeignFunctionInterface #-} 2 | 3 | -- Copyright (C) 2009 John Millikin 4 | -- 5 | -- This program is free software: you can redistribute it and/or modify 6 | -- it under the terms of the GNU General Public License as published by 7 | -- the Free Software Foundation, either version 3 of the License, or 8 | -- any later version. 9 | -- 10 | -- This program is distributed in the hope that it will be useful, 11 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | -- GNU General Public License for more details. 14 | -- 15 | -- You should have received a copy of the GNU General Public License 16 | -- along with this program. If not, see . 17 | 18 | module CPython.Types.Code 19 | ( Code 20 | , codeType 21 | ) where 22 | 23 | #include 24 | 25 | import CPython.Internal 26 | 27 | newtype Code = Code (ForeignPtr Code) 28 | 29 | instance Object Code where 30 | toObject (Code x) = SomeObject x 31 | fromForeignPtr = Code 32 | 33 | instance Concrete Code where 34 | concreteType _ = codeType 35 | 36 | {# fun pure unsafe hscpython_PyCode_Type as codeType 37 | {} -> `Type' peekStaticObject* #} 38 | -------------------------------------------------------------------------------- /lib/CPython/Types/Complex.chs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ForeignFunctionInterface #-} 2 | 3 | -- Copyright (C) 2009 John Millikin 4 | -- 5 | -- This program is free software: you can redistribute it and/or modify 6 | -- it under the terms of the GNU General Public License as published by 7 | -- the Free Software Foundation, either version 3 of the License, or 8 | -- any later version. 9 | -- 10 | -- This program is distributed in the hope that it will be useful, 11 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | -- GNU General Public License for more details. 14 | -- 15 | -- You should have received a copy of the GNU General Public License 16 | -- along with this program. If not, see . 17 | 18 | module CPython.Types.Complex 19 | ( Complex 20 | , complexType 21 | , toComplex 22 | , fromComplex 23 | ) where 24 | 25 | #include 26 | 27 | import qualified Data.Complex as C 28 | 29 | import CPython.Internal 30 | 31 | newtype Complex = Complex (ForeignPtr Complex) 32 | 33 | instance Object Complex where 34 | toObject (Complex x) = SomeObject x 35 | fromForeignPtr = Complex 36 | 37 | instance Concrete Complex where 38 | concreteType _ = complexType 39 | 40 | {# fun pure unsafe hscpython_PyComplex_Type as complexType 41 | {} -> `Type' peekStaticObject* #} 42 | 43 | toComplex :: C.Complex Double -> IO Complex 44 | toComplex x = raw >>= stealObject where 45 | real = realToFrac $ C.realPart x 46 | imag = realToFrac $ C.imagPart x 47 | raw = {# call PyComplex_FromDoubles as ^ #} real imag 48 | 49 | fromComplex :: Complex -> IO (C.Complex Double) 50 | fromComplex py = withObject py $ \pyPtr -> do 51 | real <- {# call PyComplex_RealAsDouble as ^ #} pyPtr 52 | imag <- {# call PyComplex_ImagAsDouble as ^ #} pyPtr 53 | return $ realToFrac real C.:+ realToFrac imag 54 | -------------------------------------------------------------------------------- /lib/CPython/Types/Dictionary.chs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ForeignFunctionInterface #-} 2 | 3 | -- Copyright (C) 2009 John Millikin 4 | -- 5 | -- This program is free software: you can redistribute it and/or modify 6 | -- it under the terms of the GNU General Public License as published by 7 | -- the Free Software Foundation, either version 3 of the License, or 8 | -- any later version. 9 | -- 10 | -- This program is distributed in the hope that it will be useful, 11 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | -- GNU General Public License for more details. 14 | -- 15 | -- You should have received a copy of the GNU General Public License 16 | -- along with this program. If not, see . 17 | 18 | module CPython.Types.Dictionary 19 | ( Dictionary 20 | , dictionaryType 21 | , new 22 | , clear 23 | , contains 24 | , copy 25 | , getItem 26 | , setItem 27 | , deleteItem 28 | , items 29 | , keys 30 | , values 31 | , size 32 | , merge 33 | , update 34 | , mergeFromSeq2 35 | ) where 36 | 37 | #include 38 | 39 | import CPython.Internal hiding (new) 40 | 41 | instance Concrete Dictionary where 42 | concreteType _ = dictionaryType 43 | 44 | {# fun pure unsafe hscpython_PyDict_Type as dictionaryType 45 | {} -> `Type' peekStaticObject* #} 46 | 47 | {# fun PyDict_New as new 48 | {} -> `Dictionary' stealObject* #} 49 | 50 | -- newProxy 51 | 52 | -- | Empty an existing dictionary of all key-value pairs. 53 | {# fun PyDict_Clear as clear 54 | { withObject* `Dictionary' 55 | } -> `()' id #} 56 | 57 | -- | Determine if a dictionary contains /key/. If an item in the dictionary 58 | -- matches /key/, return 'True', otherwise return 'False'. On error, throws 59 | -- an exception. This is equivalent to the Python expression @key in d@. 60 | {# fun PyDict_Contains as contains 61 | `Object key' => 62 | { withObject* `Dictionary' 63 | , withObject* `key' 64 | } -> `Bool' checkBoolReturn* #} 65 | 66 | -- | Return a new dictionary that contains the same key-value pairs as the 67 | -- old dictionary. 68 | {# fun PyDict_Copy as copy 69 | { withObject* `Dictionary' 70 | } -> `Dictionary' stealObject* #} 71 | 72 | -- | Return the object from a dictionary which has a key /key/. Return 73 | -- 'Nothing' if the key is not present. 74 | getItem :: Object key => Dictionary -> key -> IO (Maybe SomeObject) 75 | getItem dict key = 76 | withObject dict $ \dict' -> 77 | withObject key $ \key' -> do 78 | {# call PyErr_Clear as ^ #} 79 | raw <- {# call PyDict_GetItemWithError as ^ #} dict' key' 80 | if raw /= nullPtr 81 | then Just `fmap` peekObject raw 82 | else do 83 | exc <- {# call PyErr_Occurred as ^ #} 84 | exceptionIf $ exc /= nullPtr 85 | return Nothing 86 | 87 | -- getItemString 88 | 89 | -- | Inserts /value/ into a dictionary with a key of /key/. /key/ must be 90 | -- hashable; if it isn’t, throws @TypeError@. 91 | {# fun PyDict_SetItem as setItem 92 | `(Object key, Object value)' => 93 | { withObject* `Dictionary' 94 | , withObject* `key' 95 | , withObject* `value' 96 | } -> `()' checkStatusCode* #} 97 | 98 | -- setItemString 99 | 100 | -- | Remove the entry in a dictionary with key /key/. /key/ must be hashable; 101 | -- if it isn’t, throws @TypeError@. 102 | {# fun PyDict_DelItem as deleteItem 103 | `Object key' => 104 | { withObject* `Dictionary' 105 | , withObject* `key' 106 | } -> `()' checkStatusCode* #} 107 | 108 | -- deleteItemString 109 | 110 | -- | Return a 'List' containing all the items in the dictionary, as in 111 | -- the Python method @dict.items()@. 112 | {# fun PyDict_Items as items 113 | { withObject* `Dictionary' 114 | } -> `List' stealObject* #} 115 | 116 | -- | Return a 'List' containing all the keys in the dictionary, as in 117 | -- the Python method @dict.keys()@. 118 | {# fun PyDict_Keys as keys 119 | { withObject* `Dictionary' 120 | } -> `List' stealObject* #} 121 | 122 | -- | Return a 'List' containing all the values in the dictionary, as in 123 | -- the Python method @dict.values()@. 124 | {# fun PyDict_Values as values 125 | { withObject* `Dictionary' 126 | } -> `List' stealObject* #} 127 | 128 | -- | Return the number of items in the dictionary. This is equivalent to 129 | -- @len(d)@. 130 | {# fun PyDict_Size as size 131 | { withObject* `Dictionary' 132 | } -> `Integer' checkIntReturn* #} 133 | 134 | -- next 135 | 136 | -- | Iterate over mapping object /b/ adding key-value pairs to a dictionary. 137 | -- /b/ may be a dictionary, or any object supporting 'keys' and 'getItem'. 138 | -- If the third parameter is 'True', existing pairs in will be replaced if a 139 | -- matching key is found in /b/, otherwise pairs will only be added if there 140 | -- is not already a matching key. 141 | {# fun PyDict_Merge as merge 142 | `Mapping b' => 143 | { withObject* `Dictionary' 144 | , withObject* `b' 145 | , `Bool' 146 | } -> `()' checkStatusCode* #} 147 | 148 | -- | This is the same as @(\\a b -> 'merge' a b True)@ in Haskell, or 149 | -- @a.update(b)@ in Python. 150 | {# fun PyDict_Update as update 151 | `Mapping b' => 152 | { withObject* `Dictionary' 153 | , withObject* `b' 154 | } -> `()' checkStatusCode* #} 155 | 156 | -- | Update or merge into a dictionary, from the key-value pairs in /seq2/. 157 | -- /seq2/ must be an iterable object producing iterable objects of length 2, 158 | -- viewed as key-value pairs. In case of duplicate keys, the last wins if 159 | -- the third parameter is 'True', otherwise the first wins. Equivalent 160 | -- Python: 161 | -- 162 | -- @ 163 | -- def mergeFromSeq2(a, seq2, override): 164 | -- for key, value in seq2: 165 | -- if override or key not in a: 166 | -- a[key] = value 167 | -- @ 168 | {# fun PyDict_MergeFromSeq2 as mergeFromSeq2 169 | `Object seq2' => 170 | { withObject* `Dictionary' 171 | , withObject* `seq2' 172 | , `Bool' 173 | } -> `()' checkStatusCode* #} 174 | -------------------------------------------------------------------------------- /lib/CPython/Types/Exception.chs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ForeignFunctionInterface #-} 2 | 3 | -- Copyright (C) 2009 John Millikin 4 | -- 5 | -- This program is free software: you can redistribute it and/or modify 6 | -- it under the terms of the GNU General Public License as published by 7 | -- the Free Software Foundation, either version 3 of the License, or 8 | -- any later version. 9 | -- 10 | -- This program is distributed in the hope that it will be useful, 11 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | -- GNU General Public License for more details. 14 | -- 15 | -- You should have received a copy of the GNU General Public License 16 | -- along with this program. If not, see . 17 | 18 | module CPython.Types.Exception 19 | ( Exception 20 | , exceptionType 21 | , exceptionValue 22 | , exceptionTraceback 23 | ) where 24 | 25 | import CPython.Internal 26 | -------------------------------------------------------------------------------- /lib/CPython/Types/Float.chs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ForeignFunctionInterface #-} 2 | 3 | -- Copyright (C) 2009 John Millikin 4 | -- 5 | -- This program is free software: you can redistribute it and/or modify 6 | -- it under the terms of the GNU General Public License as published by 7 | -- the Free Software Foundation, either version 3 of the License, or 8 | -- any later version. 9 | -- 10 | -- This program is distributed in the hope that it will be useful, 11 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | -- GNU General Public License for more details. 14 | -- 15 | -- You should have received a copy of the GNU General Public License 16 | -- along with this program. If not, see . 17 | 18 | module CPython.Types.Float 19 | ( Float 20 | , floatType 21 | , toFloat 22 | , fromFloat 23 | ) where 24 | 25 | #include 26 | 27 | import Prelude hiding (Float) 28 | 29 | import CPython.Internal 30 | 31 | newtype Float = Float (ForeignPtr Float) 32 | 33 | instance Object Float where 34 | toObject (Float x) = SomeObject x 35 | fromForeignPtr = Float 36 | 37 | instance Concrete Float where 38 | concreteType _ = floatType 39 | 40 | {# fun pure unsafe hscpython_PyFloat_Type as floatType 41 | {} -> `Type' peekStaticObject* #} 42 | 43 | {# fun PyFloat_FromDouble as toFloat 44 | { realToFrac `Double' 45 | } -> `Float' stealObject* #} 46 | 47 | {# fun PyFloat_AsDouble as fromFloat 48 | { withObject* `Float' 49 | } -> `Double' realToFrac #} 50 | -------------------------------------------------------------------------------- /lib/CPython/Types/Function.chs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ForeignFunctionInterface #-} 2 | 3 | -- Copyright (C) 2009 John Millikin 4 | -- 5 | -- This program is free software: you can redistribute it and/or modify 6 | -- it under the terms of the GNU General Public License as published by 7 | -- the Free Software Foundation, either version 3 of the License, or 8 | -- any later version. 9 | -- 10 | -- This program is distributed in the hope that it will be useful, 11 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | -- GNU General Public License for more details. 14 | -- 15 | -- You should have received a copy of the GNU General Public License 16 | -- along with this program. If not, see . 17 | 18 | module CPython.Types.Function 19 | ( Function 20 | , functionType 21 | , new 22 | , getCode 23 | , getGlobals 24 | , getModule 25 | , getDefaults 26 | , setDefaults 27 | , getClosure 28 | , setClosure 29 | , getAnnotations 30 | , setAnnotations 31 | ) where 32 | 33 | #include 34 | 35 | import qualified CPython.Constants as Const 36 | import CPython.Internal hiding (new) 37 | import CPython.Types.Code (Code) 38 | 39 | newtype Function = Function (ForeignPtr Function) 40 | 41 | instance Object Function where 42 | toObject (Function x) = SomeObject x 43 | fromForeignPtr = Function 44 | 45 | instance Concrete Function where 46 | concreteType _ = functionType 47 | 48 | {# fun pure unsafe hscpython_PyFunction_Type as functionType 49 | {} -> `Type' peekStaticObject* #} 50 | 51 | -- | Return a new function associated with the given code object. The second 52 | -- parameter will be used as the globals accessible to the function. 53 | -- 54 | -- The function's docstring, name, and @__module__@ are retrieved from the 55 | -- code object. The parameter defaults and closure are set to 'Nothing'. 56 | {# fun PyFunction_New as new 57 | { withObject* `Code' 58 | , withObject* `Dictionary' 59 | } -> `Function' stealObject* #} 60 | 61 | -- | Return the code object associated with a function. 62 | {# fun PyFunction_GetCode as getCode 63 | { withObject* `Function' 64 | } -> `Code' peekObject* #} 65 | 66 | -- | Return the globals dictionary associated with a function. 67 | {# fun PyFunction_GetGlobals as getGlobals 68 | { withObject* `Function' 69 | } -> `Dictionary' peekObject* #} 70 | 71 | -- | Return the @__module__@ attribute of a function. This is normally 72 | -- a 'Unicode' containing the module name, but can be set to any other 73 | -- object by Python code. 74 | {# fun PyFunction_GetModule as getModule 75 | { withObject* `Function' 76 | } -> `SomeObject' peekObject* #} 77 | 78 | withNullableObject :: Object obj => Maybe obj -> (Ptr a -> IO b) -> IO b 79 | withNullableObject Nothing io = do 80 | none <- Const.none 81 | withObject none io 82 | withNullableObject (Just obj) io = withObject obj io 83 | 84 | peekNullableObject :: Object obj => Ptr a -> IO (Maybe obj) 85 | peekNullableObject = maybePeek peekObject 86 | 87 | -- | Return the default parameter values for a function. This can be a tuple 88 | -- or 'Nothing'. 89 | {# fun PyFunction_GetDefaults as getDefaults 90 | { withObject* `Function' 91 | } -> `Maybe Tuple' peekNullableObject* #} 92 | 93 | -- | Set the default values for a function. 94 | {# fun PyFunction_SetDefaults as setDefaults 95 | { withObject* `Function' 96 | , withNullableObject* `Maybe Tuple' 97 | } -> `()' checkStatusCode* #} 98 | 99 | -- | Return the closure associated with a function. This can be 'Nothing', 100 | -- or a tuple of 'Cell's. 101 | {# fun PyFunction_GetClosure as getClosure 102 | { withObject* `Function' 103 | } -> `Maybe Tuple' peekNullableObject* #} 104 | 105 | -- | Set the closure associated with a function. The tuple should contain 106 | -- 'Cell's. 107 | {# fun PyFunction_SetClosure as setClosure 108 | { withObject* `Function' 109 | , withNullableObject* `Maybe Tuple' 110 | } -> `()' checkStatusCode* #} 111 | 112 | -- | Return the annotations for a function. This can be a mutable dictionary, 113 | -- or 'Nothing'. 114 | {# fun PyFunction_GetAnnotations as getAnnotations 115 | { withObject* `Function' 116 | } -> `Maybe Dictionary' peekNullableObject* #} 117 | 118 | -- | Set the annotations for a function object. 119 | {# fun PyFunction_SetAnnotations as setAnnotations 120 | { withObject* `Function' 121 | , withNullableObject* `Maybe Dictionary' 122 | } -> `()' checkStatusCode* #} 123 | -------------------------------------------------------------------------------- /lib/CPython/Types/InstanceMethod.chs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ForeignFunctionInterface #-} 2 | 3 | -- Copyright (C) 2009 John Millikin 4 | -- 5 | -- This program is free software: you can redistribute it and/or modify 6 | -- it under the terms of the GNU General Public License as published by 7 | -- the Free Software Foundation, either version 3 of the License, or 8 | -- any later version. 9 | -- 10 | -- This program is distributed in the hope that it will be useful, 11 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | -- GNU General Public License for more details. 14 | -- 15 | -- You should have received a copy of the GNU General Public License 16 | -- along with this program. If not, see . 17 | 18 | module CPython.Types.InstanceMethod 19 | ( InstanceMethod 20 | , instanceMethodType 21 | , new 22 | , function 23 | ) where 24 | 25 | #include 26 | 27 | import CPython.Internal hiding (new) 28 | 29 | newtype InstanceMethod = InstanceMethod (ForeignPtr InstanceMethod) 30 | 31 | instance Object InstanceMethod where 32 | toObject (InstanceMethod x) = SomeObject x 33 | fromForeignPtr = InstanceMethod 34 | 35 | instance Concrete InstanceMethod where 36 | concreteType _ = instanceMethodType 37 | 38 | {# fun pure unsafe hscpython_PyInstanceMethod_Type as instanceMethodType 39 | {} -> `Type' peekStaticObject* #} 40 | 41 | {# fun PyInstanceMethod_New as new 42 | `Object func' => 43 | { withObject* `func' 44 | } -> `InstanceMethod' stealObject* #} 45 | 46 | {# fun PyInstanceMethod_Function as function 47 | { withObject* `InstanceMethod' 48 | } -> `SomeObject' peekObject* #} 49 | -------------------------------------------------------------------------------- /lib/CPython/Types/Integer.chs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ForeignFunctionInterface #-} 2 | 3 | -- Copyright (C) 2009 John Millikin 4 | -- 5 | -- This program is free software: you can redistribute it and/or modify 6 | -- it under the terms of the GNU General Public License as published by 7 | -- the Free Software Foundation, either version 3 of the License, or 8 | -- any later version. 9 | -- 10 | -- This program is distributed in the hope that it will be useful, 11 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | -- GNU General Public License for more details. 14 | -- 15 | -- You should have received a copy of the GNU General Public License 16 | -- along with this program. If not, see . 17 | 18 | module CPython.Types.Integer 19 | ( Integer 20 | , integerType 21 | , toInteger 22 | , fromInteger 23 | ) where 24 | 25 | #include 26 | 27 | import Prelude hiding (Integer, toInteger, fromInteger) 28 | import qualified Prelude as Prelude 29 | import qualified Data.Text as T 30 | 31 | import CPython.Internal 32 | import qualified CPython.Protocols.Object as O 33 | import qualified CPython.Types.Unicode as U 34 | 35 | newtype Integer = Integer (ForeignPtr Integer) 36 | 37 | instance Object Integer where 38 | toObject (Integer x) = SomeObject x 39 | fromForeignPtr = Integer 40 | 41 | instance Concrete Integer where 42 | concreteType _ = integerType 43 | 44 | {# fun pure unsafe hscpython_PyLong_Type as integerType 45 | {} -> `Type' peekStaticObject* #} 46 | 47 | toInteger :: Prelude.Integer -> IO Integer 48 | toInteger int = do 49 | let longlong = fromIntegral int 50 | let [_, min', max'] = [longlong, minBound, maxBound] 51 | stealObject =<< if Prelude.toInteger min' < int && int < Prelude.toInteger max' 52 | then {# call PyLong_FromLongLong as ^ #} longlong 53 | else withCString (show int) $ \cstr -> 54 | {# call PyLong_FromString as ^ #} cstr nullPtr 10 55 | 56 | fromInteger :: Integer -> IO Prelude.Integer 57 | fromInteger py = do 58 | (long, overflow) <- (withObject py $ \pyPtr -> 59 | alloca $ \overflowPtr -> do 60 | poke overflowPtr 0 61 | long <- {# call PyLong_AsLongAndOverflow as ^ #} pyPtr overflowPtr 62 | overflow <- peek overflowPtr 63 | return (long, overflow)) 64 | if overflow == 0 65 | then return $ Prelude.toInteger long 66 | else fmap (read . T.unpack) $ U.fromUnicode =<< O.string py 67 | -------------------------------------------------------------------------------- /lib/CPython/Types/Iterator.chs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ForeignFunctionInterface #-} 2 | 3 | -- Copyright (C) 2009 John Millikin 4 | -- 5 | -- This program is free software: you can redistribute it and/or modify 6 | -- it under the terms of the GNU General Public License as published by 7 | -- the Free Software Foundation, either version 3 of the License, or 8 | -- any later version. 9 | -- 10 | -- This program is distributed in the hope that it will be useful, 11 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | -- GNU General Public License for more details. 14 | -- 15 | -- You should have received a copy of the GNU General Public License 16 | -- along with this program. If not, see . 17 | 18 | module CPython.Types.Iterator 19 | ( SequenceIterator 20 | , sequenceIteratorType 21 | , sequenceIteratorNew 22 | 23 | , CallableIterator 24 | , callableIteratorType 25 | , callableIteratorNew 26 | ) where 27 | 28 | #include 29 | 30 | import CPython.Internal 31 | 32 | newtype SequenceIterator = SequenceIterator (ForeignPtr SequenceIterator) 33 | 34 | instance Iterator SequenceIterator where 35 | toIterator = unsafeCastToIterator 36 | 37 | instance Object SequenceIterator where 38 | toObject (SequenceIterator x) = SomeObject x 39 | fromForeignPtr = SequenceIterator 40 | 41 | instance Concrete SequenceIterator where 42 | concreteType _ = sequenceIteratorType 43 | 44 | newtype CallableIterator = CallableIterator (ForeignPtr CallableIterator) 45 | 46 | instance Iterator CallableIterator where 47 | toIterator = unsafeCastToIterator 48 | 49 | instance Object CallableIterator where 50 | toObject (CallableIterator x) = SomeObject x 51 | fromForeignPtr = CallableIterator 52 | 53 | instance Concrete CallableIterator where 54 | concreteType _ = callableIteratorType 55 | 56 | {# fun pure unsafe hscpython_PySeqIter_Type as sequenceIteratorType 57 | {} -> `Type' peekStaticObject* #} 58 | 59 | {# fun pure unsafe hscpython_PyCallIter_Type as callableIteratorType 60 | {} -> `Type' peekStaticObject* #} 61 | 62 | -- | Return an 'Iterator' that works with a general sequence object, /seq/. 63 | -- The iteration ends when the sequence raises @IndexError@ for the 64 | -- subscripting operation. 65 | {# fun PySeqIter_New as sequenceIteratorNew 66 | `Sequence seq' => 67 | { withObject* `seq' 68 | } -> `SequenceIterator' stealObject* #} 69 | 70 | -- | Return a new 'Iterator'. The first parameter, /callable/, can be any 71 | -- Python callable object that can be called with no parameters; each call 72 | -- to it should return the next item in the iteration. When /callable/ 73 | -- returns a value equal to /sentinel/, the iteration will be terminated. 74 | {# fun PyCallIter_New as callableIteratorNew 75 | `(Object callable, Object sentinel)' => 76 | { withObject* `callable' 77 | , withObject* `sentinel' 78 | } -> `CallableIterator' stealObject* #} 79 | -------------------------------------------------------------------------------- /lib/CPython/Types/List.chs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ForeignFunctionInterface #-} 2 | 3 | -- Copyright (C) 2009 John Millikin 4 | -- 5 | -- This program is free software: you can redistribute it and/or modify 6 | -- it under the terms of the GNU General Public License as published by 7 | -- the Free Software Foundation, either version 3 of the License, or 8 | -- any later version. 9 | -- 10 | -- This program is distributed in the hope that it will be useful, 11 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | -- GNU General Public License for more details. 14 | -- 15 | -- You should have received a copy of the GNU General Public License 16 | -- along with this program. If not, see . 17 | 18 | module CPython.Types.List 19 | ( List 20 | , listType 21 | , toList 22 | , iterableToList 23 | , fromList 24 | , length 25 | , getItem 26 | , setItem 27 | , insert 28 | , append 29 | , getSlice 30 | , setSlice 31 | , sort 32 | , reverse 33 | , toTuple 34 | ) where 35 | 36 | #include 37 | 38 | import Prelude hiding (reverse, length) 39 | 40 | import CPython.Internal hiding (new) 41 | import qualified CPython.Types.Tuple as T 42 | 43 | instance Concrete List where 44 | concreteType _ = listType 45 | 46 | {# fun pure unsafe hscpython_PyList_Type as listType 47 | {} -> `Type' peekStaticObject* #} 48 | 49 | toList :: [SomeObject] -> IO List 50 | toList xs = 51 | mapWith withObject xs $ \ptrs -> 52 | withArrayLen ptrs $ \count array -> 53 | {# call hscpython_poke_list #} (fromIntegral count) array 54 | >>= stealObject 55 | 56 | -- | Convert any object implementing the iterator protocol to a 'List'. 57 | iterableToList :: Object iter => iter -> IO List 58 | iterableToList iter = do 59 | raw <- callObjectRaw listType =<< T.toTuple [toObject iter] 60 | return $ unsafeCast raw 61 | 62 | fromList :: List -> IO [SomeObject] 63 | fromList py = 64 | withObject py $ \pyPtr -> 65 | ({# call PyList_Size as ^ #} pyPtr >>=) $ \size -> 66 | let size' = fromIntegral size :: Int in 67 | withArray (replicate size' nullPtr) $ \ptrs -> 68 | {# call hscpython_peek_list #} pyPtr size ptrs >> 69 | peekArray size' ptrs >>= mapM peekObject 70 | 71 | {# fun PyList_Size as length 72 | { withObject* `List' 73 | } -> `Integer' checkIntReturn* #} 74 | 75 | -- | Returns the object at a given position in the list. The position must be 76 | -- positive; indexing from the end of the list is not supported. If the 77 | -- position is out of bounds, throws an @IndexError@ exception. 78 | {# fun PyList_GetItem as getItem 79 | { withObject* `List' 80 | , fromIntegral `Integer' 81 | } -> `SomeObject' peekObject* #} 82 | 83 | -- | Set the item at a given index. 84 | setItem :: Object o => List -> Integer -> o -> IO () 85 | setItem self index x = 86 | withObject self $ \selfPtr -> 87 | withObject x $ \xPtr -> do 88 | incref xPtr 89 | {# call PyList_SetItem as ^ #} selfPtr (fromIntegral index) xPtr 90 | >>= checkStatusCode 91 | 92 | -- | Inserts /item/ into the list in front of the given index. Throws an 93 | -- exception if unsuccessful. Analogous to @list.insert(index, item)@. 94 | {# fun PyList_Insert as insert 95 | `Object item' => 96 | { withObject* `List' 97 | , fromIntegral `Integer' 98 | , withObject* `item' 99 | } -> `()' checkStatusCode* #} 100 | 101 | -- | Append /item/ to the end of th list. Throws an exception if unsuccessful. 102 | -- Analogous to @list.append(item)@. 103 | {# fun PyList_Append as append 104 | `Object item' => 105 | { withObject* `List' 106 | , withObject* `item' 107 | } -> `()' checkStatusCode* #} 108 | 109 | -- | Return a list of the objects in list containing the objects between 110 | -- the given indexes. Throws an exception if unsuccessful. Analogous to 111 | -- @list[low:high]@. Negative indices, as when slicing from Python, are not 112 | -- supported. 113 | {# fun PyList_GetSlice as getSlice 114 | { withObject* `List' 115 | , fromIntegral `Integer' 116 | , fromIntegral `Integer' 117 | } -> `List' stealObject* #} 118 | 119 | -- | Sets the slice of a list between /low/ and /high/ to the contents of 120 | -- a replacement list. Analogous to @list[low:high] = replacement@. The 121 | -- replacement may be 'Nothing', indicating the assignment of an empty list 122 | -- (slice deletion). Negative indices, as when slicing from Python, are not 123 | -- supported. 124 | setSlice 125 | :: List 126 | -> Integer -- ^ Low 127 | -> Integer -- ^ High 128 | -> Maybe List -- ^ Replacement 129 | -> IO () 130 | setSlice self low high items = let 131 | low' = fromIntegral low 132 | high' = fromIntegral high in 133 | withObject self $ \selfPtr -> 134 | maybeWith withObject items $ \itemsPtr -> do 135 | {# call PyList_SetSlice as ^ #} selfPtr low' high' itemsPtr 136 | >>= checkStatusCode 137 | 138 | -- | Sort the items of a list in place. This is equivalent to @list.sort()@. 139 | {# fun PyList_Sort as sort 140 | { withObject* `List' 141 | } -> `()' checkStatusCode* #} 142 | 143 | -- | Reverses the items of a list in place. This is equivalent to 144 | -- @list.reverse()@. 145 | {# fun PyList_Reverse as reverse 146 | { withObject* `List' 147 | } -> `()' checkStatusCode* #} 148 | 149 | -- | Return a new 'Tuple' containing the contents of a list; equivalent to 150 | -- @tuple(list)@. 151 | {# fun PyList_AsTuple as toTuple 152 | { withObject* `List' 153 | } -> `Tuple' stealObject* #} 154 | -------------------------------------------------------------------------------- /lib/CPython/Types/Method.chs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ForeignFunctionInterface #-} 2 | 3 | -- Copyright (C) 2009 John Millikin 4 | -- 5 | -- This program is free software: you can redistribute it and/or modify 6 | -- it under the terms of the GNU General Public License as published by 7 | -- the Free Software Foundation, either version 3 of the License, or 8 | -- any later version. 9 | -- 10 | -- This program is distributed in the hope that it will be useful, 11 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | -- GNU General Public License for more details. 14 | -- 15 | -- You should have received a copy of the GNU General Public License 16 | -- along with this program. If not, see . 17 | -- 18 | 19 | module CPython.Types.Method 20 | ( Method 21 | , methodType 22 | , new 23 | , function 24 | , self 25 | ) where 26 | 27 | #include 28 | 29 | import CPython.Internal hiding (new) 30 | 31 | newtype Method = Method (ForeignPtr Method) 32 | 33 | instance Object Method where 34 | toObject (Method x) = SomeObject x 35 | fromForeignPtr = Method 36 | 37 | instance Concrete Method where 38 | concreteType _ = methodType 39 | 40 | {# fun pure unsafe hscpython_PyMethod_Type as methodType 41 | {} -> `Type' peekStaticObject* #} 42 | 43 | {# fun PyMethod_New as new 44 | `(Object func, Object self)' => 45 | { withObject* `func' 46 | , withObject* `self' 47 | } -> `Method' stealObject* #} 48 | 49 | {# fun PyMethod_Function as function 50 | { withObject* `Method' 51 | } -> `SomeObject' peekObject* #} 52 | 53 | {# fun PyMethod_Self as self 54 | { withObject* `Method' 55 | } -> `SomeObject' peekObject* #} 56 | -------------------------------------------------------------------------------- /lib/CPython/Types/Module.chs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ForeignFunctionInterface #-} 2 | 3 | -- Copyright (C) 2009 John Millikin 4 | -- 5 | -- This program is free software: you can redistribute it and/or modify 6 | -- it under the terms of the GNU General Public License as published by 7 | -- the Free Software Foundation, either version 3 of the License, or 8 | -- any later version. 9 | -- 10 | -- This program is distributed in the hope that it will be useful, 11 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | -- GNU General Public License for more details. 14 | -- 15 | -- You should have received a copy of the GNU General Public License 16 | -- along with this program. If not, see . 17 | -- 18 | 19 | module CPython.Types.Module 20 | ( Module 21 | , moduleType 22 | , new 23 | , getDictionary 24 | , getName 25 | , getFilename 26 | , addObject 27 | , addIntegerConstant 28 | , addTextConstant 29 | , importModule 30 | , reload 31 | ) where 32 | 33 | #include 34 | 35 | import Prelude hiding (toInteger) 36 | import Data.Text (Text) 37 | 38 | import CPython.Internal hiding (new) 39 | import CPython.Types.Integer (toInteger) 40 | import CPython.Types.Unicode (toUnicode) 41 | 42 | newtype Module = Module (ForeignPtr Module) 43 | 44 | instance Object Module where 45 | toObject (Module x) = SomeObject x 46 | fromForeignPtr = Module 47 | 48 | instance Concrete Module where 49 | concreteType _ = moduleType 50 | 51 | {# fun pure unsafe hscpython_PyModule_Type as moduleType 52 | {} -> `Type' peekStaticObject* #} 53 | 54 | -- | Return a new module object with the @__name__@ attribute set. Only the 55 | -- module’s @__doc__@ and @__name__@ attributes are filled in; the 56 | -- caller is responsible for providing a @__file__@ attribute. 57 | {# fun PyModule_New as new 58 | { withText* `Text' 59 | } -> `Module' stealObject* #} 60 | 61 | -- | Return the dictionary object that implements a module’s namespace; 62 | -- this object is the same as the @__dict__@ attribute of the module. This 63 | -- computation never fails. It is recommended extensions use other 64 | -- computations rather than directly manipulate a module’s @__dict__@. 65 | {# fun PyModule_GetDict as getDictionary 66 | { withObject* `Module' 67 | } -> `Dictionary' peekObject* #} 68 | 69 | -- | Returns a module’s @__name__@ value. If the module does not 70 | -- provide one, or if it is not a string, throws @SystemError@. 71 | getName :: Module -> IO Text 72 | getName py = 73 | withObject py $ \py' -> do 74 | raw <- {# call PyModule_GetName as ^ #} py' 75 | exceptionIf $ raw == nullPtr 76 | peekText raw 77 | 78 | -- | Returns the name of the file from which a module was loaded using the 79 | -- module’s @__file__@ attribute. If this is not defined, or if it is 80 | -- not a string, throws @SystemError@. 81 | getFilename :: Module -> IO Text 82 | getFilename py = 83 | withObject py $ \py' -> do 84 | raw <- {# call PyModule_GetFilename as ^ #} py' 85 | exceptionIf $ raw == nullPtr 86 | peekText raw 87 | 88 | -- | Add an object to a module with the given name. This is a convenience 89 | -- computation which can be used from the module’s initialization 90 | -- computation. 91 | addObject :: Object value => Module -> Text -> value -> IO () 92 | addObject py name val = 93 | withObject py $ \py' -> 94 | withText name $ \name' -> 95 | withObject val $ \val' -> 96 | incref val' >> 97 | {# call PyModule_AddObject as ^ #} py' name' val' 98 | >>= checkStatusCode 99 | 100 | -- | Add an integer constant to a module. This convenience computation can be 101 | -- used from the module’s initialization computation. 102 | addIntegerConstant :: Module -> Text -> Integer -> IO () 103 | addIntegerConstant m name value = toInteger value >>= addObject m name 104 | 105 | -- | Add a string constant to a module. This convenience computation can be 106 | -- used from the module’s initialization computation. 107 | addTextConstant :: Module -> Text -> Text -> IO () 108 | addTextConstant m name value = toUnicode value >>= addObject m name 109 | 110 | -- | This is a higher-level interface that calls the current “import 111 | -- hook” (with an explicit level of @0@, meaning absolute import). It 112 | -- invokes the @__import__()@ computation from the @__builtins__@ of the 113 | -- current globals. This means that the import is done using whatever import 114 | -- hooks are installed in the current environment. 115 | -- 116 | -- This computation always uses absolute imports. 117 | importModule :: Text -> IO Module 118 | importModule name = do 119 | pyName <- toUnicode name 120 | withObject pyName $ \namePtr -> 121 | {# call PyImport_Import as ^ #} namePtr 122 | >>= stealObject 123 | 124 | -- | Reload a module. If an error occurs, an exception is thrown and the old 125 | -- module still exists. 126 | {# fun PyImport_ReloadModule as reload 127 | { withObject* `Module' 128 | } -> `Module' stealObject* #} 129 | -------------------------------------------------------------------------------- /lib/CPython/Types/Set.chs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ForeignFunctionInterface #-} 2 | 3 | -- Copyright (C) 2009 John Millikin 4 | -- 5 | -- This program is free software: you can redistribute it and/or modify 6 | -- it under the terms of the GNU General Public License as published by 7 | -- the Free Software Foundation, either version 3 of the License, or 8 | -- any later version. 9 | -- 10 | -- This program is distributed in the hope that it will be useful, 11 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | -- GNU General Public License for more details. 14 | -- 15 | -- You should have received a copy of the GNU General Public License 16 | -- along with this program. If not, see . 17 | 18 | -- | Any functionality not listed below is best accessed using the either 19 | -- the 'Object' protocol (including 'callMethod', 'richCompare', 'hash', 20 | -- 'repr', 'isTrue', and 'getIter') or the 'Number' protocol (including 'and', 21 | -- 'subtract', 'or', 'xor', 'inPlaceAnd', 'inPlaceSubtract', 'inPlaceOr', 22 | -- and 'inPlaceXor'). 23 | module CPython.Types.Set 24 | ( AnySet 25 | , Set 26 | , FrozenSet 27 | , setType 28 | , frozenSetType 29 | , toSet 30 | , toFrozenSet 31 | , iterableToSet 32 | , iterableToFrozenSet 33 | , fromSet 34 | , size 35 | , contains 36 | , add 37 | , discard 38 | , pop 39 | , clear 40 | ) where 41 | 42 | #include 43 | 44 | import CPython.Internal 45 | import CPython.Types.Tuple (toTuple, iterableToTuple, fromTuple) 46 | 47 | class Object a => AnySet a 48 | 49 | newtype Set = Set (ForeignPtr Set) 50 | 51 | instance Object Set where 52 | toObject (Set x) = SomeObject x 53 | fromForeignPtr = Set 54 | 55 | instance Concrete Set where 56 | concreteType _ = setType 57 | 58 | newtype FrozenSet = FrozenSet (ForeignPtr FrozenSet) 59 | 60 | instance Object FrozenSet where 61 | toObject (FrozenSet x) = SomeObject x 62 | fromForeignPtr = FrozenSet 63 | 64 | instance Concrete FrozenSet where 65 | concreteType _ = frozenSetType 66 | 67 | instance AnySet Set 68 | instance AnySet FrozenSet 69 | 70 | {# fun pure unsafe hscpython_PySet_Type as setType 71 | {} -> `Type' peekStaticObject* #} 72 | 73 | {# fun pure unsafe hscpython_PyFrozenSet_Type as frozenSetType 74 | {} -> `Type' peekStaticObject* #} 75 | 76 | toSet :: [SomeObject] -> IO Set 77 | toSet xs = toTuple xs >>= iterableToSet 78 | 79 | toFrozenSet :: [SomeObject] -> IO FrozenSet 80 | toFrozenSet xs = toTuple xs >>= iterableToFrozenSet 81 | 82 | -- | Return a new 'Set' from the contents of an iterable 'Object'. The object 83 | -- may be 'Nothing' to create an empty set. Throws a @TypeError@ if the object 84 | -- is not iterable. 85 | {# fun PySet_New as iterableToSet 86 | `Object obj' => 87 | { withObject* `obj' 88 | } -> `Set' stealObject* #} 89 | 90 | -- | Return a new 'FrozenSet' from the contents of an iterable 'Object'. The 91 | -- object may be 'Nothing' to create an empty frozen set. Throws a @TypeError@ 92 | -- if the object is not iterable. 93 | {# fun PyFrozenSet_New as iterableToFrozenSet 94 | `Object obj' => 95 | { withObject* `obj' 96 | } -> `FrozenSet' stealObject* #} 97 | 98 | fromSet :: AnySet set => set -> IO [SomeObject] 99 | fromSet set = iterableToTuple set >>= fromTuple 100 | 101 | -- | Return the size of a 'Set' or 'FrozenSet'. 102 | {# fun PySet_Size as size 103 | `AnySet set' => 104 | { withObject* `set' 105 | } -> `Integer' checkIntReturn* #} 106 | 107 | -- | Return 'True' if found, 'False' if not found. Unlike the Python 108 | -- @__contains__()@ method, this computation does not automatically convert 109 | -- unhashable 'Set's into temporary 'FrozenSet's. Throws a @TypeError@ if the 110 | -- key is unhashable. 111 | {# fun PySet_Contains as contains 112 | `(AnySet set, Object key)' => 113 | { withObject* `set' 114 | , withObject* `key' 115 | } -> `Bool' checkBoolReturn* #} 116 | 117 | -- | Add /key/ to a 'Set'. Also works with 'FrozenSet' (like 118 | -- 'CPython.Types.Tuple.setItem' it can be used to fill-in the values of 119 | -- brand new 'FrozenSet's before they are exposed to other code). Throws a 120 | -- @TypeError@ if the key is unhashable. Throws a @MemoryError@ if there is 121 | -- no room to grow. 122 | add :: (AnySet set, Object key) => set -> key -> IO () 123 | add = c_add 124 | 125 | -- c2hs won't accept functions named "add" any more, so have it generate 126 | -- c_add and then wrap that manually. 127 | {# fun PySet_Add as c_add 128 | `(AnySet set, Object key)' => 129 | { withObject* `set' 130 | , withObject* `key' 131 | } -> `()' checkStatusCode* #} 132 | 133 | -- | Return 'True' if found and removed, 'False' if not found (no action 134 | -- taken). Does not throw @KeyError@ for missing keys. Throws a @TypeError@ 135 | -- if /key/ is unhashable. Unlike the Python @discard()@ method, this 136 | -- computation does not automatically convert unhashable sets into temporary 137 | -- 'FrozenSet's. 138 | {# fun PySet_Discard as discard 139 | `Object key' => 140 | { withObject* `Set' 141 | , withObject* `key' 142 | } -> `Bool' checkBoolReturn* #} 143 | 144 | -- | Return an arbitrary object in the set, and removes the object from the 145 | -- set. Throws @KeyError@ if the set is empty. 146 | {# fun PySet_Pop as pop 147 | { withObject* `Set' 148 | } -> `SomeObject' stealObject* #} 149 | 150 | -- | Remove all elements from a set. 151 | {# fun PySet_Clear as clear 152 | { withObject* `Set' 153 | } -> `()' checkStatusCode* #} 154 | -------------------------------------------------------------------------------- /lib/CPython/Types/Slice.chs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ForeignFunctionInterface #-} 2 | 3 | -- Copyright (C) 2009 John Millikin 4 | -- 5 | -- This program is free software: you can redistribute it and/or modify 6 | -- it under the terms of the GNU General Public License as published by 7 | -- the Free Software Foundation, either version 3 of the License, or 8 | -- any later version. 9 | -- 10 | -- This program is distributed in the hope that it will be useful, 11 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | -- GNU General Public License for more details. 14 | -- 15 | -- You should have received a copy of the GNU General Public License 16 | -- along with this program. If not, see . 17 | 18 | module CPython.Types.Slice 19 | ( Slice 20 | , sliceType 21 | , new 22 | , getIndices 23 | ) where 24 | 25 | #include 26 | 27 | import Prelude hiding (length) 28 | 29 | import CPython.Internal hiding (new) 30 | 31 | newtype Slice = Slice (ForeignPtr Slice) 32 | 33 | instance Object Slice where 34 | toObject (Slice x) = SomeObject x 35 | fromForeignPtr = Slice 36 | 37 | instance Concrete Slice where 38 | concreteType _ = sliceType 39 | 40 | {# fun pure unsafe hscpython_PySlice_Type as sliceType 41 | {} -> `Type' peekStaticObject* #} 42 | 43 | -- | Return a new slice object with the given values. The /start/, /stop/, 44 | -- and /step/ parameters are used as the values of the slice object 45 | -- attributes of the same names. Any of the values may be 'Nothing', in which 46 | -- case @None@ will be used for the corresponding attribute. 47 | new :: (Object start, Object stop, Object step) => Maybe start -> Maybe stop -> Maybe step -> IO Slice 48 | new start stop step = 49 | maybeWith withObject start $ \startPtr -> 50 | maybeWith withObject stop $ \stopPtr -> 51 | maybeWith withObject step $ \stepPtr -> 52 | {# call PySlice_New as ^ #} startPtr stopPtr stepPtr 53 | >>= stealObject 54 | 55 | -- | Retrieve the start, stop, step, and slice length from a 'Slice', 56 | -- assuming a sequence of the given length. 57 | getIndices :: Slice 58 | -> Integer -- ^ Sequence length 59 | -> IO (Integer, Integer, Integer, Integer) 60 | getIndices slice length = 61 | withObject slice $ \slicePtr -> 62 | let length' = fromIntegral length in 63 | alloca $ \startPtr -> 64 | alloca $ \stopPtr -> 65 | alloca $ \stepPtr -> 66 | alloca $ \sliceLenPtr -> do 67 | {# call PySlice_GetIndicesEx as ^ #} 68 | slicePtr length' startPtr stopPtr stepPtr sliceLenPtr 69 | >>= checkStatusCode 70 | start <- fmap toInteger $ peek startPtr 71 | stop <- fmap toInteger $ peek stopPtr 72 | step <- fmap toInteger $ peek stepPtr 73 | sliceLen <- fmap toInteger $ peek sliceLenPtr 74 | return (start, stop, step, sliceLen) 75 | -------------------------------------------------------------------------------- /lib/CPython/Types/Tuple.chs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ForeignFunctionInterface #-} 2 | 3 | -- Copyright (C) 2009 John Millikin 4 | -- 5 | -- This program is free software: you can redistribute it and/or modify 6 | -- it under the terms of the GNU General Public License as published by 7 | -- the Free Software Foundation, either version 3 of the License, or 8 | -- any later version. 9 | -- 10 | -- This program is distributed in the hope that it will be useful, 11 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | -- GNU General Public License for more details. 14 | -- 15 | -- You should have received a copy of the GNU General Public License 16 | -- along with this program. If not, see . 17 | 18 | module CPython.Types.Tuple 19 | ( Tuple 20 | , tupleType 21 | , toTuple 22 | , iterableToTuple 23 | , fromTuple 24 | , length 25 | , getItem 26 | , getSlice 27 | , setItem 28 | ) where 29 | 30 | #include 31 | 32 | import Prelude hiding (length) 33 | 34 | import CPython.Internal hiding (new) 35 | 36 | instance Concrete Tuple where 37 | concreteType _ = tupleType 38 | 39 | {# fun pure unsafe hscpython_PyTuple_Type as tupleType 40 | {} -> `Type' peekStaticObject* #} 41 | 42 | toTuple :: [SomeObject] -> IO Tuple 43 | toTuple xs = 44 | mapWith withObject xs $ \ptrs -> 45 | withArrayLen ptrs $ \count array -> 46 | {# call hscpython_poke_tuple #} (fromIntegral count) array 47 | >>= stealObject 48 | 49 | -- | Convert any object implementing the iterator protocol to a 'Tuple'. 50 | iterableToTuple :: Object iter => iter -> IO Tuple 51 | iterableToTuple iter = do 52 | raw <- callObjectRaw tupleType =<< toTuple [toObject iter] 53 | return $ unsafeCast raw 54 | 55 | fromTuple :: Tuple -> IO [SomeObject] 56 | fromTuple py = 57 | withObject py $ \pyPtr -> 58 | ({# call PyTuple_Size as ^ #} pyPtr >>=) $ \size -> 59 | let size' = fromIntegral size :: Int in 60 | withArray (replicate size' nullPtr) $ \ptrs -> 61 | {# call hscpython_peek_tuple #} pyPtr size ptrs >> 62 | peekArray size' ptrs >>= mapM peekObject 63 | 64 | {# fun PyTuple_Size as length 65 | { withObject* `Tuple' 66 | } -> `Integer' checkIntReturn* #} 67 | 68 | -- | Return the object at a given index from a tuple, or throws @IndexError@ 69 | -- if the index is out of bounds. 70 | {# fun PyTuple_GetItem as getItem 71 | { withObject* `Tuple' 72 | , fromIntegral `Integer' 73 | } -> `SomeObject' peekObject* #} 74 | 75 | -- | Take a slice of a tuple from /low/ to /high/, and return it as a new 76 | -- tuple. 77 | {# fun PyTuple_GetSlice as getSlice 78 | { withObject* `Tuple' 79 | , fromIntegral `Integer' 80 | , fromIntegral `Integer' 81 | } -> `Tuple' stealObject* #} 82 | 83 | setItem :: Object o => Tuple -> Integer -> o -> IO () 84 | setItem self index x = 85 | withObject self $ \selfPtr -> 86 | withObject x $ \xPtr -> do 87 | incref xPtr 88 | {# call PyTuple_SetItem as ^ #} selfPtr (fromIntegral index) xPtr 89 | >>= checkStatusCode 90 | -------------------------------------------------------------------------------- /lib/CPython/Types/Type.chs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ForeignFunctionInterface #-} 2 | 3 | -- Copyright (C) 2009 John Millikin 4 | -- 5 | -- This program is free software: you can redistribute it and/or modify 6 | -- it under the terms of the GNU General Public License as published by 7 | -- the Free Software Foundation, either version 3 of the License, or 8 | -- any later version. 9 | -- 10 | -- This program is distributed in the hope that it will be useful, 11 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | -- GNU General Public License for more details. 14 | -- 15 | -- You should have received a copy of the GNU General Public License 16 | -- along with this program. If not, see . 17 | 18 | module CPython.Types.Type 19 | ( Type 20 | , typeType 21 | , isSubtype 22 | ) where 23 | 24 | #include 25 | 26 | import CPython.Internal 27 | 28 | instance Concrete Type where 29 | concreteType _ = typeType 30 | 31 | {# fun pure unsafe hscpython_PyType_Type as typeType 32 | {} -> `Type' peekStaticObject* #} 33 | 34 | -- | Returns 'True' if the first parameter is a subtype of the second 35 | -- parameter. 36 | {# fun PyType_IsSubtype as isSubtype 37 | { withObject* `Type' 38 | , withObject* `Type' 39 | } -> `Bool' #} 40 | -------------------------------------------------------------------------------- /lib/CPython/Types/Unicode.chs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ForeignFunctionInterface #-} 2 | 3 | -- Copyright (C) 2009 John Millikin 4 | -- 5 | -- This program is free software: you can redistribute it and/or modify 6 | -- it under the terms of the GNU General Public License as published by 7 | -- the Free Software Foundation, either version 3 of the License, or 8 | -- any later version. 9 | -- 10 | -- This program is distributed in the hope that it will be useful, 11 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | -- GNU General Public License for more details. 14 | -- 15 | -- You should have received a copy of the GNU General Public License 16 | -- along with this program. If not, see . 17 | 18 | module CPython.Types.Unicode 19 | ( 20 | -- * Unicode objects 21 | Unicode 22 | , Encoding 23 | , ErrorHandling (..) 24 | , unicodeType 25 | , toUnicode 26 | , fromUnicode 27 | , length 28 | , fromEncodedObject 29 | , fromObject 30 | , encode 31 | , decode 32 | 33 | -- * Methods and slot functions 34 | , append 35 | , split 36 | , splitLines 37 | , translate 38 | , join 39 | , MatchDirection (..) 40 | , tailMatch 41 | , FindDirection (..) 42 | , find 43 | , count 44 | , replace 45 | , format 46 | , contains 47 | ) where 48 | 49 | #include 50 | 51 | import Prelude hiding (length) 52 | import Control.Exception (ErrorCall (..), throwIO) 53 | import qualified Data.Text as T 54 | import Foreign.C.String 55 | import Foreign.C.Types 56 | import CPython.Internal 57 | import CPython.Types.Bytes (Bytes) 58 | 59 | newtype Unicode = Unicode (ForeignPtr Unicode) 60 | 61 | instance Object Unicode where 62 | toObject (Unicode x) = SomeObject x 63 | fromForeignPtr = Unicode 64 | 65 | instance Concrete Unicode where 66 | concreteType _ = unicodeType 67 | 68 | type Encoding = T.Text 69 | data ErrorHandling 70 | = Strict 71 | | Replace 72 | | Ignore 73 | deriving (Show, Eq) 74 | 75 | withErrors :: ErrorHandling -> (CString -> IO a) -> IO a 76 | withErrors errors = withCString $ case errors of 77 | Strict -> "strict" 78 | Replace -> "replace" 79 | Ignore -> "ignore" 80 | 81 | {# fun pure unsafe hscpython_PyUnicode_Type as unicodeType 82 | {} -> `Type' peekStaticObject* #} 83 | 84 | 85 | toUnicode :: T.Text -> IO Unicode 86 | toUnicode txt = withCWStringLen (T.unpack txt) $ \(wstr, sz) -> do 87 | obj <- {# call hscpython_PyUnicode_FromUnicode #} (castPtr wstr) (fromIntegral sz) 88 | stealObject obj 89 | 90 | 91 | fromUnicode :: Unicode -> IO T.Text 92 | fromUnicode obj = withObject obj $ \ptr -> do 93 | wstrPtr <- {# call hscpython_PyUnicode_AsUnicode #} ptr 94 | wstr <- peekCWString . castPtr $ wstrPtr 95 | return . T.pack $ wstr 96 | 97 | {# fun hscpython_PyUnicode_GetSize as length 98 | { withObject* `Unicode' 99 | } -> `Integer' checkIntReturn* #} 100 | 101 | 102 | -- | Coerce an encoded object /obj/ to an Unicode object. 103 | -- 104 | -- 'Bytes' and other char buffer compatible objects are decoded according to 105 | -- the given encoding and error handling mode. 106 | -- 107 | -- All other objects, including 'Unicode' objects, cause a @TypeError@ to be 108 | -- thrown. 109 | {# fun hscpython_PyUnicode_FromEncodedObject as fromEncodedObject 110 | `Object obj' => 111 | { withObject* `obj' 112 | , withText* `Encoding' 113 | , withErrors* `ErrorHandling' 114 | } -> `Unicode' stealObject* #} 115 | 116 | -- | Shortcut for @'fromEncodedObject' \"utf-8\" 'Strict'@ 117 | fromObject :: Object obj => obj -> IO Unicode 118 | fromObject obj = fromEncodedObject obj (T.pack "utf-8") Strict 119 | 120 | -- | Encode a 'Unicode' object and return the result as 'Bytes' object. 121 | -- The encoding and error mode have the same meaning as the parameters of 122 | -- the the @str.encode()@ method. The codec to be used is looked up using 123 | -- the Python codec registry. 124 | {# fun hscpython_PyUnicode_AsEncodedString as encode 125 | { withObject* `Unicode' 126 | , withText* `Encoding' 127 | , withErrors* `ErrorHandling' 128 | } -> `Bytes' stealObject* #} 129 | 130 | -- | Create a 'Unicode' object by decoding a 'Bytes' object. The encoding and 131 | -- error mode have the same meaning as the parameters of the the 132 | -- @str.encode()@ method. The codec to be used is looked up using the Python 133 | -- codec registry. 134 | decode :: Bytes -> Encoding -> ErrorHandling -> IO Unicode 135 | decode bytes enc errors = 136 | withObject bytes $ \bytesPtr -> 137 | withText enc $ \encPtr -> 138 | withErrors errors $ \errorsPtr -> 139 | alloca $ \bufferPtr -> 140 | alloca $ \lenPtr -> do 141 | {# call PyBytes_AsStringAndSize as ^ #} bytesPtr bufferPtr lenPtr 142 | >>= checkStatusCode 143 | buffer <- peek bufferPtr 144 | len <- peek lenPtr 145 | {# call hscpython_PyUnicode_Decode #} buffer len encPtr errorsPtr 146 | >>= stealObject 147 | 148 | {# fun hscpython_PyUnicode_Concat as append 149 | { withObject* `Unicode' 150 | , withObject* `Unicode' 151 | } -> `Unicode' stealObject* #} 152 | 153 | -- | Split a string giving a 'List' of 'Unicode' objects. If the separator is 154 | -- 'Nothing', splitting will be done at all whitespace substrings. Otherwise, 155 | -- splits occur at the given separator. Separators are not included in the 156 | -- resulting list. 157 | split 158 | :: Unicode 159 | -> Maybe Unicode -- ^ Separator 160 | -> Maybe Integer -- ^ Maximum splits 161 | -> IO List 162 | split s sep maxsplit = 163 | withObject s $ \sPtr -> 164 | maybeWith withObject sep $ \sepPtr -> 165 | let max' = maybe (- 1) fromInteger maxsplit in 166 | {# call hscpython_PyUnicode_Split #} sPtr sepPtr max' 167 | >>= stealObject 168 | 169 | -- | Split a 'Unicode' string at line breaks, returning a list of 'Unicode' 170 | -- strings. CRLF is considered to be one line break. If the second parameter 171 | -- is 'False', the line break characters are not included in the resulting 172 | -- strings. 173 | {# fun hscpython_PyUnicode_Splitlines as splitLines 174 | { withObject* `Unicode' 175 | , `Bool' 176 | } -> `List' stealObject* #} 177 | 178 | -- | Translate a string by applying a character mapping table to it. 179 | -- 180 | -- The mapping table must map Unicode ordinal integers to Unicode ordinal 181 | -- integers or @None@ (causing deletion of the character). 182 | -- 183 | -- Mapping tables need only provide the @__getitem__()@ interface; 184 | -- dictionaries and sequences work well. Unmapped character ordinals (ones 185 | -- which cause a @LookupError@) are left untouched and are copied as-is. 186 | -- 187 | -- The error mode has the usual meaning for codecs. 188 | {# fun hscpython_PyUnicode_Translate as translate 189 | `Object table' => 190 | { withObject* `Unicode' 191 | , withObject* `table' 192 | , withErrors* `ErrorHandling' 193 | } -> `Unicode' stealObject* #} 194 | 195 | -- | Join a sequence of strings using the given separator. 196 | {# fun hscpython_PyUnicode_Join as join 197 | `Sequence seq' => 198 | { withObject* `Unicode' 199 | , withObject* `seq' 200 | } -> `Unicode' stealObject* #} 201 | 202 | data MatchDirection = Prefix | Suffix 203 | deriving (Show, Eq) 204 | 205 | -- | Return 'True' if the substring matches @string*[*start:end]@ at the 206 | -- given tail end (either a 'Prefix' or 'Suffix' match), 'False' otherwise. 207 | tailMatch 208 | :: Unicode -- ^ String 209 | -> Unicode -- ^ Substring 210 | -> Integer -- ^ Start 211 | -> Integer -- ^ End 212 | -> MatchDirection 213 | -> IO Bool 214 | tailMatch str substr start end dir = 215 | withObject str $ \strPtr -> 216 | withObject substr $ \substrPtr -> 217 | let start' = fromInteger start 218 | end' = fromInteger end 219 | dir' = case dir of Prefix -> -1 220 | Suffix -> 1 221 | in {# call hscpython_PyUnicode_Tailmatch #} strPtr substrPtr start' end' dir' 222 | >>= checkBoolReturn 223 | 224 | data FindDirection = Forwards | Backwards 225 | deriving (Show, Eq) 226 | 227 | -- | Return the first position of the substring in @string*[*start:end]@ 228 | -- using the given direction. The return value is the index of the first 229 | -- match; a value of 'Nothing' indicates that no match was found. 230 | find 231 | :: Unicode -- ^ String 232 | -> Unicode -- ^ Substring 233 | -> Integer -- ^ Start 234 | -> Integer -- ^ End 235 | -> FindDirection 236 | -> IO (Maybe Integer) 237 | find str substr start end dir = 238 | withObject str $ \strPtr -> 239 | withObject substr $ \substrPtr -> 240 | let start' = fromInteger start 241 | end' = fromInteger end 242 | dir' = case dir of Forwards -> 1 243 | Backwards -> -1 244 | in do 245 | cRes <- {# call hscpython_PyUnicode_Find #} strPtr substrPtr start' end' dir' 246 | exceptionIf $ cRes == -2 247 | case cRes of 248 | -1 -> return Nothing 249 | x | x >= 0 -> return . Just . toInteger $ x 250 | x -> throwIO . ErrorCall $ "Invalid return code: " ++ show x 251 | 252 | -- | Return the number of non-overlapping occurrences of the substring in 253 | -- @string[start:end]@. 254 | count 255 | :: Unicode -- ^ String 256 | -> Unicode -- ^ Substring 257 | -> Integer -- ^ Start 258 | -> Integer -- ^ End 259 | -> IO Integer 260 | count str substr start end = 261 | withObject str $ \str' -> 262 | withObject substr $ \substr' -> 263 | let start' = fromInteger start in 264 | let end' = fromInteger end in 265 | {# call hscpython_PyUnicode_Count #} str' substr' start' end' 266 | >>= checkIntReturn 267 | 268 | -- | Replace occurrences of the substring with a given replacement. If the 269 | -- maximum count is 'Nothing', replace all occurences. 270 | replace 271 | :: Unicode -- ^ String 272 | -> Unicode -- ^ Substring 273 | -> Unicode -- ^ Replacement 274 | -> Maybe Integer -- ^ Maximum count 275 | -> IO Unicode 276 | replace str substr replstr maxcount = 277 | withObject str $ \strPtr -> 278 | withObject substr $ \substrPtr -> 279 | withObject replstr $ \replstrPtr -> 280 | let maxcount' = case maxcount of Nothing -> -1 281 | Just x -> fromInteger x 282 | in {# call hscpython_PyUnicode_Replace #} strPtr substrPtr replstrPtr maxcount' 283 | >>= stealObject 284 | 285 | -- | Return a new 'Unicode' object from the given format and args; this is 286 | -- analogous to @format % args@. 287 | {# fun hscpython_PyUnicode_Format as format 288 | { withObject* `Unicode' 289 | , withObject* `Tuple' 290 | } -> `Unicode' stealObject* #} 291 | 292 | -- | Check whether /element/ is contained in a string. 293 | -- 294 | -- /element/ has to coerce to a one element string. 295 | {# fun hscpython_PyUnicode_Contains as contains 296 | `Object element' => 297 | { withObject* `Unicode' 298 | , withObject* `element' 299 | } -> `Bool' checkBoolReturn* #} 300 | -------------------------------------------------------------------------------- /lib/CPython/Types/WeakReference.chs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ForeignFunctionInterface #-} 2 | 3 | -- Copyright (C) 2009 John Millikin 4 | -- 5 | -- This program is free software: you can redistribute it and/or modify 6 | -- it under the terms of the GNU General Public License as published by 7 | -- the Free Software Foundation, either version 3 of the License, or 8 | -- any later version. 9 | -- 10 | -- This program is distributed in the hope that it will be useful, 11 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | -- GNU General Public License for more details. 14 | -- 15 | -- You should have received a copy of the GNU General Public License 16 | -- along with this program. If not, see . 17 | 18 | module CPython.Types.WeakReference 19 | ( Reference 20 | , Proxy 21 | , newReference 22 | , newProxy 23 | , getObject 24 | ) where 25 | 26 | #include 27 | 28 | import CPython.Internal 29 | 30 | newtype Reference = Reference (ForeignPtr Reference) 31 | instance Object Reference where 32 | toObject (Reference x) = SomeObject x 33 | fromForeignPtr = Reference 34 | 35 | newtype Proxy = Proxy (ForeignPtr Proxy) 36 | instance Object Proxy where 37 | toObject (Proxy x) = SomeObject x 38 | fromForeignPtr = Proxy 39 | 40 | -- | Return a weak reference for the object. This will always return a new 41 | -- reference, but is not guaranteed to create a new object; an existing 42 | -- reference object may be returned. The second parameter, /callback/, can 43 | -- be a callable object that receives notification when /obj/ is garbage 44 | -- collected; it should accept a single parameter, which will be the weak 45 | -- reference object itself. If ob is not a weakly-referencable object, or if 46 | -- /callback/ is not callable, this will throw a @TypeError@. 47 | newReference :: (Object obj, Object callback) => obj -> Maybe callback -> IO Reference 48 | newReference obj cb = 49 | withObject obj $ \objPtr -> 50 | maybeWith withObject cb $ \cbPtr -> 51 | {# call PyWeakref_NewRef as ^ #} objPtr cbPtr 52 | >>= stealObject 53 | 54 | -- | Return a weak reference proxy for the object. This will always return a 55 | -- new reference, but is not guaranteed to create a new object; an existing 56 | -- proxy may be returned. The second parameter, /callback/, can be a callable 57 | -- object that receives notification when /obj/ is garbage collected; it 58 | -- should accept a single parameter, which will be the weak reference object 59 | -- itself. If ob is not a weakly-referencable object, or if /callback/ is not 60 | -- callable, this will throw a @TypeError@. 61 | newProxy :: (Object obj, Object callback) => obj -> Maybe callback -> IO Proxy 62 | newProxy obj cb = 63 | withObject obj $ \objPtr -> 64 | maybeWith withObject cb $ \cbPtr -> 65 | {# call PyWeakref_NewProxy as ^ #} objPtr cbPtr 66 | >>= stealObject 67 | 68 | -- | Return the referenced object from a weak reference. If the referent is 69 | -- no longer live, returns @None@. 70 | {# fun PyWeakref_GetObject as getObject 71 | { withObject* `Reference' 72 | } -> `SomeObject' peekObject* #} 73 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-16.27 2 | packages: 3 | - '.' 4 | flags: {} 5 | extra-package-dbs: [] 6 | extra-deps: [] 7 | nix: 8 | packages: [python3, pkgconfig] 9 | -------------------------------------------------------------------------------- /tests/Tests.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# LANGUAGE TemplateHaskell #-} 3 | 4 | -- Copyright (C) 2012 John Millikin 5 | -- 6 | -- This program is free software: you can redistribute it and/or modify 7 | -- it under the terms of the GNU General Public License as published by 8 | -- the Free Software Foundation, either version 3 of the License, or 9 | -- any later version. 10 | -- 11 | -- This program is distributed in the hope that it will be useful, 12 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | -- GNU General Public License for more details. 15 | -- 16 | -- You should have received a copy of the GNU General Public License 17 | -- along with this program. If not, see . 18 | 19 | module Main 20 | ( main ) where 21 | 22 | import qualified CPython as Py 23 | import qualified CPython.Types.Module as Py 24 | import qualified CPython.Protocols.Object as Py 25 | import qualified CPython.Protocols.Number as Py 26 | import qualified CPython.Types.Dictionary as PyDict 27 | import qualified CPython.Types.List as PyList 28 | import qualified CPython.Types.Tuple as PyTuple 29 | import qualified CPython.Types.Unicode as PyUnicode 30 | import qualified CPython.Types.Integer as PyInt 31 | import qualified CPython.Types.Exception as PyExc 32 | import Data.Text() 33 | import Control.Monad(guard) 34 | import Data.Maybe(fromMaybe) 35 | import Control.Exception(handle, SomeException) 36 | 37 | main :: IO () 38 | main = verboseExc $ handle pyExceptionHandler $ do 39 | Py.initialize 40 | testingSomePythonEvaluation 41 | Py.finalize 42 | where 43 | pyExceptionHandler :: PyExc.Exception -> IO () 44 | pyExceptionHandler exception = handle pyExceptionHandlerWithoutPythonTraceback $ do 45 | tracebackModule <- Py.importModule "traceback" 46 | print_exc <- PyUnicode.toUnicode "print_exception" >>= Py.getAttribute tracebackModule 47 | kwargs <- PyDict.new 48 | args <- case PyExc.exceptionTraceback exception of 49 | Just tb -> PyTuple.toTuple [PyExc.exceptionType exception, PyExc.exceptionValue exception, tb] 50 | _ -> PyTuple.toTuple [PyExc.exceptionType exception, PyExc.exceptionValue exception] 51 | _ <- Py.call print_exc args kwargs 52 | return () 53 | pyExceptionHandlerWithoutPythonTraceback :: PyExc.Exception -> IO () 54 | pyExceptionHandlerWithoutPythonTraceback exception = do 55 | print exception 56 | putStrLn "Unexpected Python exception (Please report a bug)" 57 | 58 | verboseExc ioAction = handleEverything (\exc -> print exc >> error "Unexpected error") ioAction 59 | 60 | handleEverything :: (SomeException -> IO a) -> IO a -> IO a 61 | handleEverything = handle 62 | 63 | testingSomePythonEvaluation :: IO () 64 | testingSomePythonEvaluation = do 65 | testList <- traverse toObj [1, 10, 100, 42] >>= PyList.toList >>= (return . Py.toObject) 66 | builtinsModule <- Py.importModule "builtins" 67 | sumFunc <- PyUnicode.toUnicode "sum" >>= Py.getAttribute builtinsModule 68 | args <- PyTuple.toTuple [testList] 69 | kwargs <- PyDict.new 70 | result <- Py.call sumFunc args kwargs >>= castToNumber >>= Py.toInteger >>= PyInt.fromInteger 71 | guard $ result == 153 72 | where 73 | castToNumber obj = do x <- Py.castToNumber obj 74 | return $ fromMaybe (error "not a number returned from the sum") x 75 | toObj integer = fmap Py.toObject $ PyInt.toInteger integer 76 | --------------------------------------------------------------------------------