{-# 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 :: forall r.
(Show r, Eq r, EmaStaticSite r) =>
SiteArg r -> IO [FilePath]
runSite SiteArg r
input = do
  Cli
cli <- IO Cli
CLI.cliAction
  DSum @Type Action Identity
result <- forall a b. (a, b) -> b
snd forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 () ->
      forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: Type -> Type) a. LoggingT m a -> Logger -> m a
runLoggerLoggingT (Cli -> Logger
getLogger Cli
cli) forall a b. (a -> b) -> a -> b
$
        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 ->
      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_ :: forall r. (Show r, Eq r, EmaStaticSite r) => SiteArg r -> IO ()
runSite_ = forall (f :: Type -> Type) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall r.
(Show r, Eq r, EmaStaticSite r) =>
Cli -> SiteArg r -> IO (RouteModel r, DSum @Type Action Identity)
runSiteWithCli Cli
cli SiteArg r
siteArg = do
  forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: Type -> Type) a. LoggingT m a -> Logger -> m a
runLoggerLoggingT (Cli -> Logger
getLogger Cli
cli) forall a b. (a -> b) -> a -> b
$ do
    FilePath
cwd <- forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO IO FilePath
getCurrentDirectory
    forall (m :: Type -> Type).
MonadLogger m =>
LogSource -> LogSource -> m ()
logInfoNS LogSource
"ema" forall a b. (a -> b) -> a -> b
$ LogSource
"Launching Ema under: " forall a. Semigroup a => a -> a -> a
<> forall a. ToText a => a -> LogSource
toText FilePath
cwd
    Dynamic (RouteModel r
model0 :: RouteModel r, (RouteModel r -> LoggingT IO ()) -> LoggingT IO ()
cont) <- 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 <- 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
        forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (RouteModel r
model0, Action a
act forall {k} (tag :: k -> Type) (f :: k -> Type) (a :: k).
tag a -> f a -> DSum @k tag f
:=> 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 <- forall (m :: Type -> Type) a. MonadIO m => m (LVar a)
LVar.empty
        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 <- forall (m :: Type -> Type).
MonadLoggerIO m =>
m (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
askLoggerIO
        forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
          forall a b. IO a -> IO b -> IO ()
race_
            ( forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: Type -> Type) a.
LoggingT m a
-> (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) -> m a
runLoggingT Loc -> LogSource -> LogLevel -> LogStr -> IO ()
logger forall a b. (a -> b) -> a -> b
$ do
                (RouteModel r -> LoggingT IO ()) -> LoggingT IO ()
cont forall a b. (a -> b) -> a -> b
$ forall (m :: Type -> Type) a. MonadIO m => LVar a -> a -> m ()
LVar.set LVar (RouteModel r)
model
                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.
                forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Port -> IO ()
threadDelay forall a. Bounded a => a
maxBound
            )
            ( forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: Type -> Type) a.
LoggingT m a
-> (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) -> m a
runLoggingT Loc -> LogSource -> LogLevel -> LogStr -> IO ()
logger forall a b. (a -> b) -> a -> b
$ do
                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
            )
        forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (RouteModel r
model0, Action a
act forall {k} (tag :: k -> Type) (f :: k -> Type) (a :: k).
tag a -> f a -> DSum @k tag f
:=> forall a. a -> Identity a
Identity ())