{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE QuasiQuotes #-}
module Python (
    module Str,
    py_initialize,
    py_finalize,
    pydef)
where

import Str (str)
import Foreign.C
import Foreign.Ptr (Ptr, nullPtr)
import Data.Aeson (FromJSON, ToJSON, encode, decode)
import Data.ByteString.Lazy.Char8 (unpack, pack)

data PyObject

foreign import ccall "get_object" c_get_object :: CString -> Ptr PyObject
foreign import ccall "print_object" c_print_object :: (Ptr PyObject) -> IO ()
foreign import ccall "PyRun_SimpleString" py_runString :: CString -> IO ()
foreign import ccall "Py_Initialize" py_initialize :: IO ()
foreign import ccall "Py_Finalize" py_finalize :: IO ()
foreign import ccall "PyString_AsString" as_string :: Ptr PyObject -> CString
foreign import ccall "Py_BuildValue" py_BuildValueInt :: CString -> CInt -> Ptr PyObject
foreign import ccall "Py_BuildValue" py_BuildValueObj :: CString -> Ptr PyObject -> Ptr PyObject
foreign import ccall "Py_BuildValue" py_BuildValueString :: CString -> CString -> Ptr PyObject
foreign import ccall "PyTuple_Pack" pyTuple_Pack :: CInt -> Ptr PyObject -> Ptr PyObject
foreign import ccall "PyObject_CallObject" pyObject_CallObject :: Ptr PyObject -> Ptr PyObject -> Ptr a
foreign import ccall "PyObject_GetAttrString" py_get_attribute :: Ptr PyObject -> CString -> Ptr PyObject
foreign import ccall "PyInt_AsLong" pyInt_AsLong :: Ptr PyObject -> CInt
foreign import ccall "PyString_AsString" pyString_AsString :: Ptr PyObject -> CString



py_callObj :: Ptr PyObject -> (String, Ptr PyObject) -> IO (Ptr PyObject)
py_callObj f (s, x) = do
    -- p <- withCString s (\s -> return $ py_BuildValueObj s x) 
    p <- return $ pyTuple_Pack (fromIntegral 1) x
    -- print $ pyCallable_Check p
    result <- return $ pyObject_CallObject f p
    return result

py_callString :: Ptr PyObject -> (String, CString) -> IO (Ptr PyObject)
py_callString f (s, x) = do
    p <- withCString s (\s -> return $ py_BuildValueString s x) 
    return $ pyObject_CallObject f p

py_callInt :: Ptr PyObject -> (String, CInt) -> IO (Ptr PyObject)
py_callInt f (s, x) = do
    p <- withCString s (\s -> return $ py_BuildValueInt s x) 
    return $ pyObject_CallObject f p

python :: String -> IO ()
python s = withCString s py_runString

get_object :: String -> IO (Ptr PyObject)
get_object s = withCString s $ return . c_get_object

get_attribute :: Ptr PyObject -> String -> IO (Ptr PyObject)
get_attribute p s = withCString s $ return . py_get_attribute p

jsonfunc = [str|
def jsonfunc(f):
    import simplejson as json
    import traceback
    def new_f(*args):
        new_args = []
        for x in args:
            try:
                new_x = json.loads(x)
            except:
                print('error processing %s' % x)  
            new_args.append(new_x)
        try:
            result = f(*new_args)
            return json.dumps(result)
        except Exception as ex:
            print(traceback.format_exc())
            result = json.dumps(None)
    return new_f
|]

hString :: String -> String -> (String -> IO String)
hString name s = \x -> do
    python jsonfunc
    python s
    python $ name ++ " = jsonfunc(" ++ name ++ ")"
    f <- get_object name
    cx <- newCString x
    r <- py_callString f ("(s)", cx)
    x2 <- peekCString $ pyString_AsString r
    return x2

pydef :: (ToJSON a, FromJSON b) => String -> String -> a -> IO (Maybe b)
pydef name s = \input -> do
    outputStr <- hString name s (unpack . encode $ input)
    return $ mydecode $ outputStr

mydecode :: (FromJSON a) => String -> Maybe a
mydecode s = do
    x <- (decode . pack . (\x -> "[" ++ x ++ "]") ) s
    return $ head x