Refactor views

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

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