mirror of
https://github.com/srid/ema.git
synced 2024-11-22 04:13:06 +03:00
Ema.CLI.Action: unGADTify (#160)
* Ema.CLI.Action: unGADTify This simplifies the type for subsequent changes to be made. * Include outPath in return
This commit is contained in:
parent
3ed20effae
commit
089c5fa882
@ -11,9 +11,7 @@
|
||||
module Ema.Example.Ex06_Markdown where
|
||||
|
||||
import Control.Monad.Logger (LogLevel (..), MonadLoggerIO (..), defaultLoc, logInfoNS)
|
||||
import Control.Monad.Logger.Extras (runLoggerLoggingT)
|
||||
import Data.Default (Default (..))
|
||||
import Data.Dependent.Sum (DSum (..))
|
||||
import Data.Generics.Sum.Any
|
||||
import Data.Map (member)
|
||||
import Ema
|
||||
@ -126,12 +124,7 @@ runWithFollow ::
|
||||
runWithFollow input = do
|
||||
cli <- CLI.cliAction
|
||||
let cfg = SiteConfig cli followServerOptions
|
||||
result <- snd <$> runSiteWith @Route cfg input
|
||||
case result of
|
||||
CLI.Run _ :=> Identity () ->
|
||||
flip runLoggerLoggingT (CLI.getLogger cli) $
|
||||
CLI.crash "ema" "Live server unexpectedly stopped"
|
||||
CLI.Generate _ :=> Identity _ -> pass
|
||||
void $ snd <$> runSiteWith @Route cfg input
|
||||
|
||||
followServerOptions :: EmaServerOptions Route
|
||||
followServerOptions = EmaServerOptions wsClientJS followServerHandler
|
||||
|
@ -15,7 +15,6 @@ import Control.Exception (throw)
|
||||
import Control.Monad.Logger (MonadLogger, MonadLoggerIO)
|
||||
import Data.List qualified as List
|
||||
import Data.Map.Strict qualified as Map
|
||||
import Data.Some (Some)
|
||||
import Data.Time (UTCTime, defaultTimeLocale, formatTime, getCurrentTime)
|
||||
import Ema
|
||||
import Ema.CLI qualified
|
||||
@ -31,7 +30,7 @@ newtype StaticRoute (baseDir :: Symbol) = StaticRoute {unStaticRoute :: FilePath
|
||||
deriving stock (Generic)
|
||||
|
||||
data Model = Model
|
||||
{ modelCliAction :: Some Ema.CLI.Action
|
||||
{ modelCliAction :: Ema.CLI.Action
|
||||
, modelFiles :: Map FilePath UTCTime
|
||||
}
|
||||
deriving stock (Eq, Show, Generic)
|
||||
@ -97,7 +96,8 @@ staticRouteUrl rp model fp =
|
||||
-- In statically generated site, do it only for CSS and JS files.
|
||||
guard $
|
||||
Ema.CLI.isLiveServer (modelCliAction model)
|
||||
|| takeExtension fp `List.elem` [".css", ".js"]
|
||||
|| takeExtension fp
|
||||
`List.elem` [".css", ".js"]
|
||||
pure $ "?" <> tag
|
||||
|
||||
lookupMust :: FilePath -> Model -> UTCTime
|
||||
|
@ -4,6 +4,7 @@
|
||||
|
||||
- Relax `base` constraint forever
|
||||
- Live server shim/websocket customization ([\#152](https://github.com/srid/ema/pull/152)) @lucasvreis
|
||||
- `Ema.CLI`: The `Action` type is no longer a GADT.
|
||||
|
||||
## 0.10.2.0 (2023-08-09)
|
||||
|
||||
|
@ -79,11 +79,8 @@ library
|
||||
build-depends:
|
||||
, aeson
|
||||
, async
|
||||
, base >=4.13.0.0 && <4.99
|
||||
, constraints-extras
|
||||
, base >=4.13.0.0 && <4.99
|
||||
, data-default
|
||||
, dependent-sum
|
||||
, dependent-sum-template
|
||||
, directory
|
||||
, file-embed
|
||||
, filepath
|
||||
@ -96,7 +93,7 @@ library
|
||||
, neat-interpolation
|
||||
, optics-core
|
||||
, optparse-applicative
|
||||
, relude >=1.0
|
||||
, relude >=1.0
|
||||
, sop-core
|
||||
, text
|
||||
, unliftio
|
||||
|
@ -12,9 +12,7 @@ import Control.Concurrent.Async (race_)
|
||||
import Control.Monad.Logger (LoggingT (runLoggingT), MonadLoggerIO (askLoggerIO), logInfoNS, logWarnNS)
|
||||
import Control.Monad.Logger.Extras (runLoggerLoggingT)
|
||||
import Data.Default (Default, def)
|
||||
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))
|
||||
@ -48,17 +46,11 @@ runSite ::
|
||||
(Show r, Eq r, EmaStaticSite r) =>
|
||||
-- | The input required to create the `Dynamic` of the `RouteModel`
|
||||
SiteArg r ->
|
||||
IO [FilePath]
|
||||
IO (FilePath, [FilePath])
|
||||
runSite input = do
|
||||
cli <- CLI.cliAction
|
||||
let cfg = SiteConfig cli def
|
||||
result <- snd <$> runSiteWith @r cfg input
|
||||
case result of
|
||||
CLI.Run _ :=> Identity () ->
|
||||
flip runLoggerLoggingT (getLogger cli) $
|
||||
CLI.crash "ema" "Live server unexpectedly stopped"
|
||||
CLI.Generate _ :=> Identity fs ->
|
||||
pure fs
|
||||
snd <$> runSiteWith @r cfg input
|
||||
|
||||
-- | Like @runSite@ but discards the result
|
||||
runSite_ :: forall r. (Show r, Eq r, EmaStaticSite r) => SiteArg r -> IO ()
|
||||
@ -79,7 +71,8 @@ runSiteWith ::
|
||||
IO
|
||||
( -- The initial model value.
|
||||
RouteModel r
|
||||
, DSum CLI.Action Identity
|
||||
, -- Out path, and the list of statically generated files
|
||||
(FilePath, [FilePath])
|
||||
)
|
||||
runSiteWith cfg siteArg = do
|
||||
let opts = siteConfigServerOpts cfg
|
||||
@ -89,10 +82,10 @@ runSiteWith cfg siteArg = do
|
||||
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
|
||||
CLI.Generate dest -> do
|
||||
fs <- generateSiteFromModel @r dest model0
|
||||
pure (model0, act :=> Identity fs)
|
||||
Some act@(CLI.Run (host, mport)) -> do
|
||||
pure (model0, (dest, fs))
|
||||
CLI.Run (host, mport) -> do
|
||||
model <- LVar.empty
|
||||
LVar.set model model0
|
||||
logger <- askLoggerIO
|
||||
@ -108,4 +101,4 @@ runSiteWith cfg siteArg = do
|
||||
( flip runLoggingT logger $ do
|
||||
Server.runServerWithWebSocketHotReload @r opts host mport model
|
||||
)
|
||||
pure (model0, act :=> Identity ())
|
||||
CLI.crash "ema" "Live server unexpectedly stopped"
|
||||
|
@ -10,14 +10,7 @@ import Control.Monad.Logger.Extras (
|
||||
colorize,
|
||||
logToStdout,
|
||||
)
|
||||
import Data.Constraint.Extras.TH (deriveArgDict)
|
||||
import Data.Default (Default (def))
|
||||
import Data.GADT.Compare.TH (
|
||||
DeriveGCompare (deriveGCompare),
|
||||
DeriveGEQ (deriveGEq),
|
||||
)
|
||||
import Data.GADT.Show.TH (DeriveGShow (deriveGShow))
|
||||
import Data.Some (Some (..))
|
||||
import Network.Wai.Handler.Warp (Port)
|
||||
import Options.Applicative hiding (action)
|
||||
|
||||
@ -29,25 +22,21 @@ instance Default Host where
|
||||
def = "127.0.0.1"
|
||||
|
||||
-- | CLI subcommand
|
||||
data Action result where
|
||||
-- | Generate static files at the given output directory, returning the list
|
||||
-- of generated files.
|
||||
Generate :: FilePath -> Action [FilePath]
|
||||
-- | Run the live server
|
||||
Run :: (Host, Maybe Port) -> Action ()
|
||||
data Action
|
||||
= -- | Generate static files at the given output directory, returning the list
|
||||
-- of generated files.
|
||||
Generate FilePath
|
||||
| -- | Run the live server
|
||||
Run (Host, Maybe Port)
|
||||
deriving stock (Eq, Show, Generic)
|
||||
|
||||
$(deriveGEq ''Action)
|
||||
$(deriveGShow ''Action)
|
||||
$(deriveGCompare ''Action)
|
||||
$(deriveArgDict ''Action)
|
||||
|
||||
isLiveServer :: Some Action -> Bool
|
||||
isLiveServer (Some (Run _)) = True
|
||||
isLiveServer :: Action -> Bool
|
||||
isLiveServer (Run _) = True
|
||||
isLiveServer _ = False
|
||||
|
||||
-- | Ema's command-line interface options
|
||||
data Cli = Cli
|
||||
{ action :: Some Action
|
||||
{ action :: Action
|
||||
-- ^ The Ema action to run
|
||||
, verbose :: Bool
|
||||
-- ^ Logging verbosity
|
||||
@ -56,7 +45,7 @@ data Cli = Cli
|
||||
|
||||
instance Default Cli where
|
||||
-- By default, run the live server on random port.
|
||||
def = Cli (Some (Run def)) False
|
||||
def = Cli (Run def) False
|
||||
|
||||
cliParser :: Parser Cli
|
||||
cliParser = do
|
||||
@ -65,16 +54,16 @@ cliParser = do
|
||||
( command "gen" (info generate (progDesc "Generate static site"))
|
||||
<> command "run" (info run (progDesc "Run the live server"))
|
||||
)
|
||||
<|> pure (Some $ Run def)
|
||||
<|> pure (Run def)
|
||||
verbose <- switch (long "verbose" <> short 'v' <> help "Enable verbose logging")
|
||||
pure Cli {..}
|
||||
where
|
||||
run :: Parser (Some Action)
|
||||
run :: Parser Action
|
||||
run =
|
||||
fmap (Some . Run) $ (,) <$> hostParser <*> optional portParser
|
||||
generate :: Parser (Some Action)
|
||||
fmap Run $ (,) <$> hostParser <*> optional portParser
|
||||
generate :: Parser Action
|
||||
generate =
|
||||
Some . Generate <$> argument str (metavar "DEST")
|
||||
Generate <$> argument str (metavar "DEST")
|
||||
|
||||
hostParser :: Parser Host
|
||||
hostParser =
|
||||
|
@ -6,7 +6,6 @@ module Ema.Site (
|
||||
) where
|
||||
|
||||
import Control.Monad.Logger (MonadLoggerIO)
|
||||
import Data.Some (Some)
|
||||
import Ema.Asset (Asset)
|
||||
import Ema.CLI qualified as CLI
|
||||
import Ema.Dynamic (Dynamic)
|
||||
@ -54,7 +53,7 @@ class (IsRoute r) => EmaSite r where
|
||||
siteInput ::
|
||||
forall m.
|
||||
(MonadIO m, MonadUnliftIO m, MonadLoggerIO m) =>
|
||||
Some CLI.Action ->
|
||||
CLI.Action ->
|
||||
-- | The value passed by the programmer to `Ema.App.runSite`
|
||||
SiteArg r ->
|
||||
-- | Time-varying value of the model. If your model is not time-varying, use
|
||||
|
Loading…
Reference in New Issue
Block a user