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