diff --git a/app/App.hs b/app/App.hs index 0bac028..3236b6e 100644 --- a/app/App.hs +++ b/app/App.hs @@ -1,7 +1,14 @@ +{-# LANGUAGE CPP #-} + module App (start) where +#ifdef wasi_HOST_OS import GHC.Wasm.Prim import Language.Javascript.JSaddle (JSM) +#else +import Language.Javascript.JSaddle +#endif + import SimpleCounter qualified import Snake qualified import TodoMVC qualified @@ -10,7 +17,7 @@ import XHR qualified start :: JSString -> JSM () start e = - case fromJSString e of + case fromJSString e :: String of "simplecounter" -> SimpleCounter.start "snake" -> Snake.start "todomvc" -> TodoMVC.start diff --git a/app/Main.hs b/app/Main.hs index 3f1a49c..e77363e 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,3 +1,7 @@ +{-# LANGUAGE CPP #-} + +#ifdef wasi_HOST_OS + module MyMain (main) where import App (start) @@ -8,3 +12,23 @@ foreign export javascript "hs_start" main :: JSString -> IO () main :: JSString -> IO () main e = JSaddle.Wasm.run $ start e + +#else + +module Main (main) where + +import App (start) +import Language.Javascript.JSaddle +import Language.Javascript.JSaddle.Warp +import Network.Wai.Handler.Warp +import Network.WebSockets +import System.Environment + +main :: IO () +main = getArgs >>= \case + [arg] -> runSettings (setPort 8000 defaultSettings) + =<< jsaddleOr defaultConnectionOptions (start $ toJSString arg) + jsaddleApp + _ -> fail "bad args: specify an example, e.g. 2048" + +#endif diff --git a/app/XHR.hs b/app/XHR.hs index c26e4ac..8ea38a6 100644 --- a/app/XHR.hs +++ b/app/XHR.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE RecordWildCards #-} @@ -9,13 +10,19 @@ module XHR (start) where -- slightly adapted from https://github.com/dmjio/miso/blob/master/examples/xhr/Main.hs +#ifdef wasi_HOST_OS +import GHC.Wasm.Prim +#else +import Data.JSString (JSString) +import Language.Javascript.JSaddle (fromJSString, toJSString) +#endif + import Control.Monad.IO.Class import Data.Aeson import qualified Data.Map as M import Data.Maybe import qualified Data.Text as T import GHC.Generics -import GHC.Wasm.Prim import Miso hiding (defaultOptions) import Miso.String @@ -135,14 +142,19 @@ instance FromJSON APIInfo where getGitHubAPIInfo :: JSM APIInfo getGitHubAPIInfo = do resp <- liftIO $ - T.pack . fromJSString <$> js_fetch (toJSString "https://api.github.com") + T.pack . fromJSString <$> js_fetch (toJSString ("https://api.github.com" :: String)) case eitherDecodeStrictText resp :: Either String APIInfo of Left s -> error s Right j -> pure j +#ifdef wasi_HOST_OS -- We use the WASM JS FFI here to access the more modern fetch API. If you want -- your code to eg also work when compiling with non-cross GHC and using -- jsaddle-warp, you can use fetch or XMLHttpRequest via JSaddle, for example -- via ghcjs-dom, servant-jsaddle or servant-client-js. foreign import javascript safe "const r = await fetch($1); return r.text();" js_fetch :: JSString -> IO JSString +#else +js_fetch :: JSString -> IO JSString +js_fetch = error "not implemented" +#endif diff --git a/ghc-wasm-miso-examples.cabal b/ghc-wasm-miso-examples.cabal index d8e3fe1..4b98b3d 100644 --- a/ghc-wasm-miso-examples.cabal +++ b/ghc-wasm-miso-examples.cabal @@ -8,10 +8,8 @@ executable ghc-wasm-miso-examples , aeson , base , containers - , ghc-experimental , hs2048 , jsaddle - , jsaddle-wasm , miso , mtl , random @@ -26,4 +24,8 @@ executable ghc-wasm-miso-examples Snake TodoMVC XHR - ghc-options: -no-hs-main -optl-mexec-model=reactor "-optl-Wl,--export=hs_start" + if arch(wasm32) + build-depends: ghc-experimental, jsaddle-wasm + ghc-options: -no-hs-main -optl-mexec-model=reactor "-optl-Wl,--export=hs_start" + else + build-depends: jsaddle-warp, warp, websockets