summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBen Sima <ben@bsima.me>2019-10-19 22:46:54 -0700
committerBen Sima <ben@bsima.me>2019-10-19 22:46:54 -0700
commitfa110aee28474835b0b84f2b348fec8553d965dd (patch)
tree97e732de5851f9fb5168706673e2db4754232ee9
parentaa0cd5e980faf1cb0b33105f86f32a8aa64f53f4 (diff)
[ibb] initial stylesheet
-rw-r--r--apex/Ibb.hs29
-rw-r--r--lore/Biz/Ibb/Look.hs27
2 files changed, 55 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
diff --git a/lore/Biz/Ibb/Look.hs b/lore/Biz/Ibb/Look.hs
new file mode 100644
index 0000000..9017ba2
--- /dev/null
+++ b/lore/Biz/Ibb/Look.hs
@@ -0,0 +1,27 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-- | The look and feel of Ibb
+module Biz.Ibb.Look where
+
+import Alpha
+import Clay
+import qualified Clay.Stylesheet as Stylesheet
+import qualified Clay.Render as Clay
+import qualified Clay.Flexbox as Flexbox
+import qualified Clay.Media as Media
+
+main :: Css
+main = do
+ "html" <> "body" ? do
+ width (pc 100)
+ display flex
+ flexDirection column
+ alignItems center
+ alignContent center
+ justifyContent center
+ ".container" ? do
+ width (px 900)
+ display flex
+ justifyContent center
+ flexDirection column