diff --git a/src/Ema/App.hs b/src/Ema/App.hs index 5b73d30..1f941f7 100644 --- a/src/Ema/App.hs +++ b/src/Ema/App.hs @@ -20,7 +20,7 @@ import qualified Data.LVar as LVar import Ema.CLI (Action (..), Cli) import qualified Ema.CLI as CLI import qualified Ema.Generate as Generate -import Ema.Route (HtmlRoute (..)) +import Ema.Route (FileRoute (..)) import qualified Ema.Server as Server import System.Directory (getCurrentDirectory, withCurrentDirectory) import System.Environment (lookupEnv) @@ -48,7 +48,7 @@ runEmaPure render = do -- exits, and vice-versa. runEma :: forall model route. - (HtmlRoute route, Show route) => + (FileRoute route, Show route) => [FilePath] -> (model -> [route]) -> -- | How to render a route, given the model @@ -66,7 +66,7 @@ runEma staticAssets staticRoutes render runModel = do -- Useful if you are handling CLI arguments yourself. runEmaWithCli :: forall model route. - (HtmlRoute route, Show route) => + (FileRoute route, Show route) => Cli -> [FilePath] -> (model -> [route]) -> @@ -93,7 +93,7 @@ runEmaWithCli cli staticAssets staticRoutes render runModel = do -- | Run Ema live dev server runEmaWithCliInCwd :: forall model route m. - (MonadIO m, MonadUnliftIO m, MonadLoggerIO m, HtmlRoute route, Show route) => + (MonadIO m, MonadUnliftIO m, MonadLoggerIO m, FileRoute route, Show route) => -- | CLI arguments CLI.Action -> -- | Your site model type, as a @LVar@ in order to support modifications over diff --git a/src/Ema/Example/Ex02_Basic.hs b/src/Ema/Example/Ex02_Basic.hs index fa3df09..ce1f8c7 100644 --- a/src/Ema/Example/Ex02_Basic.hs +++ b/src/Ema/Example/Ex02_Basic.hs @@ -10,7 +10,7 @@ module Ema.Example.Ex02_Basic where import Control.Concurrent (threadDelay) import qualified Data.LVar as LVar -import Ema (HtmlRoute (..)) +import Ema (FileRoute (..)) import qualified Ema import qualified Ema.CLI import qualified Ema.Helper.Tailwind as Tailwind @@ -25,10 +25,10 @@ data Route data Model = Model Text -instance HtmlRoute Route where +instance FileRoute Route where encodeRoute = \case Index -> mempty - About -> one "about" + About -> (one "about", ".html") decodeRoute = \case [] -> Just Index ["about"] -> Just About diff --git a/src/Ema/Example/Ex03_Clock.hs b/src/Ema/Example/Ex03_Clock.hs index f7f68a2..0ab2047 100644 --- a/src/Ema/Example/Ex03_Clock.hs +++ b/src/Ema/Example/Ex03_Clock.hs @@ -13,7 +13,7 @@ import Control.Concurrent (threadDelay) import qualified Data.LVar as LVar import Data.List ((!!)) import Data.Time (UTCTime, defaultTimeLocale, formatTime, getCurrentTime) -import Ema (HtmlRoute (..), routeUrl, runEma) +import Ema (FileRoute (..), routeUrl, runEma) import qualified Ema.CLI import qualified Ema.Helper.Tailwind as Tailwind import Text.Blaze.Html5 ((!)) @@ -25,10 +25,10 @@ data Route | OnlyTime deriving (Show, Enum, Bounded) -instance HtmlRoute Route where +instance FileRoute Route where encodeRoute = \case Index -> mempty - OnlyTime -> one "time" + OnlyTime -> (one "time", ".html") decodeRoute = \case [] -> Just Index ["time"] -> Just OnlyTime diff --git a/src/Ema/Generate.hs b/src/Ema/Generate.hs index ad7fbd3..308cd4d 100644 --- a/src/Ema/Generate.hs +++ b/src/Ema/Generate.hs @@ -6,7 +6,7 @@ module Ema.Generate where import Control.Exception (throw) import Control.Monad.Logger -import Ema.Route (HtmlRoute, routeFile) +import Ema.Route (FileRoute, routeFile) import System.Directory (copyFile, createDirectoryIfMissing, doesDirectoryExist, doesFileExist, doesPathExist) import System.FilePath (takeDirectory, ()) import System.FilePattern.Directory (getDirectoryFiles) @@ -20,7 +20,7 @@ generate :: ( MonadIO m, MonadUnliftIO m, MonadLoggerIO m, - HtmlRoute route + FileRoute route ) => FilePath -> model -> diff --git a/src/Ema/Route.hs b/src/Ema/Route.hs index f1bfd3e..337382b 100644 --- a/src/Ema/Route.hs +++ b/src/Ema/Route.hs @@ -2,7 +2,7 @@ {-# LANGUAGE TypeApplications #-} module Ema.Route - ( HtmlRoute (..), + ( FileRoute (..), routeUrl, routeFile, Slug (unSlug), @@ -20,15 +20,19 @@ import Ema.Route.UrlStrategy slugRelUrlWithStrategy, ) --- | Route to the generated HTML file. -class HtmlRoute route where - -- How to convert URLs to/from routes - encodeRoute :: route -> [Slug] +-- | Route to a generated file. +class FileRoute route where + -- | Slug path as well as the extension of the file corresponding to this + -- route. + encodeRoute :: route -> ([Slug], String) + + -- | Decode a slug path into a route. The final component of the slug path + -- will contain the extension if there is any. decodeRoute :: [Slug] -> Maybe route -- | The unit model is useful when using Ema in pure fashion (see @Ema.runEmaPure@) with a single route (index.html) only. -instance HtmlRoute () where - encodeRoute () = [] +instance FileRoute () where + encodeRoute () = ([], ".html") decodeRoute = \case [] -> Just () _ -> Nothing @@ -37,10 +41,10 @@ instance HtmlRoute () where -- -- As the returned URL is relative, you will have to either make it absolute (by -- prepending with `/`) or set the `` URL in your HTML head element. -routeUrl :: forall r. HtmlRoute r => r -> Text +routeUrl :: forall r. FileRoute r => r -> Text routeUrl r = slugRelUrlWithStrategy def (encodeRoute r) -routeFile :: forall r. HtmlRoute r => r -> FilePath +routeFile :: forall r. FileRoute r => r -> FilePath routeFile r = slugFileWithStrategy def (encodeRoute r) diff --git a/src/Ema/Route/UrlStrategy.hs b/src/Ema/Route/UrlStrategy.hs index b331e81..1ab15ca 100644 --- a/src/Ema/Route/UrlStrategy.hs +++ b/src/Ema/Route/UrlStrategy.hs @@ -19,8 +19,8 @@ data UrlStrategy instance Default UrlStrategy where def = UrlStrategy_HtmlOnlySansExt -slugRelUrlWithStrategy :: UrlStrategy -> [Slug] -> Text -slugRelUrlWithStrategy strat slugs = +slugRelUrlWithStrategy :: UrlStrategy -> ([Slug], String) -> Text +slugRelUrlWithStrategy strat (slugs, ".html") = case strat of UrlStrategy_FolderOnly -> T.intercalate "/" (encodeSlug <$> slugs) @@ -36,12 +36,14 @@ slugRelUrlWithStrategy strat slugs = if NE.last xs == x then NE.init xs else toList xs +slugRelUrlWithStrategy _ (slugs, ext) = + T.intercalate "/" (encodeSlug <$> slugs) <> toText ext -slugFileWithStrategy :: UrlStrategy -> [Slug] -> FilePath -slugFileWithStrategy strat slugs = +slugFileWithStrategy :: UrlStrategy -> ([Slug], String) -> FilePath +slugFileWithStrategy strat (slugs, ext) = case strat of UrlStrategy_FolderOnly -> - joinPath $ fmap (toString . unSlug) slugs <> ["index.html"] + joinPath $ fmap (toString . unSlug) slugs <> ["index" <> ext] UrlStrategy_HtmlOnlySansExt -> let (term :| (reverse -> parts)) = fromMaybe ("index" :| []) $ nonEmpty (reverse $ fmap (toString . unSlug) slugs) - in joinPath $ parts <> [term <> ".html"] + in joinPath $ parts <> [term <> ext] diff --git a/src/Ema/Server.hs b/src/Ema/Server.hs index c370857..93901ec 100644 --- a/src/Ema/Server.hs +++ b/src/Ema/Server.hs @@ -9,7 +9,7 @@ import Control.Monad.Logger import Data.LVar (LVar) import qualified Data.LVar as LVar import qualified Data.Text as T -import Ema.Route (HtmlRoute (..)) +import Ema.Route (FileRoute (..)) import qualified Ema.Route.Slug as Slug import GHC.IO.Unsafe (unsafePerformIO) import NeatInterpolation (text) @@ -26,7 +26,7 @@ import UnliftIO (MonadUnliftIO) runServerWithWebSocketHotReload :: forall model route m. - ( HtmlRoute route, + ( FileRoute route, Show route, MonadIO m, MonadUnliftIO m,