App.hs

{-# LANGUAGE AllowAmbiguousTypes #-}

module Ema.App (
  runSite,
  runSite_,
  runSiteWithCli,
) where

import Control.Concurrent (threadDelay)
import Control.Concurrent.Async (race_)
import Control.Monad.Logger (LoggingT (runLoggingT), MonadLoggerIO (askLoggerIO), logInfoNS, logWarnNS)
import Control.Monad.Logger.Extras (runLoggerLoggingT)
import Data.Dependent.Sum (DSum ((:=>)))
import Data.LVar qualified as LVar
import Data.Some (Some (Some))
import Ema.CLI (getLogger)
import Ema.CLI qualified as CLI
import Ema.Dynamic (Dynamic (Dynamic))
import Ema.Generate (generateSiteFromModel)
import Ema.Route.Class (IsRoute (RouteModel))
import Ema.Server qualified as Server
import Ema.Site (EmaSite (SiteArg, siteInput), EmaStaticSite)
import System.Directory (getCurrentDirectory)

{- | Run the given Ema site,

  Takes as argument the associated `SiteArg`.

  In generate mode, return the generated files.  In live-server mode, this
  function will never return.
-}
runSite ::
  forall r.
  (Show r, Eq r, EmaStaticSite r) =>
  -- | The input required to create the `Dynamic` of the `RouteModel`
  SiteArg r ->
  IO [FilePath]
runSite input = do
  cli <- CLI.cliAction
  result <- snd <$> runSiteWithCli @r cli input
  case result of
    CLI.Run _ :=> Identity () ->
      flip runLoggerLoggingT (getLogger cli) $
        CLI.crash "ema" "Live server unexpectedly stopped"
    CLI.Generate _ :=> Identity fs ->
      pure fs

-- | Like @runSite@ but discards the result
runSite_ :: forall r. (Show r, Eq r, EmaStaticSite r) => SiteArg r -> IO ()
runSite_ = void . runSite @r

{- | Like @runSite@ but takes the CLI action. Also returns more information.

 Useful if you are handling the CLI arguments yourself.

 Use "void $ Ema.runSiteWithCli def ..." if you are running live-server only.
-}
runSiteWithCli ::
  forall r.
  (Show r, Eq r, EmaStaticSite r) =>
  CLI.Cli ->
  SiteArg r ->
  IO
    ( -- The initial model value.
      RouteModel r
    , DSum CLI.Action Identity
    )
runSiteWithCli cli siteArg = do
  flip runLoggerLoggingT (getLogger cli) $ do
    cwd <- liftIO getCurrentDirectory
    logInfoNS "ema" $ "Launching Ema under: " <> toText cwd
    Dynamic (model0 :: RouteModel r, cont) <- siteInput @r (CLI.action cli) siteArg
    case CLI.action cli of
      Some act@(CLI.Generate dest) -> do
        fs <- generateSiteFromModel @r dest model0
        pure (model0, act :=> Identity fs)
      Some act@(CLI.Run (host, mport)) -> do
        model <- LVar.empty
        LVar.set model model0
        logger <- askLoggerIO
        liftIO $
          race_
            ( flip runLoggingT logger $ do
                cont $ LVar.set model
                logWarnNS "ema" "modelPatcher exited; no more model updates!"
                -- We want to keep this thread alive, so that the server thread
                -- doesn't exit.
                liftIO $ threadDelay maxBound
            )
            ( flip runLoggingT logger $ do
                Server.runServerWithWebSocketHotReload @r host mport model
            )
        pure (model0, act :=> Identity ())