{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} module Ema.App ( runEma, runEmaPure, runEmaWithCli, MonadEma, ) where import Control.Concurrent (threadDelay) import Control.Concurrent.Async (race_) import Control.Monad.Logger import Control.Monad.Logger.Extras import Data.LVar (LVar) import qualified Data.LVar as LVar import Ema.CLI (Action (..), Cli) import qualified Ema.CLI as CLI import Ema.Class (Ema (..), MonadEma) import qualified Ema.Generate as Generate import qualified Ema.Server as Server import System.Directory (getCurrentDirectory, withCurrentDirectory) import System.Environment (lookupEnv) -- | Pure version of @runEmaWith@ (i.e with no model). -- -- Due to purity, there is no impure state, and thus no time-varying model. -- Neither is there a concept of route, as only a single route (index.html) is -- expected, whose HTML contents is specified as the only argument to this -- function. runEmaPure :: -- | How to render a route (CLI.Action -> LByteString) -> IO () runEmaPure render = do runEma (\act () () -> render act) $ \model -> do LVar.set model () liftIO $ threadDelay maxBound -- | Convenient version of @runEmaWith@ that takes initial model and an update -- function. You typically want to use this. -- -- It uses @race_@ to properly clean up the update action when the ema thread -- exits, and vice-versa. runEma :: forall model route. (Ema model route, Show route) => -- | How to render a route, given the model (CLI.Action -> model -> route -> LByteString) -> -- | A long-running IO action that will update the @model@ @LVar@ over time. -- This IO action must set the initial model value in the very beginning. (forall m. MonadEma m => LVar model -> m ()) -> IO () runEma render runModel = do cli <- CLI.cliAction runEmaWithCli cli render runModel -- | Like @runEma@ but takes the CLI action -- -- Useful if you are handling CLI arguments yourself. runEmaWithCli :: forall model route. (Ema model route, Show route) => Cli -> -- | How to render a route, given the model (CLI.Action -> model -> route -> LByteString) -> -- | A long-running IO action that will update the @model@ @LVar@ over time. -- This IO action must set the initial model value in the very beginning. (forall m. MonadEma m => LVar model -> m ()) -> IO () runEmaWithCli cli render runModel = do model <- LVar.empty -- TODO: Allow library users to control logging levels let logger = colorize logToStdout withCurrentDirectory (CLI.workingDir cli) $ do cwd <- getCurrentDirectory flip runLoggerLoggingT logger $ do logInfoN $ "Running Ema under: " <> toText cwd logInfoN "Waiting for initial site model ..." logInfoN " stuck here? set a model value using `LVar.set`" race_ (flip runLoggerLoggingT logger $ runModel model) (flip runLoggerLoggingT logger $ runEmaWithCliInCwd (CLI.action cli) model render) -- | Run Ema live dev server runEmaWithCliInCwd :: forall model route m. (MonadEma m, Ema model route, Show route) => -- | CLI arguments CLI.Action -> -- | Your site model type, as a @LVar@ in order to support modifications over -- time (for hot-reload). -- -- Use @Data.LVar.new@ to create it, and then -- over time -- @Data.LVar.set@ -- or @Data.LVar.modify@ to modify it. Ema will automatically hot-reload your -- site as this model data changes. LVar model -> -- | Your site render function. Takes the current @model@ value, and the page -- @route@ type as arguments. It must return the raw HTML to render to browser -- or generate on disk. (Action -> model -> route -> LByteString) -> m () runEmaWithCliInCwd cliAction model render = do case cliAction of Generate dest -> do val <- LVar.get model Generate.generate dest val (render cliAction) Run -> do void $ LVar.get model port <- liftIO $ fromMaybe 8000 . (readMaybe @Int =<<) <$> lookupEnv "PORT" Server.runServerWithWebSocketHotReload port model (render cliAction)