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 #-} {-# 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