{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE NoMonomorphismRestriction #-} {-# OPTIONS_GHC -Wno-missing-signatures #-} module Examples.Ex04 where import Control.Monad.Classes qualified as MC -- import Control.Reactive import Data.Map.Strict as Map import Literate.Web import Relude router = "post" capturePathSegment @PostName "post" <.> response @Post @'[PlainText] <+> "page" capturePathSegment @PageName "page" <.> response @Page @'[PlainText] <+> pathSegment "lorem" -- content :: -- ( PostName -> (a :~: a, Post) -- , PageName -> (a :~: a, Page) ) -- content :: -- MC.MonadReader Model m => -- endpoint ~ m Text => -- Sym.ToF -- (Either (PostName, Sym.Endpoint endpoint (m Post)) -- (PageName, Sym.Endpoint endpoint (m Page))) -- endpoint content = contentPost :!: contentPage :!: contentOther where contentPost n = contentEndpoint do Model{..} <- MC.ask return $ modelPosts Map.! n contentPage = contentEndpoint . \case CapturedExtra (Left (_n, p)) -> do return p CapturedExtra (Right n) -> do Model{..} <- MC.ask return $ modelPages Map.! n contentOther = return "ipsum" -- c0 = compile CompilerEnv{} router content instance MimeEncodable Post PlainText where mimeEncode (Post t) = mimeEncode @_ @PlainText t instance MimeEncodable Page PlainText where mimeEncode (Page t) = mimeEncode @_ @PlainText t instance (MC.MonadReader Model m) => Capturable PostName (Compiler m) where capturePathSegment _n = Compiler do model <- MC.ask return [ Output{outputPath = [unPostName name], outputExts = [], outputData = ($ name)} | name <- Map.keys (modelPosts model) ] instance (MC.MonadReader Model m) => Capturable PageName (Compiler m) where -- Keep the 'Page' to avoid looking it up in 'contentPage'. type Captured PageName (Compiler m) = CapturedExtra PageName Page capturePathSegment _n = Compiler do model <- MC.ask return [ Output { outputPath = [unPageName name] , outputExts = [] , outputData = ($ CapturedExtra (Left (name, page))) } | (name, page) <- Map.toList (modelPages model) ] {- data Rodel m = Rodel { rodelPosts :: RW m (Map PostName (RW m Post)) , rodelPages :: RW m (Map PageName (RW m Page)) } -} -- * Type 'Model' data Model = Model { modelPosts :: Map PostName Post , modelPages :: Map PageName Page } model1 = Model { modelPosts = Map.fromList [ (PostName "post1", Post "post-model-1") , (PostName "post2", Post "post-model-2") ] , modelPages = Map.fromList [ (PageName "page1", Page "page-model-1") , (PageName "page2", Page "page-model-2") ] } -- ** Type 'PostName' data PostName = PostName {unPostName :: PathSegment} deriving (Show, Eq, Ord) -- ** Type 'PageName' data PageName = PageName {unPageName :: PathSegment} deriving (Show, Eq, Ord) -- ** Type 'Post' data Post = Post {unPost :: Text} deriving (Show) -- ** Type 'Page' data Page = Page {unPage :: Text} deriving (Show)