From fa110aee28474835b0b84f2b348fec8553d965dd Mon Sep 17 00:00:00 2001
From: Ben Sima <ben@bsima.me>
Date: Sat, 19 Oct 2019 22:46:54 -0700
Subject: [ibb] initial stylesheet

---
 apex/Ibb.hs | 29 ++++++++++++++++++++++++++++-
 1 file changed, 28 insertions(+), 1 deletion(-)

(limited to 'apex')

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
-- 
cgit v1.2.3