-----------------------------------------------------------------------------
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Miso.Run
-- Copyright   :  (C) 2016-2025 David M. Johnson
-- License     :  BSD3-style (see the file LICENSE)
-- Maintainer  :  David M. Johnson <code@dmj.io>
-- Stability   :  experimental
-- Portability :  non-portable
--
-- Support for running and live-reloading of miso applications.
----------------------------------------------------------------------------
module Miso.Run
  ( -- ** Live reload
    run
  , reload
  ) 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
-----------------------------------------------------------------------------
import           Miso.String
-----------------------------------------------------------------------------
-- | Entry point for a miso application.
--
-- * When compiling with GHC (native), this starts a web server for live reload, using [jsaddle](https://hackage.haskell.org/package/jsaddle).
-- * When compiling to WASM, this uses [jsaddle-wasm](https://hackage.haskell.org/package/jsaddle-wasm).
-- * When compiling to JS (GHCJS), this is simply 'id'.
run
  :: JSM ()
  -- ^ A JSM action typically created using 'Miso.miso' or 'Miso.startApp'
  -> 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
      runSettings (setPort port (setTimeout 3600 defaultSettings)) =<<
        jsaddleOr defaultConnectionOptions (action >> syncPoint)
        (static J.jsaddleApp)
-----------------------------------------------------------------------------
-- | Start or restart the server, with a static Middleware policy.
--
-- dmj: This is like @debug@ from `jsaddle-warp`, except it uses a static
-- middleware for static file hosting.
--
-- This means that usage of `url('mario.png')` will "just work" when developing
-- from GHCi.
--
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
-----------------------------------------------------------------------------
-- | Like 'run', but clears the <body> and <head> on each reload.
--
-- Meant to be used with WASM browser mode
--
-- @since 1.9.0.0
reload
  :: JSM ()
  -- ^ A JSM action typically created using 'Miso.miso' or 'Miso.startApp'
  -> IO ()
reload :: JSM () -> IO ()
reload JSM ()
action = JSM () -> IO ()
run (JSM ()
clear 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 ()
action)
  where
    clear :: JSM ()
    clear :: JSM ()
clear = do
      body_ <- MisoString -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg (MisoString
"document" :: MisoString) JSM JSVal -> MisoString -> JSM JSVal
forall this name.
(MakeObject this, ToJSString name) =>
this -> name -> JSM JSVal
! (MisoString
"body" :: MisoString)
      (body_ <# ("innerHTML" :: MisoString)) ("" :: MisoString)
      head_ <- jsg ("document" :: MisoString) ! ("head" :: MisoString)
      (head_ <# ("innerHTML" :: MisoString)) ("" :: MisoString)
-----------------------------------------------------------------------------