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
, Server.Auth , Server.Auth
, Types , Types
, View
-- other-extensions: -- other-extensions:
build-depends: base >=4.10 && <4.11 build-depends: base >=4.10 && <4.11
, servant , servant

View File

@ -12,40 +12,27 @@
module API (API, handler) where module API (API, handler) where
import ClassyPrelude hiding (Handler, Index)
import Servant import Servant
import Servant.HTML.Lucid (HTML) import Servant.HTML.Lucid (HTML)
import Lucid (HtmlT, ToHtml(..))
import qualified Lucid.Html5 as H
import Types import Types
import View
import qualified API.Users as Users import qualified API.Users as Users
data Index = Index data Index = Index
bulma :: Monad m => HtmlT m () type API = Get '[HTML] (AppView Index)
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
:<|> Users.API :<|> Users.API
handler :: ServerT API AppM handler :: ServerT API AppM
handler = indexHandler :<|> Users.handler handler = indexHandler :<|> Users.handler
indexHandler :: AppM Index instance ToHtml Index where
indexHandler = do toHtml _ = do
return Index 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