Generic instance for CanGenerate

.github/workflows/ci.yaml

@@ -9,7 +9,7 @@ jobs:
       MAINLINE: refs/heads/master
     steps:
       - uses: actions/checkout@v2
-      - uses: cachix/install-nix-action@v13
+      - uses: cachix/install-nix-action@v16
         with:
           install_url: https://nixos-nix-install-tests.cachix.org/serve/i6laym9jw3wg9mw6ncyrk6gjx4l34vvx/install
           install_options: "--tarball-url-prefix https://nixos-nix-install-tests.cachix.org/serve"

src/Ema/Asset.hs

@@ -8,12 +8,26 @@ module Ema.Asset (
   CanGenerate (..),
 ) where
 
-import Ema.Route.Class (IsRoute (RouteModel))
+import Data.SOP.NP
+import Data.SOP.NS
+import Data.Set qualified as Set
+import Ema.Route.Class (
+  Contains (npIso),
+  GRouteModel,
+  IsRoute (RouteModel),
+  IsRouteIn,
+  IsRouteProd,
+  NPConst (npConstFrom),
+  SingleModelRoute (SingleModelRoute),
+ )
 import Ema.Route.Encoder (
   RouteEncoder,
   leftRouteEncoder,
   rightRouteEncoder,
  )
+import Generics.SOP hiding (Generic)
+import Optics.Core (view)
+import Prelude hiding (All)
 
 -- | The type of assets that can be bundled in a static site.
 data Asset a
@@ -37,8 +51,72 @@ class IsRoute r => CanRender r where
 -- | Class of routes to statically generate.
 class IsRoute r => CanGenerate r where
   generatableRoutes :: RouteModel r -> [r]
-  default generatableRoutes :: (Enum r, Bounded r) => RouteModel r -> [r]
-  generatableRoutes _ = [minBound .. maxBound]
+  default generatableRoutes ::
+    ( IsRoute r
+    , All2 CanGenerate (Code r)
+    , All2 IsRoute (Code r)
+    , All2 (IsGeneratableProd ms) (Code r)
+    , HasDatatypeInfo r
+    , ms ~ GRouteModel (Code r)
+    , All (IsRouteProd ms) (Code r)
+    , RouteModel r ~ NP I ms
+    , Ord r
+    ) =>
+    RouteModel r ->
+    [r]
+  generatableRoutes = gGeneratableRoutes
+
+instance
+  ( NPConst I (GRouteModel (Code r)) m
+  , HasDatatypeInfo r
+  , All2 CanGenerate (Code r)
+  , All2 IsRoute (Code r)
+  , All2 (IsGeneratableProd ms) (Code r)
+  , ms ~ GRouteModel (Code r)
+  , All (IsRouteProd ms) (Code r)
+  , IsRoute r
+  , Ord r
+  ) =>
+  CanGenerate (SingleModelRoute m r)
+  where
+  generatableRoutes m =
+    SingleModelRoute <$> gGeneratableRoutes @r (npConstFrom . I $ m)
+
+class (IsRouteIn ms r, CanGenerate r) => IsGeneratableProd ms r
+instance (IsRouteIn ms r, CanGenerate r) => IsGeneratableProd ms r
+
+gGeneratableRoutes ::
+  forall r ms.
+  ( IsRoute r
+  , All2 CanGenerate (Code r)
+  , All2 IsRoute (Code r)
+  , All2 (IsGeneratableProd ms) (Code r)
+  , HasDatatypeInfo r
+  , ms ~ GRouteModel (Code r)
+  , All (IsRouteProd ms) (Code r)
+  , Ord r
+  ) =>
+  NP I ms ->
+  [r]
+gGeneratableRoutes m =
+  let pop =
+        cpure_POP
+          (Proxy @(IsGeneratableProd ms))
+          insideRoutes
+      -- FIXME: Can we use traverse due to Applicative instance list.
+      pops =
+        hcfor
+          (Proxy @IsRoute)
+          pop
+          id
+      -- Workaround duplicates routes frmo the FIXME above.
+      removeDups = Set.toList . Set.fromList
+   in removeDups $ to <$> concatMap apInjs_POP pops
+  where
+    insideRoutes :: forall b. (IsGeneratableProd ms b) => [b]
+    insideRoutes =
+      let m' = view (npIso @_ @(RouteModel b)) m
+       in generatableRoutes m'
 
 -- Combining of two routes
 instance

src/Ema/Example/Ex01_Basic.hs

@@ -14,7 +14,7 @@ import Text.Blaze.Html5.Attributes qualified as A
 data Route
   = Route_Index
   | Route_About
-  deriving stock (Show, Eq, Generic, Enum, Bounded)
+  deriving stock (Show, Eq, Ord, Generic, Enum, Bounded)
   deriving anyclass
     ( SOP.Generic
     , SOP.HasDatatypeInfo

src/Ema/Example/Ex02_Store.hs

@@ -27,9 +27,10 @@ data Route
   | Route_About
   | Route_Products ProductRoute
   | Route_Category CategoryRoute
-  deriving stock (Show, Eq, Generic)
+  deriving stock (Show, Eq, Ord, Generic)
   deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo)
   deriving (IsRoute) via (SingleModelRoute Model Route)
+  deriving (CanGenerate) via (SingleModelRoute Model Route)
 
 instance HasModel Route where
   modelDynamic _ _ _ = do
@@ -39,19 +40,21 @@ instance HasModel Route where
 data ProductRoute
   = ProductRoute_Index
   | ProductRoute_Product ProductName
-  deriving stock (Show, Eq, Generic)
+  deriving stock (Show, Eq, Ord, Generic)
   deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo)
   deriving (IsRoute) via (SingleModelRoute Model ProductRoute)
+  deriving (CanGenerate) via (SingleModelRoute Model ProductRoute)
 
 data CategoryRoute
   = CategoryRoute_Index
   | CategoryRoute_Category CategoryName
-  deriving stock (Show, Eq, Generic)
+  deriving stock (Show, Eq, Ord, Generic)
   deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo)
   deriving (IsRoute) via (SingleModelRoute Model CategoryRoute)
+  deriving (CanGenerate) via (SingleModelRoute Model CategoryRoute)
 
 newtype ProductName = ProductName Text
-  deriving stock (Show, Eq)
+  deriving stock (Show, Eq, Ord)
   deriving newtype (IsString, ToString)
 
 instance IsRoute ProductName where
@@ -64,7 +67,7 @@ instance CanGenerate ProductName where
   generatableRoutes m = ProductName <$> modelProducts m
 
 newtype CategoryName = CategoryName Text
-  deriving stock (Show, Eq)
+  deriving stock (Show, Eq, Ord)
   deriving newtype (IsString, ToString)
 
 instance IsRoute CategoryName where
@@ -89,21 +92,6 @@ instance IsRoute CategoryName where
 instance CanGenerate CategoryName where
   generatableRoutes m = CategoryName <$> modelCategories m
 
--- TODO: Generic!
-instance CanGenerate ProductRoute where
-  generatableRoutes m =
-    [ProductRoute_Index] <> (ProductRoute_Product <$> generatableRoutes m)
-
-instance CanGenerate CategoryRoute where
-  generatableRoutes m =
-    [CategoryRoute_Index] <> (CategoryRoute_Category <$> generatableRoutes m)
-
-instance CanGenerate Route where
-  generatableRoutes m =
-    [Route_Index, Route_About]
-      <> (Route_Products <$> generatableRoutes m)
-      <> (Route_Category <$> generatableRoutes m)
-
 main :: IO ()
 main = void $ Ema.runSite @Route ()
 

src/Ema/Example/Ex03_Clock.hs

@@ -30,9 +30,10 @@ type Model = UTCTime
 data Route
   = Route_Index
   | Route_OnlyTime
-  deriving stock (Show, Eq, Generic, Enum, Bounded)
-  deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo, CanGenerate)
+  deriving stock (Show, Eq, Ord, Generic, Enum, Bounded)
+  deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo)
   deriving (IsRoute) via (SingleModelRoute Model Route)
+  deriving (CanGenerate) via (SingleModelRoute Model Route)
 
 instance HasModel Route where
   modelDynamic _ _ () = do

src/Ema/Route/Class.hs

@@ -13,6 +13,13 @@ module Ema.Route.Class (
   -- * Sub routes
   innerRouteEncoder,
   innerModel,
+
+  -- * Generic helpers
+  IsRouteProd,
+  IsRouteIn,
+  GRouteModel,
+  Contains (npIso),
+  NPConst (npConstFrom),
 ) where
 
 import Data.List ((!!))