srid/ema
1
1
Fork 0
mirror of https://github.com/srid/ema.git synced 2024-11-29 09:25:14 +03:00
Code Issues Projects Releases Wiki Activity

Return generated files

Browse Source
This commit is contained in:
Sridhar Ratnakumar 2022-01-08 16:06:07 -05:00
parent 9d3a985f95
commit 2ad9036293
3 changed files with 15 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
CHANGELOG.md
View File

@ -5,7 +5,8 @@
- Pin TailwindCSS to 2.x, because the 3.x broke our CDN url
- Remove unused Cabal deps (#61)
- `Tailwind.layoutWith`: don't hardcode `<body>` attrs
- `runEma`: return the monadic's action's return value
- `runEma` and friends:
- return the monadic's action's return value or generated files
## 0.2.0.0 -- 2021-11-21

16
src/Ema/App.hs
View File

@ -60,7 +60,7 @@ runEma ::
-- | 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. (MonadIO m, MonadUnliftIO m, MonadLoggerIO m) => CLI.Action -> LVar model -> m b) ->
IO (Maybe b)
IO (Either b (Maybe [FilePath]))
runEma render runModel = do
cli <- CLI.cliAction
runEmaWithCli cli render runModel
@ -77,7 +77,7 @@ runEmaWithCli ::
-- | 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. (MonadIO m, MonadUnliftIO m, MonadLoggerIO m) => CLI.Action -> LVar model -> m b) ->
IO (Maybe b)
IO (Either b (Maybe [FilePath]))
runEmaWithCli cli render runModel = do
model <- LVar.empty
-- TODO: Allow library users to control logging levels, or colors.
@ -86,10 +86,9 @@ runEmaWithCli cli render runModel = do
cwd <- liftIO getCurrentDirectory
logInfoN $ "Launching Ema under: " <> toText cwd
logInfoN "Waiting for initial model ..."
leftToMaybe
<$> race
(flip runLoggerLoggingT logger $ runModel (CLI.action cli) model)
(flip runLoggerLoggingT logger $ runEmaWithCliInCwd (CLI.action cli) model render)
race
(flip runLoggerLoggingT logger $ runModel (CLI.action cli) model)
(flip runLoggerLoggingT logger $ runEmaWithCliInCwd (CLI.action cli) model render)
-- | Run Ema live dev server
runEmaWithCliInCwd ::
@ -108,18 +107,19 @@ runEmaWithCliInCwd ::
-- @route@ type as arguments. It must return the raw HTML to render to browser
-- or generate on disk.
(CLI.Action -> model -> route -> Asset LByteString) ->
m ()
m (Maybe [FilePath])
runEmaWithCliInCwd cliAction model render = do
val <- LVar.get model
logInfoN "... initial model is now available."
case cliAction of
CLI.Generate dest -> do
withBlockBuffering $
fmap Just <$> withBlockBuffering $
Generate.generate dest val (render cliAction)
CLI.Run -> do
port <- liftIO $ fromMaybe 8000 . (readMaybe @Int =<<) <$> lookupEnv "PORT"
host <- liftIO $ fromMaybe "127.0.0.1" <$> lookupEnv "HOST"
Server.runServerWithWebSocketHotReload host port model (render cliAction)
pure Nothing
where
-- Temporarily use block buffering before calling an IO action that is
-- known ahead to log rapidly, so as to not hamper serial processing speed.

7
src/Ema/Generate.hs
View File

@ -27,7 +27,8 @@ generate ::
FilePath ->
model ->
(model -> route -> Asset LByteString) ->
m ()
-- | List of generated files.
m [FilePath]
generate dest model render = do
unlessM (liftIO $ doesDirectoryExist dest) $ do
error $ "Destination does not exist: " <> toText dest
@ -39,12 +40,13 @@ generate dest model render = do
case render model r of
AssetStatic fp -> Left (r, fp)
AssetGenerated _fmt s -> Right (encodeRoute model r, s)
forM_ generatedPaths $ \(relPath, !s) -> do
paths <- forM generatedPaths $ \(relPath, !s) -> do
let fp = dest </> relPath
log LevelInfo $ toText $ "W " <> fp
liftIO $ do
createDirectoryIfMissing True (takeDirectory fp)
writeFileLBS fp s
pure fp
forM_ staticPaths $ \(r, staticPath) -> do
liftIO (doesPathExist staticPath) >>= \case
True ->
@ -54,6 +56,7 @@ generate dest model render = do
False ->
log LevelWarn $ toText $ "? " <> staticPath <> " (missing)"
noBirdbrainedJekyll dest
pure paths
-- | Disable birdbrained hacks from GitHub to disable surprises like,
-- https://github.com/jekyll/jekyll/issues/55