1 {-# LANGUAGE DeriveGeneric #-}
3 {-# LANGUAGE UndecidableInstances #-}
4 {-# LANGUAGE NoMonomorphismRestriction #-}
5 {-# OPTIONS_GHC -Wno-missing-signatures #-}
7 module Examples.Ex03 where
9 import Control.Monad (Monad (..))
10 import Control.Monad.Classes qualified as MC
12 import Data.Function (($), (.))
13 import Data.Maybe (Maybe (..), maybe)
16 import Data.Set qualified as Set
17 import Data.String (IsString (..))
18 import GHC.Generics (Generic)
19 import Text.Show (Show (..))
23 -- | 'dataType' can be used at any point where
24 -- the Tuples-of-Functions are no longer wanted.
27 <+> pathSegment "feed"
28 <+> "filter" </> (dataType @(Maybe Lang) $ pathSegment "all" <+> infer) <.> optional (capturePathSegment @Tag "tag")
33 -- (Either () (Either () (Maybe Lang, Maybe Tag)))
40 contentStatic = return "STATIC"
41 contentFeed = return "FEED"
42 contentFilter filterLang filterTag =
46 Nothing -> maybe "ALL-LANG-ALL-TAGS" show filterTag
47 Just lang -> case filterTag of
49 Just tag -> show (lang, tag)
55 deriving (Eq, Show, Generic)
57 routeLang = dataType @Lang $ pathSegment "en" <+> pathSegment "fr"
59 -- | Using 'Inferable' has the downside of requiring
60 -- to explicit manually the symantices required.
61 instance (SumFunctor sem, PathSegmentable sem, Dataable sem) => Inferable Lang sem where
65 newtype Tag = Tag {unTag :: PathSegment} deriving (Eq, Ord, Show)
66 instance IsString Tag where
67 fromString = Tag . fromString
69 -- | Capturing a 'Tag' makes no sense when compiling a static site.
70 -- Hence the 'Compiler' semantic for 'Capturable'
71 -- requires a readable 'Model' somewhere in the monad stack
72 -- in order to generate all 'Tag's folders.
73 instance MC.MonadReader Model m => Capturable Tag (Compiler m) where
74 capturePathSegment _n =
78 [ Output{outputPath = [unTag tag], outputExts = [], outputData = tag}
79 | tag <- Set.toList (modelTags model)
84 { modelTags :: Set Tag
87 model1 = Model{modelTags = Set.fromList []}
88 model2 = Model{modelTags = Set.fromList ["cat1", "cat2", "cat3"]}