Refactor views

This commit is contained in:
Mats Rauhala 2018-08-05 00:14:30 +03:00
parent bcc702b95c
commit 8ff50d21ed
3 changed files with 58 additions and 24 deletions

View File

@ -27,6 +27,7 @@ executable ebook-manager
, Server
, Server.Auth
, Types
, View
-- other-extensions:
build-depends: base >=4.10 && <4.11
, servant

View File

@ -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

46
src/View.hs Normal file
View File

@ -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