diff --git a/ebook-manager.cabal b/ebook-manager.cabal index c29f0f3..e4bea20 100644 --- a/ebook-manager.cabal +++ b/ebook-manager.cabal @@ -27,6 +27,7 @@ executable ebook-manager , Server , Server.Auth , Types + , View -- other-extensions: build-depends: base >=4.10 && <4.11 , servant diff --git a/src/API.hs b/src/API.hs index dbe61e1..d21c7b1 100644 --- a/src/API.hs +++ b/src/API.hs @@ -12,40 +12,27 @@ module API (API, handler) where -import ClassyPrelude hiding (Handler, Index) import Servant import Servant.HTML.Lucid (HTML) -import Lucid (HtmlT, ToHtml(..)) -import qualified Lucid.Html5 as H import Types +import View + import qualified API.Users as Users data Index = Index -bulma :: Monad m => HtmlT m () -bulma = H.doctypehtml_ $ do - H.meta_ [ H.name_ "viewport", H.content_ "width=device-width, initial-scale=1" ] - H.meta_ [ H.charset_ "utf-8" ] - H.title_ "Hello bulma!" - H.link_ [ H.rel_ "stylesheet", H.href_ "/static/css/bulma.min.css" ] - H.script_ [ H.defer_ "", H.src_ "https://use.fontawesome.com/releases/v5.1.0/js/all.js" ] ("" :: String) - H.body_ $ do - H.section_ [ H.class_ "section" ] $ do - H.div_ [ H.class_ "container" ] $ do - H.h1_ [ H.class_ "title" ] "Hello world" - H.p_ [ H.class_ "subtitle" ] "My first website with bulma" - -instance ToHtml Index where - toHtml _ = bulma - toHtmlRaw = toHtml - -type API = Get '[HTML] Index +type API = Get '[HTML] (AppView Index) :<|> Users.API handler :: ServerT API AppM handler = indexHandler :<|> Users.handler -indexHandler :: AppM Index -indexHandler = do - return Index +instance ToHtml Index where + toHtml _ = do + h1_ [class_ "title"] "Home page" + p_ [class_ "subtitle"] "Hello world" + toHtmlRaw = toHtml + +indexHandler :: AppM (AppView Index) +indexHandler = mkView "Home" Index diff --git a/src/View.hs b/src/View.hs new file mode 100644 index 0000000..66212d3 --- /dev/null +++ b/src/View.hs @@ -0,0 +1,46 @@ +{-# Language NoImplicitPrelude #-} +module View + ( AppView + , mkView + , ToHtml(..) + , module H ) + where + +import ClassyPrelude +import Server.Auth +import Servant.Auth.Server +import Lucid (HtmlT, ToHtml(..)) +import Lucid.Html5 as H + +-- Idea from stackbuilders +-- The idea hasn't been fleshed out 100% yet, but basically for every html view +-- have the endpoint return an @AppView@. Might work with status codes as well +-- +-- Collect the metadata to the data type and try to manage it automatically +data AppView view = AppView { content :: view + , title :: Text + , user :: AuthResult SafeUser + } deriving (Generic, Show) + +instance (ToHtml view) => ToHtml (AppView view) where + toHtml v = bulma v + toHtmlRaw = toHtml + +-- Not sure if the monad constraint is needed. Maybe in the future? +mkView :: (Monad m, ToHtml view) => Text -> view -> m (AppView view) +mkView title content = mkAuthView title content Indefinite + +mkAuthView :: (Monad m, ToHtml view) => Text -> view -> AuthResult SafeUser -> m (AppView view) +mkAuthView title content user = pure AppView{..} + +bulma :: (Monad m, ToHtml view) => AppView view -> HtmlT m () +bulma AppView{..} = H.doctypehtml_ $ do + H.meta_ [ H.name_ "viewport", H.content_ "width=device-width, initial-scale=1" ] + H.meta_ [ H.charset_ "utf-8" ] + H.title_ "Hello bulma!" + H.link_ [ H.rel_ "stylesheet", H.href_ "/static/css/bulma.min.css" ] + H.title_ (toHtml title) + H.script_ [ H.defer_ "", H.src_ "https://use.fontawesome.com/releases/v5.1.0/js/all.js" ] ("" :: String) + H.body_ $ do + H.section_ [ H.class_ "section" ] $ do + H.div_ [ H.class_ "container" ] $ toHtml content