merge route encoder

ema.cabal

@@ -118,12 +118,12 @@ library
   exposed-modules:
     Ema
     Ema.CLI
+    Ema.Route
 
   other-modules:
     Ema.App
     Ema.Asset
     Ema.Generate
-    Ema.Route
     Ema.Server
     Ema.Site
 

src/Ema/Route.hs

@@ -12,6 +12,7 @@ module Ema.Route
     defaultEnum,
 
     -- * Internal
+    mergeRouteEncoder,
     checkRouteEncoderForSingleRoute,
   )
 where
@@ -42,6 +43,25 @@ decodeRoute (_, f, _) = f
 allRoutes :: RouteEncoder model r -> model -> [r]
 allRoutes (_, _, f) = f
 
+-- | Returns a new route encoder that supports either of the input routes.
+mergeRouteEncoder :: RouteEncoder a r1 -> RouteEncoder b r2 -> RouteEncoder (a, b) (Either r1 r2)
+mergeRouteEncoder enc1 enc2 =
+  ( \m ->
+      either
+        (encodeRoute enc1 (fst m))
+        (encodeRoute enc2 (snd m)),
+    \m fp ->
+      asum
+        [ Left <$> decodeRoute enc1 (fst m) fp,
+          Right <$> decodeRoute enc2 (snd m) fp
+        ],
+    \m ->
+      mconcat
+        [ Left <$> allRoutes enc1 (fst m),
+          Right <$> allRoutes enc2 (snd m)
+        ]
+  )
+
 -- TODO: Determine this generically somehow
 -- See https://github.com/srid/ema/issues/76
 defaultEnum :: (Bounded r, Enum r) => [r]

src/Ema/Site.hs

@@ -29,6 +29,7 @@ import Ema.Route
     allRoutes,
     decodeRoute,
     encodeRoute,
+    mergeRouteEncoder,
   )
 import System.FilePath ((</>))
 import Text.Show (Show (show))
@@ -97,27 +98,17 @@ constModal x _ startModel = do
 (+:) = mergeSite
 
 -- | Merge two sites to produce a single site.
--- TODO: Avoid unnecessary updates site1 webpage when only site2 changes (eg:
+-- TODO: Avoid unnecessary updates on site1 webpage when only site2 changes (eg:
 -- basic shouldn't refresh when clock changes)
 mergeSite :: forall r1 r2 a1 a2. Site a1 r1 -> Site a2 r2 -> Site (a1, a2) (Either r1 r2)
 mergeSite site1 site2 =
   Site name render patch enc
   where
     name = siteName site1 <> "+" <> siteName site2
+    enc = mergeRouteEncoder (siteRouteEncoder site1) (siteRouteEncoder site2)
     render cliAct _ x = \case
       Left r -> siteRender site1 cliAct (siteRouteEncoder site1) (fst x) r
       Right r -> siteRender site2 cliAct (siteRouteEncoder site2) (snd x) r
-    enc =
-      ( \(a, b) -> \case
-          Left r -> encodeRoute (siteRouteEncoder site1) a r
-          Right r -> encodeRoute (siteRouteEncoder site2) b r,
-        \(a, b) fp ->
-          fmap Left (decodeRoute (siteRouteEncoder site1) a fp)
-            <|> fmap Right (decodeRoute (siteRouteEncoder site2) b fp),
-        \(a, b) ->
-          fmap Left (allRoutes (siteRouteEncoder site1) a)
-            <> fmap Right (allRoutes (siteRouteEncoder site2) b)
-      )
     patch ::
       forall m b.
       (MonadIO m, MonadUnliftIO m, MonadLoggerIO m) =>