--
--  Fresco Framework for Multi-Language Programming
--  Copyright 2015-2016 Peter Althainz
--    
--  Distributed under the Apache License, Version 2.0
--  (See attached file LICENSE or copy at 
--  http:--www.apache.org/licenses/LICENSE-2.0)
-- 
--  file: haskell/Fresco/System.hs
--

{-# LANGUAGE ForeignFunctionInterface, CPP #-}

-- | Helper functions for binding ffi, encoding, decoding via messagepack
module Fresco.System

where

import Data.ByteString
import Data.ByteString.Unsafe
import Data.MessagePack
import Data.Either
import Data.Maybe
import Data.Serialize

import Foreign
import Foreign.C
import Foreign.Ptr

import Fresco.Component

#ifdef UseWinDLLLoading
import System.Win32.DLL
#else
import System.Posix.DynamicLinker
#endif

import System.Environment
import System.IO.Unsafe
import Data.IORef

toMsg :: ComponentClass o => o -> ByteString
toMsg o = encode (toObj o)

fromMsg :: ComponentClass o => ByteString -> Maybe o
fromMsg bs = case decode bs of 
                Right o -> Just $ fromObj o
                _ -> Nothing

-- helper functions

type MsgFunction = Ptr () -> Word64 -> Ptr CChar -> Word32 -> IO Word32
foreign import ccall "dynamic" 
   mkMsgFun :: FunPtr MsgFunction -> MsgFunction
foreign import ccall "wrapper"
   mkMsgFunPtr :: MsgFunction -> IO (FunPtr MsgFunction)

callMsgFunction :: FunPtr MsgFunction -> Ptr () -> Word64 -> ByteString -> IO Int
callMsgFunction mf p ct msg = do
      let f = mkMsgFun mf
      let dat = msg
      unsafeUseAsCStringLen' dat $ \(dat'1, dat'2) -> f p ct dat'1  dat'2 >>= \res -> return (fromIntegral res)
--      unsafeUseAsCStringLen' dat $ \(dat'1, dat'2) -> print "msgfun" >> print dat'1 >> print dat'2 >> f p dat'1  dat'2 >>= \res -> return (fromIntegral res)

type InitFunction = Ptr () -> IO Word32
foreign import ccall "dynamic" 
   mkInitFun :: FunPtr InitFunction -> InitFunction

callInitFunction :: FunPtr InitFunction -> Ptr () -> IO Int
callInitFunction ifp p = do
    let f = mkInitFun ifp
    res <- f p
    return (fromIntegral res)




-- Entity Interface

type EntityCreateFunction = ((Ptr CChar) -> (Word32 -> ((Ptr (Ptr ())) -> (IO ())))) 
foreign import ccall "dynamic" 
   mkEntityCreateFunction :: FunPtr EntityCreateFunction -> EntityCreateFunction

type EntityDestroyFunction = ((Ptr ()) -> IO ()) 
foreign import ccall "dynamic" 
   mkEntityDestroyFunction :: FunPtr EntityDestroyFunction -> EntityDestroyFunction

type EntityIdFunction = ((Ptr ()) -> IO (Ptr CChar))
foreign import ccall "dynamic"
  mkEntityIdFunction :: FunPtr EntityIdFunction -> EntityIdFunction

type EntityIdFreeFunction = ((Ptr CChar) -> IO ())
foreign import ccall "dynamic"
  mkEntityIdFreeFunction :: FunPtr EntityIdFreeFunction -> EntityIdFreeFunction


type EntitySetFunction = ((Ptr CChar) -> (Word32 -> ((Ptr ()) -> (IO ()))))
foreign import ccall "dynamic" 
   mkEntitySetFunction :: FunPtr EntitySetFunction -> EntitySetFunction

-- pub extern "C" fn entity_get_data(ep: EntityPointer, ct: u64, pp: *mut *mut DataPointer) 
type EntityGetDataFunction = ((Ptr ()) -> Word64 -> (Ptr (Ptr ())) -> IO ())
foreign import ccall "dynamic" 
   mkEntityGetDataFunction :: FunPtr EntityGetDataFunction -> EntityGetDataFunction

-- pub extern "C" fn entity_data_read(dp: *mut DataPointer, p_cp: *mut *const libc::c_char, p_len: *mut libc::c_int)
type EntityDataReadFunction = ((Ptr ()) -> (Ptr (Ptr CChar)) -> (Ptr Word32) -> IO ())
foreign import ccall "dynamic" 
   mkEntityDataReadFunction :: FunPtr EntityDataReadFunction -> EntityDataReadFunction

-- pub extern "C" fn entity_data_release(dp: *mut DataPointer)
type EntityDataReleaseFunction = ((Ptr ()) -> IO ())
foreign import ccall "dynamic" 
   mkEntityDataReleaseFunction :: FunPtr EntityDataReleaseFunction -> EntityDataReleaseFunction


-- pub extern "C" fn callback_system_create(pp: *mut *mut CallbackSystem) {
type ObjectLibSystemCreateFunction = ((Ptr (Ptr ())) -> (IO ()))
foreign import ccall "dynamic" 
   mkObjectLibSystemCreateFunction :: FunPtr ObjectLibSystemCreateFunction -> ObjectLibSystemCreateFunction

-- pub extern "C" fn callback_system_step(cbs: *mut CallbackSystem) {
type ObjectLibSystemAddEntityFunction = ((Ptr ()) -> ((Ptr ()) -> (IO ())))
foreign import ccall "dynamic" 
   mkObjectLibSystemAddEntityFunction:: FunPtr ObjectLibSystemAddEntityFunction -> ObjectLibSystemAddEntityFunction
   
-- pub extern "C" fn callback_system_step(cbs: *mut CallbackSystem) {
type ObjectLibSystemStepFunction = ((Ptr ()) -> (IO ()))
foreign import ccall "dynamic" 
   mkObjectLibSystemStepFunction:: FunPtr ObjectLibSystemStepFunction -> ObjectLibSystemStepFunction
   


-- pub extern "C" fn callback_system_create(pp: *mut *mut CallbackSystem) {
type CallbackSystemCreateFunction = ((Ptr (Ptr ())) -> (IO ()))
foreign import ccall "dynamic" 
   mkCallbackSystemCreateFunction :: FunPtr CallbackSystemCreateFunction -> CallbackSystemCreateFunction

-- pub extern "C" fn callback_system_register_receiver (cbs: *mut CallbackSystem, ep: EntityPointer, ct: u64, mfp: MessageFunctionPointer) {
type CallbackSystemRegisterReceiverFunction = ((Ptr ()) -> ((Ptr ()) -> (Word64 -> ((FunPtr ((Ptr ()) -> (Word64 -> ((Ptr CChar) -> (Word32 -> (IO Word32))))) -> (IO ()))))))
foreign import ccall "dynamic"
   mkCallbackSystemRegisterReceiverFunction :: FunPtr CallbackSystemRegisterReceiverFunction -> CallbackSystemRegisterReceiverFunction

-- pub extern "C" fn callback_system_step(cbs: *mut CallbackSystem) {
type CallbackSystemStepFunction = ((Ptr ()) -> (IO ()))
foreign import ccall "dynamic" 
   mkCallbackSystemStepFunction:: FunPtr CallbackSystemStepFunction -> CallbackSystemStepFunction
   

data EntityInterface = EntityInterface {
                        eCreate :: EntityCreateFunction,
                        eDestroy :: EntityDestroyFunction,
                        eId :: EntityIdFunction,
                        eIdFree :: EntityIdFreeFunction,

                        edSet :: EntitySetFunction,
                        edGet :: EntityGetDataFunction,
                        edRead :: EntityDataReadFunction,
                        edRelease :: EntityDataReleaseFunction,

                        olsCreate :: ObjectLibSystemCreateFunction,
                        olsAddEntity :: ObjectLibSystemAddEntityFunction,
                        olsStep :: ObjectLibSystemStepFunction,

                        cbsCreate :: CallbackSystemCreateFunction,
                        cbsRegisterReceiver :: CallbackSystemRegisterReceiverFunction,
                        cbsStep :: CallbackSystemStepFunction
                      }

#ifdef UseWinDLLLoading
dynamicEI :: IORef EntityInterface
{-# NOINLINE dynamicEI #-}
dynamicEI = unsafePerformIO (do
    libname <- getEnv "INTONACO"
    dll <- loadLibrary libname

    ec <- getProcAddress dll "entity_create"
    let ec' = mkEntityCreateFunction $ castPtrToFunPtr ec

    ed <- getProcAddress dll "entity_destroy"
    let ed' = mkEntityDestroyFunction $ castPtrToFunPtr ed

    ei <- getProcAddress dll "entity_id"
    let ei' = mkEntityIdFunction $ castPtrToFunPtr ei

    eif <- getProcAddress dll "entity_id_free"
    let eif' = mkEntityIdFreeFunction $ castPtrToFunPtr eif


    eds <- getProcAddress dll "entity_set" 
    let eds' = mkEntitySetFunction $ castPtrToFunPtr eds

    edg <- getProcAddress dll "entity_get_data"
    let edg' = mkEntityGetDataFunction $ castPtrToFunPtr edg

    edr <- getProcAddress dll "entity_data_read"
    let edr' = mkEntityDataReadFunction $ castPtrToFunPtr edr

    edrl <- getProcAddress dll "entity_data_release"
    let edrl' = mkEntityDataReleaseFunction $ castPtrToFunPtr edrl


    olc <- getProcAddress dll "object_lib_system_create" 
    let olc' = mkObjectLibSystemCreateFunction $ castPtrToFunPtr olc

    ola <- getProcAddress dll "object_lib_system_add_entity" 
    let ola' = mkObjectLibSystemAddEntityFunction $ castPtrToFunPtr ola

    ols <- getProcAddress dll "object_lib_system_step" 
    let ols' = mkObjectLibSystemStepFunction $ castPtrToFunPtr ols


    cbc <- getProcAddress dll "callback_system_create" 
    let cbc' = mkCallbackSystemCreateFunction $ castPtrToFunPtr cbc

    cbr <- getProcAddress dll "callback_system_register_receiver" 
    let cbr' = mkCallbackSystemRegisterReceiverFunction $ castPtrToFunPtr cbr

    cbs <- getProcAddress dll "callback_system_step" 
    let cbs' = mkCallbackSystemStepFunction $ castPtrToFunPtr cbs


    ref <- newIORef $ EntityInterface ec' ed' ei' eif'  eds' edg' edr' edrl'  olc' ola' ols'  cbc' cbr' cbs' 
    return ref
    )

  

#else
dynamicEI :: IORef EntityInterface
{-# NOINLINE dynamicEI #-}
dynamicEI = unsafePerformIO ( 
  do
    libname <- getEnv "INTONACO"
    dll <- dlopen libname [RTLD_NOW]

    ec <- dlsym dll "entity_create"
    let ec' = mkEntityCreateFunction ec

    ed <- dlsym dll "entity_destroy"
    let ed' = mkEntityDestroyFunction ed

    ei <- dlsym dll "entity_id"
    let ei' = mkEntityIdFunction ei

    eif <- dlsym dll "entity_id_free"
    let eif' = mkEntityIdFreeFunction eif


    eds <- dlsym dll "entity_set" 
    let eds' = mkEntitySetFunction eds

    edg <- dlsym dll "entity_get_data"
    let edg' = mkEntityGetDataFunction edg

    edr <- dlsym dll "entity_data_read"
    let edr' = mkEntityDataReadFunction edr

    edrl <- dlsym dll "entity_data_release"
    let edrl' = mkEntityDataReleaseFunction edrl


    olc <- dlsym dll "object_lib_system_create" 
    let olc' = mkObjectLibSystemCreateFunction olc

    ola <- dlsym dll "object_lib_system_add_entity" 
    let ola' = mkObjectLibSystemAddEntityFunction ola

    ols <- dlsym dll "object_lib_system_step" 
    let ols' = mkObjectLibSystemStepFunction ols


    cbc <- dlsym dll "callback_system_create" 
    let cbc' = mkCallbackSystemCreateFunction cbc

    cbr <- dlsym dll "callback_system_register_receiver" 
    let cbr' = mkCallbackSystemRegisterReceiverFunction cbr

    cbs <- dlsym dll "callback_system_step" 
    let cbs' = mkCallbackSystemStepFunction cbs


    ref <- newIORef $ EntityInterface ec' ed' ei' eif'  eds' edg' edr' edrl'  olc' ola' ols'  cbc' cbr' cbs' 
    return ref
  )
#endif

type CStringCLen i = (CString, i)

unsafeUseAsCStringLen' :: (Integral i) => ByteString -> (CStringCLen i -> IO a) -> IO a
unsafeUseAsCStringLen' str fn =
   unsafeUseAsCStringLen str (\(ptr, len) -> fn (ptr, fromIntegral len))



entityCreate :: (ByteString) -> IO ((Ptr ()))
entityCreate a1 =
  unsafeUseAsCStringLen' a1 $ \(a1'1, a1'2) -> 
  alloca $ \a2' -> 
  (do
    dei <- readIORef dynamicEI
    (eCreate dei) a1'1  a1'2 a2') >>
  peek  a2' >>= \a2'' -> 
  return (a2'')

entityDestroy :: Ptr () -> IO ()
entityDestroy a1 =
  (do
    dei <- readIORef dynamicEI
    (eDestroy dei) a1) >>
  return ()

entityId :: Ptr () -> IO ByteString
entityId ep = do
  dei <- readIORef dynamicEI
  p <- ((eId dei) ep)
  bs <- packCStringLen (p, 16)
  (eIdFree dei) p
  return bs



entitySet :: (ByteString) -> (Ptr ()) -> IO ()
entitySet a1 a2 =
  unsafeUseAsCStringLen' a1 $ \(a1'1, a1'2) -> 
  let {a2' = id a2} in 
  (do
    dei <- readIORef dynamicEI
    (edSet dei) a1'1  a1'2 a2') >>
  return ()

entityGetData :: (Ptr ()) -> Word64 -> IO ((Ptr ()))
entityGetData a1 a2 =
  alloca $ \a3' -> 
  (do
    dei <- readIORef dynamicEI
    (edGet dei) a1 (fromIntegral a2) a3') >>
  peek a3' >>= \a3'' -> 
  return (a3'')

entityDataRead :: Ptr () -> IO ByteString
entityDataRead a1 =
  alloca $ \a2' -> 
  alloca $ \a3' -> 
  (do
    dei <- readIORef dynamicEI
    (edRead dei) a1 a2' a3') >>
  peek a2' >>= \a2'' ->
  peek  a3' >>= \a3'' ->
  (do
     bs <- packCStringLen (a2'', fromIntegral a3'')
     return bs
    ) 

entityDataRelease :: Ptr () -> IO ()
entityDataRelease a1 = do
    dei <- readIORef dynamicEI
    (edRelease dei) a1
    return ()



objectLibSystemCreate :: IO ((Ptr ()))
objectLibSystemCreate =
  alloca $ \a1' -> 
  (do
    dei <- readIORef dynamicEI
    (olsCreate dei) a1') >>
  peek  a1'>>= \a1'' -> 
  return (a1'')

objectLibSystemAddEntity :: (Ptr ()) -> (Ptr ()) -> IO ()
objectLibSystemAddEntity a1 a2 =
  let {a1' = id a1; a2' = id a2} in 
  (do
    dei <- readIORef dynamicEI
    (olsAddEntity dei) a1' a2') >>
  return ()

objectLibSystemStep :: (Ptr ()) -> IO ()
objectLibSystemStep a1 =
  let {a1' = id a1} in 
  (do
    dei <- readIORef dynamicEI
    (olsStep dei) a1') >>
  return ()




callbackSystemCreate :: IO ((Ptr ()))
callbackSystemCreate =
  alloca $ \a1' -> 
  (do
    dei <- readIORef dynamicEI
    (cbsCreate dei) a1') >>
  peek  a1'>>= \a1'' -> 
  return (a1'')

callbackSystemRegisterReceiver :: (Ptr ()) -> (Ptr ()) -> (Word64) -> (FunPtr (Ptr () -> Word64 -> Ptr CChar -> Word32 -> IO Word32)) -> IO ()
callbackSystemRegisterReceiver a1 a2 a3 a4 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  let {a3' = fromIntegral a3} in 
  let {a4' = id a4} in 
  (do
    dei <- readIORef dynamicEI
    (cbsRegisterReceiver dei) a1' a2' a3' a4') >>
  return ()

callbackSystemStep :: (Ptr ()) -> IO ()
callbackSystemStep a1 =
  let {a1' = id a1} in 
  (do
    dei <- readIORef dynamicEI
    (cbsStep dei) a1') >>
  return ()