Fix ghcjs build

This commit is contained in:
Ryan Trinkle 2023-07-04 11:51:22 -04:00
parent ba2c227fd6
commit 0376e5cac0

View File

@ -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