{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module Miso.Run
(
run
) where
#ifdef WASM
import qualified Language.Javascript.JSaddle.Wasm as J
#elif !GHCJS_BOTH
import Data.Maybe
import System.Environment
import Text.Read
import qualified Language.Javascript.JSaddle.Warp as J
import Network.Wai.Middleware.Static (static)
import Network.Wai.Handler.Warp (defaultSettings, setTimeout, setPort, runSettings)
import Network.WebSockets (defaultConnectionOptions)
import Language.Javascript.JSaddle.WebSockets (debugWrapper, jsaddleOr, jsaddleAppWithJs, jsaddleJs)
#endif
import Language.Javascript.JSaddle
run :: JSM () -> IO ()
#ifdef WASM
run = J.run
#elif GHCJS_BOTH
run = id
#else
run :: JSM () -> IO ()
run JSM ()
action = do
port <- Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
8008 (Maybe Int -> Int)
-> (Maybe String -> Maybe Int) -> Maybe String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Int) -> Maybe String -> Maybe Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (Maybe String -> Int) -> IO (Maybe String) -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe String)
lookupEnv String
"PORT"
isGhci <- (== "<interactive>") <$> getProgName
putStrLn $ "Running on port " <> show port <> "..."
if isGhci
then debugMiso port action
else J.run port action
debugMiso :: Int -> JSM () -> IO ()
debugMiso :: Int -> JSM () -> IO ()
debugMiso Int
port JSM ()
f = do
(Middleware -> JSM () -> IO ()) -> IO ()
debugWrapper ((Middleware -> JSM () -> IO ()) -> IO ())
-> (Middleware -> JSM () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Middleware
withRefresh JSM ()
registerContext ->
Settings -> Application -> IO ()
runSettings (Int -> Settings -> Settings
setPort Int
port (Int -> Settings -> Settings
setTimeout Int
3600 Settings
defaultSettings)) (Application -> IO ()) -> IO Application -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
ConnectionOptions -> JSM () -> Application -> IO Application
jsaddleOr
ConnectionOptions
defaultConnectionOptions
(JSM ()
registerContext JSM () -> JSM () -> JSM ()
forall a b. JSM a -> JSM b -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> JSM ()
f JSM () -> JSM () -> JSM ()
forall a b. JSM a -> JSM b -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> JSM ()
syncPoint)
(Middleware
static Middleware -> Middleware
forall a b. (a -> b) -> a -> b
$ Middleware
withRefresh Middleware -> Middleware
forall a b. (a -> b) -> a -> b
$ ByteString -> Application
jsaddleAppWithJs (ByteString -> Application) -> ByteString -> Application
forall a b. (a -> b) -> a -> b
$ Bool -> ByteString
jsaddleJs Bool
True)
#endif