Refactor views
This commit is contained in:
parent
bcc702b95c
commit
8ff50d21ed
@ -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
|
||||||
|
35
src/API.hs
35
src/API.hs
@ -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
46
src/View.hs
Normal 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
|
Loading…
Reference in New Issue
Block a user