add some encoders, and a new example WIP

.hlint.yaml

@@ -0,0 +1 @@
+- ignore: {name: Use camelCase }

ema.cabal

@@ -138,7 +138,8 @@ library
   if flag(with-examples)
     other-modules:
       Ema.Example.Common
-      Ema.Example.Ex02_Basic
+      Ema.Example.Ex01_Basic
+      Ema.Example.Ex02_Bookshelf
       Ema.Example.Ex03_Clock
       Ema.Example.Ex04_Multi
 

src/Ema/Example/Ex01_Basic.hs

@@ -0,0 +1,40 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+-- | A very simple site in three parts: route types, `main` and rendering implementation.
+module Ema.Example.Ex01_Basic where
+
+import Ema
+import Ema.Example.Common (tailwindLayout)
+import Generics.SOP qualified as SOP
+import Text.Blaze.Html5 ((!))
+import Text.Blaze.Html5 qualified as H
+import Text.Blaze.Html5.Attributes qualified as A
+
+data Route
+  = Route_Index
+  | Route_About
+  deriving stock (Show, Eq, Generic)
+  deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo, HasModel, IsRoute)
+
+main :: IO ()
+main = void $ Ema.runSite @Route ()
+
+instance RenderAsset Route where
+  renderAsset enc () r =
+    Ema.AssetGenerated Ema.Html $
+      tailwindLayout (H.title "Basic site" >> H.base ! A.href "/") $
+        H.div ! A.class_ "container mx-auto mt-8 p-2" $ do
+          H.h1 ! A.class_ "text-3xl font-bold" $ "Basic site"
+          case r of
+            Route_Index -> do
+              "You are on the index page. "
+              routeElem Route_About "Go to About"
+            Route_About -> do
+              routeElem Route_Index "Go to Index"
+              ". You are on the about page. "
+    where
+      routeElem r' w =
+        H.a ! A.class_ "text-red-500 hover:underline" ! routeHref r' $ w
+      routeHref r' =
+        A.href (fromString . toString $ Ema.routeUrl enc () r')

src/Ema/Example/Ex02_Basic.hs

@@ -1,46 +0,0 @@
-{-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE UndecidableInstances #-}
-{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
-
-{-# HLINT ignore "Use camelCase" #-}
-
--- | A very simple site with two routes, and HTML rendered using Blaze DSL
-module Ema.Example.Ex02_Basic where
-
-import Ema
-import Ema.Example.Common (tailwindLayout)
-import Ema.Route.Class (IsRoute)
-import GHC.Generics qualified as GHC
-import Generics.SOP (Generic, HasDatatypeInfo)
-import Text.Blaze.Html5 ((!))
-import Text.Blaze.Html5 qualified as H
-import Text.Blaze.Html5.Attributes qualified as A
-import Prelude hiding (Generic)
-
-data Route
-  = Route_Index
-  | Route_About
-  deriving stock (Show, Eq, GHC.Generic)
-  deriving anyclass (Generic, HasDatatypeInfo, IsRoute, HasModel)
-
-main :: IO ()
-main = void $ Ema.runSite @Route ()
-
-instance RenderAsset Route where
-  renderAsset enc () r =
-    Ema.AssetGenerated Ema.Html $
-      tailwindLayout (H.title "Basic site" >> H.base ! A.href "/") $
-        H.div ! A.class_ "container mx-auto" $ do
-          H.div ! A.class_ "mt-8 p-2 text-center" $ do
-            case r of
-              Route_Index -> do
-                "You are on the index page. "
-                routeElem Route_About "Go to About"
-              Route_About -> do
-                routeElem Route_Index "Go to Index"
-                ". You are on the about page. "
-    where
-      routeElem r' w =
-        H.a ! A.class_ "text-red-500 hover:underline" ! routeHref r' $ w
-      routeHref r' =
-        A.href (fromString . toString $ Ema.routeUrl enc () r')

src/Ema/Example/Ex02_Bookshelf.hs

@@ -0,0 +1,66 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+-- | TODO: rewrite this to load books.json and display that, with individual page for books too.
+module Ema.Example.Ex02_Bookshelf where
+
+import Ema
+import Ema.Example.Common (tailwindLayout)
+import Generics.SOP qualified as SOP
+import Text.Blaze.Html5 ((!))
+import Text.Blaze.Html5 qualified as H
+import Text.Blaze.Html5.Attributes qualified as A
+
+data Route
+  = Route_Index
+  | Route_About
+  | Route_Products ProductRoute
+  deriving stock (Show, Eq, Generic)
+  deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo, HasModel, IsRoute)
+
+-- TODO: Use DerivingVia to specify options, to disable extra /product/ in URL.
+data ProductRoute
+  = ProductRoute_Index
+  | ProductRoute_Product ProductName
+  deriving stock (Show, Eq, Generic)
+  deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo, IsRoute)
+
+-- TODO: Demonstrate all_ using a model (that loads from .json?)
+newtype ProductName = ProductName Text
+  deriving stock (Show, Eq)
+  deriving newtype (IsString, ToString, IsRoute)
+
+main :: IO ()
+main = void $ Ema.runSite @Route ()
+
+instance RenderAsset Route where
+  renderAsset enc () r =
+    Ema.AssetGenerated Ema.Html $
+      tailwindLayout (H.title "Basic site" >> H.base ! A.href "/") $
+        H.div ! A.class_ "container mx-auto mt-8 p-2" $ do
+          H.h1 ! A.class_ "text-3xl font-bold" $ "TODO: Bookshelf"
+          case r of
+            Route_Index -> do
+              "You are on the index page. "
+              routeElem Route_About "Go to About"
+              " or go to "
+              routeElem (Route_Products ProductRoute_Index) "products"
+            Route_About -> do
+              routeElem Route_Index "Go to Index"
+              ". You are on the about page. "
+            Route_Products pr -> do
+              H.h2 "Products"
+              case pr of
+                ProductRoute_Index -> do
+                  H.p "List of products go here"
+                  H.li $ routeElem (Route_Products $ ProductRoute_Product "egg") "Eggs"
+                  H.li $ routeElem (Route_Products $ ProductRoute_Product "sausage") "Sausages"
+                  routeElem Route_Index "Back to index"
+                ProductRoute_Product name -> do
+                  H.h3 ! A.class_ "p-2 border-2" $ fromString . toString $ name
+                  routeElem (Route_Products ProductRoute_Index) "Back to products"
+    where
+      routeElem r' w =
+        H.a ! A.class_ "text-red-500 hover:underline" ! routeHref r' $ w
+      routeHref r' =
+        A.href (fromString . toString $ Ema.routeUrl enc () r')

src/Ema/Example/Ex04_Multi.hs

@@ -8,7 +8,8 @@ module Ema.Example.Ex04_Multi where
 import Data.Generics.Sum.Any (AsAny (_As))
 import Ema
 import Ema.Example.Common (tailwindLayout)
-import Ema.Example.Ex02_Basic qualified as Ex02
+import Ema.Example.Ex01_Basic qualified as Ex01
+import Ema.Example.Ex02_Bookshelf qualified as Ex02
 import Ema.Example.Ex03_Clock qualified as Ex03
 import GHC.Generics qualified as GHC
 import Generics.SOP (Generic, HasDatatypeInfo, I (..), NP (..))
@@ -19,7 +20,8 @@ import Prelude hiding (Generic)
 
 data R
   = R_Index
-  | R_Basic Ex02.Route
+  | R_Basic Ex01.Route
+  | R_Bookshelf Ex02.Route
   | R_Clock Ex03.Route
   deriving stock (Show, Eq, GHC.Generic)
   deriving anyclass (Generic, HasDatatypeInfo, IsRoute)
@@ -41,11 +43,11 @@ instance RenderAsset R where
     R_Index ->
       Ema.AssetGenerated Ema.Html $ renderIndex m
     R_Basic r ->
-      let enc' = innerRouteEncoder (_As @"R_Basic") enc
+      renderAsset (innerRouteEncoder (_As @"R_Basic") enc) (innerModel m) r
-       in renderAsset enc' (innerModel m) r
+    R_Bookshelf r ->
+      renderAsset (innerRouteEncoder (_As @"R_Bookshelf") enc) (innerModel m) r
     R_Clock r ->
-      let enc' = innerRouteEncoder (_As @"R_Clock") enc
+      renderAsset (innerRouteEncoder (_As @"R_Clock") enc) (innerModel m) r
-       in renderAsset enc' (innerModel m) r
 
 renderIndex :: M -> LByteString
 renderIndex (I clockTime :* Nil) =
@@ -53,7 +55,8 @@ renderIndex (I clockTime :* Nil) =
     H.div ! A.class_ "container mx-auto text-center mt-8 p-2" $ do
       H.p "You can compose Ema sites. Here are two sites composed to produce one:"
       H.ul ! A.class_ "flex flex-col justify-center .items-center mt-4 space-y-4" $ do
-        H.li $ routeElem "basic" "Ex02_Basic"
+        H.li $ routeElem "basic" "Ex01_Basic"
+        H.li $ routeElem "bookshelf" "Ex02_Bookshelf"
         H.li $ routeElem "clock" "Ex03_Clock"
       H.p $ do
         "The current time is: "

src/Ema/Model.hs

@@ -3,14 +3,13 @@
 
 module Ema.Model
   ( HasModel (..),
-    unitModel,
   )
 where
 
 import Control.Monad.Logger (MonadLoggerIO)
 import Data.Some (Some)
 import Ema.CLI qualified as CLI
-import Ema.Dynamic (Dynamic (Dynamic))
+import Ema.Dynamic (Dynamic)
 import Ema.Route.Class (IsRoute (RouteModel))
 import Ema.Route.Encoder (RouteEncoder)
 import UnliftIO (MonadUnliftIO)
@@ -36,12 +35,4 @@ class IsRoute r => HasModel r where
     RouteEncoder (RouteModel r) r ->
     ModelInput r ->
     m (Dynamic m (RouteModel r))
-  runModel _ _ _ = pure unitModel
+  runModel _ _ _ = pure $ pure ()
-
-unitModel :: Monad m => Dynamic m ()
-unitModel =
-  Dynamic
-    ( (),
-      \_set -> do
-        pure ()
-    )

src/Ema/Route/Class.hs

@@ -7,6 +7,8 @@ module Ema.Route.Class
   ( IsRoute (RouteModel, mkRouteEncoder),
     gMkRouteEncoder,
     ConstModelRoute (..),
+    ShowReadable (ShowReadable),
+    Stringable (Stringable),
 
     -- * Sub routes
     innerRouteEncoder,
@@ -60,6 +62,24 @@ instance
   mkRouteEncoder =
     gMkRouteEncoder @r & mapRouteEncoder (iso id Just) (prism' unConstModelRoute (Just . ConstModelRoute)) (const ())
 
+newtype ShowReadable a = ShowReadable a
+  deriving newtype (Show, Read)
+
+newtype Stringable a = Stringable a
+  deriving newtype (ToString, IsString)
+
+instance (Show a, Read a) => IsRoute (ShowReadable a) where
+  type RouteModel (ShowReadable a) = ()
+  mkRouteEncoder = showReadRouteEncoder
+
+instance (IsString a, ToString a) => IsRoute (Stringable a) where
+  type RouteModel (Stringable a) = ()
+  mkRouteEncoder = stringRouteEncoder
+
+deriving via (Stringable Text) instance IsRoute Text
+
+deriving via (Stringable String) instance IsRoute String
+
 instance IsRoute () where
   type RouteModel () = ()
   mkRouteEncoder = singletonRouteEncoder
@@ -83,6 +103,8 @@ class HasModel (xs :: [Type]) (x :: Type) where
   -- | Fill in the outter model containing the given inner model.
   outerModel :: x -> NP I xs
 
+-- Could probably replace this lens-sop:
+-- with https://hackage.haskell.org/package/lens-sop-0.2.0.3/docs/Generics-SOP-Lens.html#v:np
 instance {-# OVERLAPPING #-} HasModel '[] () where
   innerModel _ = ()
   outerModel () = Nil
@@ -103,14 +125,12 @@ instance {-# OVERLAPPABLE #-} HasModel xs x => HasModel (x' ': xs) x where
   innerModel (_ :* xs) = innerModel xs
   outerModel x = I undefined :* outerModel x
 
--- TODO: avoid Iso using https://hackage.haskell.org/package/generic-lens
-
 -- | Extract the inner RouteEncoder.
+-- TODO: avoid having to specify Prism
 innerRouteEncoder ::
   forall m o i (ms :: [Type]).
   HasModel ms m =>
   Prism' o i ->
-  -- Iso o o (Maybe i) i ->
   RouteEncoder (NP I ms) o ->
   RouteEncoder m i
 innerRouteEncoder prism =

src/Ema/Route/Encoder.hs

@@ -11,6 +11,7 @@ module Ema.Route.Encoder
     singletonRouteEncoderFrom,
     isoRouteEncoder,
     showReadRouteEncoder,
+    stringRouteEncoder,
     mapRouteEncoder,
     leftRouteEncoder,
     rightRouteEncoder,
@@ -177,12 +178,11 @@ isoRouteEncoder iso =
 
 showReadRouteEncoder :: (Show r, Read r) => RouteEncoder () r
 showReadRouteEncoder =
-  unsafeMkRouteEncoder (const enc) (const dec) (const [])
+  isoRouteEncoder $ iso ((<> ".html") . show) (readMaybe <=< fmap toString . T.stripSuffix ".html" . toText)
-  where
+
-    enc r = show r <> ".html"
+stringRouteEncoder :: (IsString a, ToString a) => RouteEncoder () a
-    dec fp = do
+stringRouteEncoder =
-      x' <- fmap toString $ T.stripSuffix ".html" $ toText fp
+  isoRouteEncoder $ iso ((<> ".html") . toString) (fmap (fromString . toString) . T.stripSuffix ".html" . toText)
-      readMaybe x'
 
 -- | Route encoder for single route encoding to 'index.html'
 singletonRouteEncoder :: RouteEncoder a ()

src/Ema/Server.hs

@@ -13,7 +13,6 @@ import Data.LVar qualified as LVar
 import Data.Text qualified as T
 import Ema.Asset
 import Ema.CLI
-import Ema.Model
 import Ema.Route.Class
 import Ema.Route.Encoder
   ( checkRouteEncoderForSingleRoute,