Add file extension to Route class

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

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

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

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 ->

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 `<base>` 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)

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]

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,