From c345c7bd80bab21ab50c7fdf35879530296374e0 Mon Sep 17 00:00:00 2001 From: Sridhar Ratnakumar Date: Sat, 22 May 2021 00:02:04 -0400 Subject: [PATCH] Combine staticRoutes and staticAssets --- src/Ema/App.hs | 23 ++++++++++------------- src/Ema/Example/Ex02_Basic.hs | 2 +- src/Ema/Example/Ex03_Clock.hs | 2 +- src/Ema/Generate.hs | 11 +++++------ src/Ema/Route.hs | 10 ++++++++++ 5 files changed, 27 insertions(+), 21 deletions(-) diff --git a/src/Ema/App.hs b/src/Ema/App.hs index 15f603f..d02d7ed 100644 --- a/src/Ema/App.hs +++ b/src/Ema/App.hs @@ -37,7 +37,7 @@ runEmaPure :: (CLI.Action -> LByteString) -> IO () runEmaPure render = do - runEma (const []) (const $ one ()) (\act () () -> render act) $ \model -> do + runEma (const $ one $ Right ()) (\act () () -> render act) $ \model -> do LVar.set model () liftIO $ threadDelay maxBound @@ -49,17 +49,16 @@ runEmaPure render = do runEma :: forall model route. (FileRoute route, Show route) => - (model -> [FilePath]) -> - (model -> [route]) -> + (model -> [Either FilePath 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. (MonadIO m, MonadUnliftIO m, MonadLoggerIO m) => LVar model -> m ()) -> IO () -runEma staticAssets staticRoutes render runModel = do +runEma allRoutes render runModel = do cli <- CLI.cliAction - runEmaWithCli cli staticAssets staticRoutes render runModel + runEmaWithCli cli allRoutes render runModel -- | Like @runEma@ but takes the CLI action -- @@ -68,15 +67,14 @@ runEmaWithCli :: forall model route. (FileRoute route, Show route) => Cli -> - (model -> [FilePath]) -> - (model -> [route]) -> + (model -> [Either FilePath 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. (MonadIO m, MonadUnliftIO m, MonadLoggerIO m) => LVar model -> m ()) -> IO () -runEmaWithCli cli staticAssets staticRoutes render runModel = do +runEmaWithCli cli allRoutes render runModel = do model <- LVar.empty -- TODO: Allow library users to control logging levels let logger = colorize logToStdout @@ -88,7 +86,7 @@ runEmaWithCli cli staticAssets staticRoutes render runModel = do logInfoN " stuck here? set a model value using `LVar.set`" race_ (flip runLoggerLoggingT logger $ runModel model) - (flip runLoggerLoggingT logger $ runEmaWithCliInCwd (CLI.action cli) model staticAssets staticRoutes render) + (flip runLoggerLoggingT logger $ runEmaWithCliInCwd (CLI.action cli) model allRoutes render) -- | Run Ema live dev server runEmaWithCliInCwd :: @@ -103,18 +101,17 @@ runEmaWithCliInCwd :: -- or @Data.LVar.modify@ to modify it. Ema will automatically hot-reload your -- site as this model data changes. LVar model -> - (model -> [FilePath]) -> - (model -> [route]) -> + (model -> [Either FilePath route]) -> -- | 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 staticAssets staticRoutes render = do +runEmaWithCliInCwd cliAction model allRoutes render = do case cliAction of Generate dest -> do val <- LVar.get model - Generate.generate dest val (staticAssets val) (staticRoutes val) (render cliAction) + Generate.generate dest val (allRoutes val) (render cliAction) Run -> do void $ LVar.get model port <- liftIO $ fromMaybe 8000 . (readMaybe @Int =<<) <$> lookupEnv "PORT" diff --git a/src/Ema/Example/Ex02_Basic.hs b/src/Ema/Example/Ex02_Basic.hs index 7cec0df..cae3b51 100644 --- a/src/Ema/Example/Ex02_Basic.hs +++ b/src/Ema/Example/Ex02_Basic.hs @@ -38,7 +38,7 @@ instance FileRoute Route where main :: IO () main = do let routes = [minBound .. maxBound] - Ema.runEma mempty (const routes) render $ \model -> do + Ema.runEma (const $ Right <$> routes) render $ \model -> do LVar.set model $ Model "Hello World. " liftIO $ threadDelay maxBound diff --git a/src/Ema/Example/Ex03_Clock.hs b/src/Ema/Example/Ex03_Clock.hs index 864feb4..29db1f7 100644 --- a/src/Ema/Example/Ex03_Clock.hs +++ b/src/Ema/Example/Ex03_Clock.hs @@ -38,7 +38,7 @@ instance FileRoute Route where main :: IO () main = do let routes = [minBound .. maxBound] - Ema.runEma mempty (const routes) render $ \model -> + Ema.runEma (const $ Right <$> routes) render $ \model -> forever $ do LVar.set model =<< liftIO getCurrentTime liftIO $ threadDelay $ 1 * 1000000 diff --git a/src/Ema/Generate.hs b/src/Ema/Generate.hs index 8350126..0096011 100644 --- a/src/Ema/Generate.hs +++ b/src/Ema/Generate.hs @@ -24,22 +24,21 @@ generate :: ) => FilePath -> model -> - [FilePath] -> - [route] -> + [Either FilePath route] -> (model -> route -> LByteString) -> m () -generate dest model staticAssets routes render = do +generate dest model allRoutes render = do unlessM (liftIO $ doesDirectoryExist dest) $ do error $ "Destination does not exist: " <> toText dest - log LevelInfo $ "Writing " <> show (length routes) <> " routes" - forM_ routes $ \r -> do + log LevelInfo $ "Writing " <> show (length allRoutes) <> " routes" + forM_ (rights allRoutes) $ \r -> do let fp = dest encodeFileRoute r log LevelInfo $ toText $ "W " <> fp let !s = render model r liftIO $ do createDirectoryIfMissing True (takeDirectory fp) writeFileLBS fp s - forM_ staticAssets $ \staticPath -> do + forM_ (lefts allRoutes) $ \staticPath -> do liftIO (doesPathExist staticPath) >>= \case True -> -- TODO: In current branch, we don't expect this to be a directory. diff --git a/src/Ema/Route.hs b/src/Ema/Route.hs index fbc868d..74e6a03 100644 --- a/src/Ema/Route.hs +++ b/src/Ema/Route.hs @@ -28,6 +28,16 @@ instance FileRoute () where encodeFileRoute () = "index.html" decodeFileRoute = guard . (== "index.html") +-- | For file route type extendeded to let raw filepaths pass through. +-- +-- Useful in combining with static path routes that are not to be generated. +instance FileRoute r => FileRoute (Either FilePath r) where + encodeFileRoute = + either id encodeFileRoute + decodeFileRoute s = + fmap Right (decodeFileRoute s) + <|> fmap Left (Just s) + -- | Return the relative URL of the given route -- -- As the returned URL is relative, you will have to either make it absolute (by