diff options
Diffstat (limited to 'apex')
| -rw-r--r-- | apex/Ibb.hs | 29 |
1 files changed, 28 insertions, 1 deletions
diff --git a/apex/Ibb.hs b/apex/Ibb.hs index e843987..00fa349 100644 --- a/apex/Ibb.hs +++ b/apex/Ibb.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} @@ -12,6 +13,10 @@ module Ibb where import Alpha import Biz.Ibb import qualified Biz.Ibb.Keep as Keep +import qualified Biz.Ibb.Look as Look +import qualified Clay +import qualified Data.Text.Lazy as Lazy +import qualified Data.Text.Lazy.Encoding as Lazy import Data.Maybe (fromMaybe) import Data.Acid (AcidState) import qualified Data.Acid.Abstract as Acid @@ -19,6 +24,7 @@ import GitHash (giHash, tGitInfoCwd) import qualified Lucid as L import Lucid.Base import Miso +import Network.HTTP.Media ((//), (/:)) import Network.HTTP.Types import Network.RemoteData import Network.Wai @@ -51,6 +57,7 @@ instance L.ToHtml a => L.ToHtml (HtmlPage a) where L.head_ $ do L.meta_ [L.charset_ "utf-8"] jsRef "/static/all.js" + cssRef "/css/main.css" L.body_ $ do page L.p_ gitCommit @@ -63,6 +70,9 @@ instance L.ToHtml a => L.ToHtml (HtmlPage a) where , makeAttribute "async" mempty , makeAttribute "defer" mempty ] + cssRef href = L.with + (L.link_ mempty) + [L.rel_ "stylesheet", L.type_ "text/css", L.href_ href] type ServerRoutes = ToServerRoutes AppRoutes HtmlPage Action @@ -74,15 +84,32 @@ handle404 _ respond = respond $ HtmlPage $ notfound -type Routes = "static" :> Raw +newtype CSS = CSS { unCSS :: Text } + +instance MimeRender CSS Text where + mimeRender _ = Lazy.encodeUtf8 . Lazy.fromStrict + +instance Accept CSS where + contentType _ = "text" // "css" /: ("charset", "utf-8") + +type CssRoute = "css" :> "main.css" :> Get '[CSS] Text + +type Routes + = "static" :> Raw + :<|> CssRoute :<|> ServerRoutes :<|> "api" :> ApiRoutes :<|> Raw +cssHandlers :: Server CssRoute +cssHandlers = return . Lazy.toStrict . Clay.render + $ Look.main + app :: AcidState Keep.IbbKeep -> Application app keep = serve (Proxy @Routes) $ static + :<|> cssHandlers :<|> serverHandlers :<|> apiHandlers keep :<|> Tagged handle404 |