call-haskell-from-anything-1.0.0.0: test/Test1.hs

{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE TemplateHaskell #-}

module Test1 where

import           Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import qualified Data.MessagePack as MSG

import Foreign.C

-- import FFI.Anything.TH (deriveCallable)
import FFI.Anything.TypeUncurry.Msgpack



-- | Example function to be called from Python.
f1 :: Int -> Double -> String
f1 i f = "Called with params: " ++ show i ++ ", " ++ show f


-- To be translated to:
f1' :: ByteString -> ByteString
f1' bs = BSL.toStrict $ MSG.pack (uncurry f1 $ msg)
  where
    msg = case MSG.unpack (BSL.fromStrict bs) of
      Nothing -> error "could not unpack"
      Just r -> r


-- TODO check who deallocs - it seems to work magically!
foreign export ccall f1_hs :: CString -> IO CString
f1_hs :: CString -> IO CString
f1_hs cs = do
    cs_bs <- BS.packCString cs
    let res_bs = f1' cs_bs
    res_cs <- BS.useAsCString res_bs return
    return res_cs


f1_t :: ByteString -> ByteString
f1_t = uncurryMsgpack f1

foreign export ccall f1_t_export :: CString -> IO CString
f1_t_export :: CString -> IO CString
f1_t_export = byteStringToCStringFun f1_t



fib :: Int -> Int
fib 0 = 1
fib 1 = 1
fib n = fib (n-1) + fib (n-2)


fib_print :: Int -> IO Int
fib_print x = putStrLn ("fib_print: " ++ show f) >> return f
  where
    f = fib x


foreign export ccall fib_export :: CString -> IO CString
fib_export :: CString -> IO CString
fib_export = export fib


-- TODO the sole *presence* of this function seems to make the calls in Python slower
-- foreign export ccall fib_print_export :: CString -> IO CString
-- fib_print_export :: CString -> IO CString
-- fib_print_export = exportIO fib_print

-- -- TODO the sole *presence* of this function seems to make the calls in Python slower
-- foreign export ccall fib_print_export2 :: CString -> IO CString
-- fib_print_export2 :: CString -> IO CString
-- fib_print_export2 = exportIO fib_print


-- $(deriveCallable 'f1 "f1_hs")


foreign export ccall fib_export_ffi :: CInt -> CInt
fib_export_ffi :: CInt -> CInt
fib_export_ffi = fromIntegral . fib . fromIntegral