Fix ghcjs build
This commit is contained in:
parent
ba2c227fd6
commit
0376e5cac0
@ -3,13 +3,11 @@
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
module React.Export where
|
||||
|
||||
import Control.Monad.Except
|
||||
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 qualified Data.Text.IO as T
|
||||
import Language.Haskell.TH
|
||||
import Language.Haskell.TH.Syntax as TH
|
||||
import Language.Javascript.JSaddle
|
||||
@ -19,6 +17,8 @@ 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
|
||||
|
||||
@ -38,12 +38,6 @@ exportToJSIO build = runJS $ \arg -> do
|
||||
_ <- (arg # t "setVal") [m]
|
||||
pure ()
|
||||
|
||||
printJavaScriptException :: JavaScriptException -> JSM ()
|
||||
printJavaScriptException (JavaScriptException e) = do
|
||||
s <- e # t "toString" $ ()
|
||||
j <- valToJSON s
|
||||
liftIO $ T.putStrLn $ "Exception: " <> tshow j
|
||||
|
||||
runJS :: (JSVal -> JSM ()) -> IO ()
|
||||
|
||||
#ifdef ghcjs_HOST_OS
|
||||
@ -53,7 +47,7 @@ foreign import javascript unsafe "getProgramArg"
|
||||
|
||||
runJS f = do
|
||||
arg <- getProgramArg
|
||||
f arg `catchError` printJavaScriptException
|
||||
f arg
|
||||
|
||||
#else
|
||||
|
||||
@ -61,4 +55,10 @@ runJS f = do
|
||||
let port = 3001 --TODO: Get this from npm config or something
|
||||
run port $ \arg -> f arg `catchError` printJavaScriptException
|
||||
|
||||
printJavaScriptException :: JavaScriptException -> JSM ()
|
||||
printJavaScriptException (JavaScriptException e) = do
|
||||
s <- e # t "toString" $ ()
|
||||
j <- valToJSON s
|
||||
liftIO $ T.putStrLn $ "Exception: " <> tshow j
|
||||
|
||||
#endif
|
||||
|
Loading…
Reference in New Issue
Block a user