{-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}
module React.Export where

import Control.Monad.Reader as MTL
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Text (Text)
import qualified Data.Text as T
import Language.Haskell.TH
import Language.Haskell.TH.Syntax as TH
import Language.Javascript.JSaddle

import React.Misc
import React.JSaddle ()
import React.Types

#ifndef ghcjs_HOST_OS
import Control.Monad.Except
import qualified Data.Text.IO as T
import Language.Javascript.JSaddle.Warp
#endif

mainExportsToJS :: [Name] -> Q [Dec]
mainExportsToJS :: [Name] -> Q [Dec]
mainExportsToJS [Name]
names = [d|
    main :: IO ()
    main = exportToJSIO $ sequence $ Map.fromList $(listE $ fmap nameToExportEntry names)
  |]

nameToExportEntry :: Name -> Q Exp
nameToExportEntry :: Name -> Q Exp
nameToExportEntry Name
n = [| (T.pack $(TH.lift $ nameBase n), MTL.lift . toJSVal =<< $(varE n)) |]

exportToJSIO :: ReaderT React JSM (Map Text JSVal) -> IO ()
exportToJSIO :: ReaderT React JSM (Map Text JSVal) -> IO ()
exportToJSIO ReaderT React JSM (Map Text JSVal)
build = (JSVal -> JSM ()) -> IO ()
runJS ((JSVal -> JSM ()) -> IO ()) -> (JSVal -> JSM ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \JSVal
arg -> do
  React
react <- (JSVal -> React) -> JSM JSVal -> JSM React
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Object -> React
React (Object -> React) -> (JSVal -> Object) -> JSVal -> React
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSVal -> Object
Object) (JSM JSVal -> JSM React) -> JSM JSVal -> JSM React
forall a b. (a -> b) -> a -> b
$ JSVal
arg JSVal -> Text -> JSM JSVal
forall this name.
(MakeObject this, ToJSString name) =>
this -> name -> JSM JSVal
! Text -> Text
t Text
"react"
  Map Text JSVal
m <- (ReaderT React JSM (Map Text JSVal)
 -> React -> JSM (Map Text JSVal))
-> React
-> ReaderT React JSM (Map Text JSVal)
-> JSM (Map Text JSVal)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT React JSM (Map Text JSVal) -> React -> JSM (Map Text JSVal)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT React
react ReaderT React JSM (Map Text JSVal)
build
  JSVal
_ <- (JSVal
arg JSVal -> Text -> [Map Text JSVal] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# Text -> Text
t Text
"setVal") [Map Text JSVal
m]
  () -> JSM ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

runJS :: (JSVal -> JSM ()) -> IO ()

#ifdef ghcjs_HOST_OS

foreign import javascript unsafe "getProgramArg"
    getProgramArg :: JSM JSVal

runJS f = do
  arg <- getProgramArg
  f arg

#else

runJS :: (JSVal -> JSM ()) -> IO ()
runJS JSVal -> JSM ()
f = do
  let port :: Int
port = Int
3001 --TODO: Get this from npm config or something
  Int -> (JSVal -> JSM ()) -> IO ()
run Int
port ((JSVal -> JSM ()) -> IO ()) -> (JSVal -> JSM ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \JSVal
arg -> JSVal -> JSM ()
f JSVal
arg JSM () -> (JavaScriptException -> JSM ()) -> JSM ()
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` JavaScriptException -> JSM ()
printJavaScriptException

printJavaScriptException :: JavaScriptException -> JSM ()
printJavaScriptException :: JavaScriptException -> JSM ()
printJavaScriptException (JavaScriptException JSVal
e) = do
  JSVal
s <- JSVal
e JSVal -> Text -> () -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# Text -> Text
t Text
"toString" (() -> JSM JSVal) -> () -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ ()
  JSString
j <- JSVal -> JSM JSString
forall value. ToJSVal value => value -> JSM JSString
valToJSON JSVal
s
  IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
T.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Exception: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> JSString -> Text
forall a. Show a => a -> Text
tshow JSString
j

#endif