{-# 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 :: SiteArg r -> IO [FilePath]
runSite SiteArg r
input = do
  Cli
cli <- IO Cli
CLI.cliAction
  DSum @Type Action Identity
result <- (RouteModel r, DSum @Type Action Identity)
-> DSum @Type Action Identity
forall a b. (a, b) -> b
snd ((RouteModel r, DSum @Type Action Identity)
 -> DSum @Type Action Identity)
-> IO (RouteModel r, DSum @Type Action Identity)
-> IO (DSum @Type Action Identity)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Cli -> SiteArg r -> IO (RouteModel r, DSum @Type Action Identity)
forall r.
(Show r, Eq r, EmaStaticSite r) =>
Cli -> SiteArg r -> IO (RouteModel r, DSum @Type Action Identity)
runSiteWithCli @r Cli
cli SiteArg r
input
  case DSum @Type Action Identity
result of
    CLI.Run (Host, Maybe Port)
_ :=> Identity () ->
      (LoggingT IO [FilePath] -> Logger -> IO [FilePath])
-> Logger -> LoggingT IO [FilePath] -> IO [FilePath]
forall a b c. (a -> b -> c) -> b -> a -> c
flip LoggingT IO [FilePath] -> Logger -> IO [FilePath]
forall (m :: Type -> Type) a. LoggingT m a -> Logger -> m a
runLoggerLoggingT (Cli -> Logger
getLogger Cli
cli) (LoggingT IO [FilePath] -> IO [FilePath])
-> LoggingT IO [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$
        LogSource -> LogSource -> LoggingT IO [FilePath]
forall (m :: Type -> Type) a.
(MonadLoggerIO m, MonadFail m) =>
LogSource -> LogSource -> m a
CLI.crash LogSource
"ema" LogSource
"Live server unexpectedly stopped"
    CLI.Generate FilePath
_ :=> Identity a
fs ->
      a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure a
fs

-- | Like @runSite@ but discards the result
runSite_ :: forall r. (Show r, Eq r, EmaStaticSite r) => SiteArg r -> IO ()
runSite_ :: SiteArg r -> IO ()
runSite_ = IO [FilePath] -> IO ()
forall (f :: Type -> Type) a. Functor f => f a -> f ()
void (IO [FilePath] -> IO ())
-> (SiteArg r -> IO [FilePath]) -> SiteArg r -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Show r, Eq r, EmaStaticSite r) => SiteArg r -> IO [FilePath]
forall r.
(Show r, Eq r, EmaStaticSite r) =>
SiteArg r -> IO [FilePath]
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 r -> IO (RouteModel r, DSum @Type Action Identity)
runSiteWithCli Cli
cli SiteArg r
siteArg = do
  (LoggingT IO (RouteModel r, DSum @Type Action Identity)
 -> Logger -> IO (RouteModel r, DSum @Type Action Identity))
-> Logger
-> LoggingT IO (RouteModel r, DSum @Type Action Identity)
-> IO (RouteModel r, DSum @Type Action Identity)
forall a b c. (a -> b -> c) -> b -> a -> c
flip LoggingT IO (RouteModel r, DSum @Type Action Identity)
-> Logger -> IO (RouteModel r, DSum @Type Action Identity)
forall (m :: Type -> Type) a. LoggingT m a -> Logger -> m a
runLoggerLoggingT (Cli -> Logger
getLogger Cli
cli) (LoggingT IO (RouteModel r, DSum @Type Action Identity)
 -> IO (RouteModel r, DSum @Type Action Identity))
-> LoggingT IO (RouteModel r, DSum @Type Action Identity)
-> IO (RouteModel r, DSum @Type Action Identity)
forall a b. (a -> b) -> a -> b
$ do
    FilePath
cwd <- IO FilePath -> LoggingT IO FilePath
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO IO FilePath
getCurrentDirectory
    LogSource -> LogSource -> LoggingT IO ()
forall (m :: Type -> Type).
MonadLogger m =>
LogSource -> LogSource -> m ()
logInfoNS LogSource
"ema" (LogSource -> LoggingT IO ()) -> LogSource -> LoggingT IO ()
forall a b. (a -> b) -> a -> b
$ LogSource
"Launching Ema under: " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> FilePath -> LogSource
forall a. ToText a => a -> LogSource
toText FilePath
cwd
    Dynamic (model0 :: RouteModel r, (RouteModel r -> LoggingT IO ()) -> LoggingT IO ()
cont) <- Some @Type Action
-> SiteArg r -> LoggingT IO (Dynamic (LoggingT IO) (RouteModel r))
forall r (m :: Type -> Type).
(EmaSite r, MonadIO m, MonadUnliftIO m, MonadLoggerIO m) =>
Some @Type Action -> SiteArg r -> m (Dynamic m (RouteModel r))
siteInput @r (Cli -> Some @Type Action
CLI.action Cli
cli) SiteArg r
siteArg
    case Cli -> Some @Type Action
CLI.action Cli
cli of
      Some act :: Action a
act@(CLI.Generate FilePath
dest) -> do
        [FilePath]
fs <- FilePath -> RouteModel r -> LoggingT IO [FilePath]
forall r (m :: Type -> Type).
(MonadIO m, MonadLoggerIO m, MonadFail m, Eq r, Show r, IsRoute r,
 EmaStaticSite r) =>
FilePath -> RouteModel r -> m [FilePath]
generateSiteFromModel @r FilePath
dest RouteModel r
model0
        (RouteModel r, DSum @Type Action Identity)
-> LoggingT IO (RouteModel r, DSum @Type Action Identity)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (RouteModel r
model0, Action a
act Action a -> Identity a -> DSum @Type Action Identity
forall {k} (tag :: k -> Type) (f :: k -> Type) (a :: k).
tag a -> f a -> DSum @k tag f
:=> [FilePath] -> Identity [FilePath]
forall a. a -> Identity a
Identity [FilePath]
fs)
      Some act :: Action a
act@(CLI.Run (Host
host, Maybe Port
mport)) -> do
        LVar (RouteModel r)
model <- LoggingT IO (LVar (RouteModel r))
forall (m :: Type -> Type) a. MonadIO m => m (LVar a)
LVar.empty
        LVar (RouteModel r) -> RouteModel r -> LoggingT IO ()
forall (m :: Type -> Type) a. MonadIO m => LVar a -> a -> m ()
LVar.set LVar (RouteModel r)
model RouteModel r
model0
        Loc -> LogSource -> LogLevel -> LogStr -> IO ()
logger <- LoggingT IO (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
forall (m :: Type -> Type).
MonadLoggerIO m =>
m (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
askLoggerIO
        IO () -> LoggingT IO ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> LoggingT IO ()) -> IO () -> LoggingT IO ()
forall a b. (a -> b) -> a -> b
$
          IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO ()
race_
            ( (LoggingT IO ()
 -> (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) -> IO ())
-> (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
-> LoggingT IO ()
-> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip LoggingT IO ()
-> (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) -> IO ()
forall (m :: Type -> Type) a.
LoggingT m a
-> (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) -> m a
runLoggingT Loc -> LogSource -> LogLevel -> LogStr -> IO ()
logger (LoggingT IO () -> IO ()) -> LoggingT IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                (RouteModel r -> LoggingT IO ()) -> LoggingT IO ()
cont ((RouteModel r -> LoggingT IO ()) -> LoggingT IO ())
-> (RouteModel r -> LoggingT IO ()) -> LoggingT IO ()
forall a b. (a -> b) -> a -> b
$ LVar (RouteModel r) -> RouteModel r -> LoggingT IO ()
forall (m :: Type -> Type) a. MonadIO m => LVar a -> a -> m ()
LVar.set LVar (RouteModel r)
model
                LogSource -> LogSource -> LoggingT IO ()
forall (m :: Type -> Type).
MonadLogger m =>
LogSource -> LogSource -> m ()
logWarnNS LogSource
"ema" LogSource
"modelPatcher exited; no more model updates!"
                -- We want to keep this thread alive, so that the server thread
                -- doesn't exit.
                IO () -> LoggingT IO ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> LoggingT IO ()) -> IO () -> LoggingT IO ()
forall a b. (a -> b) -> a -> b
$ Port -> IO ()
threadDelay Port
forall a. Bounded a => a
maxBound
            )
            ( (LoggingT IO ()
 -> (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) -> IO ())
-> (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
-> LoggingT IO ()
-> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip LoggingT IO ()
-> (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) -> IO ()
forall (m :: Type -> Type) a.
LoggingT m a
-> (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) -> m a
runLoggingT Loc -> LogSource -> LogLevel -> LogStr -> IO ()
logger (LoggingT IO () -> IO ()) -> LoggingT IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                Host -> Maybe Port -> LVar (RouteModel r) -> LoggingT IO ()
forall r (m :: Type -> Type).
(Show r, MonadIO m, MonadUnliftIO m, MonadLoggerIO m, Eq r,
 IsRoute r, EmaStaticSite r) =>
Host -> Maybe Port -> LVar (RouteModel r) -> m ()
Server.runServerWithWebSocketHotReload @r Host
host Maybe Port
mport LVar (RouteModel r)
model
            )
        (RouteModel r, DSum @Type Action Identity)
-> LoggingT IO (RouteModel r, DSum @Type Action Identity)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (RouteModel r
model0, Action a
act Action a -> Identity a -> DSum @Type Action Identity
forall {k} (tag :: k -> Type) (f :: k -> Type) (a :: k).
tag a -> f a -> DSum @k tag f
:=> () -> Identity ()
forall a. a -> Identity a
Identity ())