{-# LANGUAGE ForeignFunctionInterface, OverloadedStrings #-}
module Language.Javascript.JSaddle.CLib
  ( jsaddleInit
  , NativeCallbacks (..)
  , AppCallbacks (..)
  , AppConfig (..)
  , pokeAppConfig
  , appConfigToAppCallbacks
  ) where

import Prelude ()
import Prelude.Compat

import Control.Monad (void)
import Control.Concurrent (forkIO)

import Data.Aeson (encode, decode)
import Data.ByteString (useAsCString, packCString)
import Data.ByteString.Char8 (unpack)
import Data.ByteString.Lazy (ByteString, toStrict, fromStrict)
import Data.Default (def, Default)
import Data.Text (Text)
import qualified Data.Text.Encoding as T

import Foreign.C.String (CString, newCString)
import Foreign.Ptr (FunPtr, Ptr)
import Foreign.Storable (poke)
import Foreign.Marshal.Utils (new)

import Language.Javascript.JSaddle (JSM)
import Language.Javascript.JSaddle.Run (runJavaScript)
import Language.Javascript.JSaddle.Run.Files (initState, runBatch, ghcjsHelpers)

import Language.Javascript.JSaddle.CLib.Internal

foreign import ccall safe "dynamic"
  mkCallback :: FunPtr (CString -> IO ()) -> CString -> IO ()

foreign import ccall safe "wrapper"
  wrapStartCallback :: IO () -> IO (FunPtr (IO ()))

foreign import ccall safe "wrapper"
  wrapMessageCallback :: (CString -> IO ()) -> IO (FunPtr (CString -> IO ()))

foreign import ccall safe "wrapper"
  wrapMessageCallback2 :: (CString -> CString -> IO ()) -> IO (FunPtr (CString -> CString -> IO ()))

foreign import ccall safe "wrapper"
  wrapSyncCallback :: (CString -> IO CString) -> IO (FunPtr (CString -> IO CString))

jsaddleInit :: JSM () -> FunPtr (CString -> IO ()) -> IO (Ptr NativeCallbacks)
jsaddleInit jsm evaluateJavascriptAsyncPtr = do
  let evaluateJavascriptAsync = mkCallback evaluateJavascriptAsyncPtr
  (processResult, processSyncResult, start) <- runJavaScript (\batch ->
    useAsCString (toStrict $ "runJSaddleBatch(" <> encode batch <> ");")
      evaluateJavascriptAsync) jsm
  jsaddleStartPtr <- wrapStartCallback $ void $ forkIO start
  jsaddleResultPtr <- wrapMessageCallback $ \s -> do
    result <- decode . fromStrict <$> packCString s
    case result of
      Nothing -> error $ "jsaddle message decode failed: " <> show result
      Just r -> processResult r
  jsaddleSyncResultPtr <- wrapSyncCallback $ \s -> do
    result <- decode . fromStrict <$> packCString s
    case result of
      Nothing -> error $ "jsaddle message decode failed: " <> show result
      Just r -> newCString =<< unpack . toStrict . encode <$> processSyncResult r
  jsaddleJsPtr <- newCString $ unpack $ toStrict jsaddleJs
  jsaddleHtmlPtr <- newCString $ unpack $ toStrict indexHtml
  new NativeCallbacks
    { _nativeCallbacks_jsaddleStart = jsaddleStartPtr
    , _nativeCallbacks_jsaddleResult = jsaddleResultPtr
    , _nativeCallbacks_jsaddleSyncResult = jsaddleSyncResultPtr
    , _nativeCallbacks_jsaddleJsData = jsaddleJsPtr
    , _nativeCallbacks_jsaddleHtmlData = jsaddleHtmlPtr
    }

data AppConfig = AppConfig
  { _appConfig_mainActivityOnCreate :: IO ()
  , _appConfig_mainActivityOnStart :: IO ()
  , _appConfig_mainActivityOnResume :: IO ()
  , _appConfig_mainActivityOnPause :: IO ()
  , _appConfig_mainActivityOnStop :: IO ()
  , _appConfig_mainActivityOnDestroy :: IO ()
  , _appConfig_mainActivityOnRestart :: IO ()
  , _appConfig_mainActivityOnNewIntent :: (Text -> Text -> IO ())
  , _appConfig_firebaseInstanceIdServiceSendRegistrationToServer :: Text -> IO ()
  }

instance Default AppConfig where
  def = AppConfig
    { _appConfig_mainActivityOnCreate = return ()
    , _appConfig_mainActivityOnStart = return ()
    , _appConfig_mainActivityOnResume = return ()
    , _appConfig_mainActivityOnPause = return ()
    , _appConfig_mainActivityOnStop = return ()
    , _appConfig_mainActivityOnDestroy = return ()
    , _appConfig_mainActivityOnRestart = return ()
    , _appConfig_mainActivityOnNewIntent = \_ _ -> return ()
    , _appConfig_firebaseInstanceIdServiceSendRegistrationToServer = \_ -> return ()
    }

appConfigToAppCallbacks :: AppConfig -> IO AppCallbacks
appConfigToAppCallbacks c = do
  create <- wrapStartCallback $ _appConfig_mainActivityOnCreate c
  start <- wrapStartCallback $ _appConfig_mainActivityOnStart c
  resume <- wrapStartCallback $ _appConfig_mainActivityOnResume c
  pause <- wrapStartCallback $ _appConfig_mainActivityOnPause c
  stop <- wrapStartCallback $ _appConfig_mainActivityOnStop c
  destroy <- wrapStartCallback $ _appConfig_mainActivityOnDestroy c
  restart <- wrapStartCallback $ _appConfig_mainActivityOnRestart c
  newIntent <- wrapMessageCallback2 $ \intentAction intentData -> do
    intentAction' <- fromUtf8CString intentAction
    intentData' <- fromUtf8CString intentData
    _appConfig_mainActivityOnNewIntent c intentAction' intentData'
  firebaseRegPtr <- wrapMessageCallback $ \token -> do
    token' <- fromUtf8CString token
    _appConfig_firebaseInstanceIdServiceSendRegistrationToServer c token'
  return $ AppCallbacks
    { _appCallbacks_mainActivity_onCreate = create
    , _appCallbacks_mainActivity_onStart = start
    , _appCallbacks_mainActivity_onResume = resume
    , _appCallbacks_mainActivity_onPause = pause
    , _appCallbacks_mainActivity_onStop = stop
    , _appCallbacks_mainActivity_onDestroy = destroy
    , _appCallbacks_mainActivity_onRestart = restart
    , _appCallbacks_mainActivity_onNewIntent = newIntent
    , _appCallbacks_firebaseInstanceIdService_sendRegistrationToServer = firebaseRegPtr
    }

fromUtf8CString :: CString -> IO Text
fromUtf8CString = fmap T.decodeUtf8 . packCString

pokeAppConfig :: Ptr AppCallbacks -> AppConfig -> IO ()
pokeAppConfig ptr cfg = poke ptr =<< appConfigToAppCallbacks cfg

jsaddleJs :: ByteString
jsaddleJs = ghcjsHelpers <> "\
    \runJSaddleBatch = (function() {\n\
    \ " <> initState <> "\n\
    \ return function(batch) {\n\
    \ " <> runBatch (\a -> "jsaddle.postMessage(JSON.stringify(" <> a <> "));")
              (Just (\a -> "JSON.parse(jsaddle.syncMessage(JSON.stringify(" <> a <> ")))")) <> "\
    \ };\n\
    \})();\n\
    \jsaddle.postReady();\n"

indexHtml :: ByteString
indexHtml =
    "<!DOCTYPE html>\n\
    \<html>\n\
    \<head>\n\
    \<title>JSaddle</title>\n\
    \</head>\n\
    \<body>\n\
    \</body>\n\
    \</html>"