From c55157beed254db889b00f82a7ede45d87a7d9b7 Mon Sep 17 00:00:00 2001
From: "Yann Esposito (Yogsototh)" <yann.esposito@gmail.com>
Date: Sat, 15 Dec 2018 00:09:06 +0100
Subject: [PATCH] css

---
 aggreact.cabal           |  8 ++++++--
 package.yaml             |  4 +++-
 src/Aggreact.hs          |  5 +++++
 src/Aggreact/Comments.hs |  3 ++-
 src/Aggreact/Css.hs      | 12 ++++++++++++
 src/Servant/Clay.hs      | 22 ++++++++++++++++++++++
 6 files changed, 50 insertions(+), 4 deletions(-)
 create mode 100644 src/Aggreact/Css.hs
 create mode 100644 src/Servant/Clay.hs

diff --git a/aggreact.cabal b/aggreact.cabal
index f2e2f22..02a6ef9 100644
--- a/aggreact.cabal
+++ b/aggreact.cabal
@@ -2,7 +2,7 @@
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: a75b559a48622ecf2f5c1828cceaaca1e22b3e02dd220be74a7c3ec81fb1b60b
+-- hash: d11aa404572bc87a8da8ab8884a2b01443beea6ede73072538bcbe8a4f42ca1b
 
 name:           aggreact
 version:        0.1.0.0
@@ -29,6 +29,8 @@ library
   exposed-modules:
       Aggreact
       Aggreact.Comments
+      Aggreact.Css
+      Servant.Clay
   other-modules:
       Paths_aggreact
   hs-source-dirs:
@@ -43,8 +45,10 @@ library
     , cereal
     , cereal-text
     , cereal-time
+    , clay
     , containers
     , http-api-data
+    , http-media
     , human-readable-duration
     , ixset
     , protolude
@@ -66,7 +70,7 @@ executable aggreact
   hs-source-dirs:
       src-exe
   default-extensions: OverloadedStrings NoImplicitPrelude ScopedTypeVariables
-  ghc-options: -Wall -Wcompat -Wincomplete-uni-patterns -Wredundant-constraints -Wnoncanonical-monad-instances -Werror -O2 -optP-Wno-nonportable-include-path -threaded -rtsopts -with-rtsopts="-N -I0"
+  ghc-options: -Wall -Wcompat -Wincomplete-uni-patterns -Wredundant-constraints -Wnoncanonical-monad-instances -Werror -O2 -optP-Wno-nonportable-include-path -threaded -rtsopts -with-rtsopts=-N -I0
   build-depends:
       aggreact
     , base >=4.8 && <5
diff --git a/package.yaml b/package.yaml
index 4091032..563bc7d 100644
--- a/package.yaml
+++ b/package.yaml
@@ -33,8 +33,10 @@ library:
   - cereal
   - cereal-text
   - cereal-time
+  - clay
   - containers
   - http-api-data
+  - http-media
   - human-readable-duration
   - ixset
   - safecopy
@@ -54,7 +56,7 @@ executables:
     - -optP-Wno-nonportable-include-path
     - -threaded
     - -rtsopts
-    - -with-rtsopts="-N -I0"
+    - "-with-rtsopts=-N -I0"
     dependencies:
     - aggreact
 tests:
diff --git a/src/Aggreact.hs b/src/Aggreact.hs
index f2c99d4..ff29d96 100644
--- a/src/Aggreact.hs
+++ b/src/Aggreact.hs
@@ -26,16 +26,20 @@ module Aggreact
 import           Protolude
 
 import           Aggreact.Comments
+import           Aggreact.Css             (genCss)
 
+import           Clay                     (Css)
 import           Data.Time                (getCurrentTime)
 import           Network.Wai              (Application)
 import qualified Network.Wai.Handler.Warp as Warp
 import           Servant
+import           Servant.Clay
 import           Servant.HTML.Blaze
 
 type CommentAPI =
   "comments" :> Capture "slug" Text :> Get '[HTML,JSON] CommentPage
   :<|> "slugs" :> Get '[JSON] [Slug]
+  :<|> "main.css" :> Get '[CSS] Css
   :<|> "comments" :> ReqBody '[JSON, FormUrlEncoded] NewComment :> Post '[JSON] Comment
 
 data Conf = Conf { port :: Int }
@@ -55,6 +59,7 @@ api = Proxy
 server :: DB Comments -> Server CommentAPI
 server db = showComments db
             :<|> listSlugs db
+            :<|> return genCss
             :<|> liftIO . createNewComment db
 
 app :: DB Comments -> Application
diff --git a/src/Aggreact/Comments.hs b/src/Aggreact/Comments.hs
index 956dd72..cf01063 100644
--- a/src/Aggreact/Comments.hs
+++ b/src/Aggreact/Comments.hs
@@ -256,8 +256,9 @@ getCommentsByParentId db s = Acid.query db (CommentsByParentId s)
 boilerplate :: Text -> H.Markup -> H.Html
 boilerplate url innerHtml =
   H.html $ do
-    H.head $
+    H.head $ do
       H.title (H.text "Aggreact")
+      H.link H.! A.rel "stylesheet" H.! A.type_ "text/css" H.! A.href "/main.css"
     H.body $ do
       H.h1 $ do
         H.text "Aggreact: "
diff --git a/src/Aggreact/Css.hs b/src/Aggreact/Css.hs
new file mode 100644
index 0000000..6089fa5
--- /dev/null
+++ b/src/Aggreact/Css.hs
@@ -0,0 +1,12 @@
+module Aggreact.Css where
+
+import Clay
+
+genCss :: Css
+genCss =
+  body ? do
+    fontFamily ["Menlo"] [monospace]
+    fontSize (px 14)
+    maxWidth (px 800)
+    lineHeight (em 1.5)
+    margin (px 0) auto (px 0) auto
diff --git a/src/Servant/Clay.hs b/src/Servant/Clay.hs
new file mode 100644
index 0000000..35e9d87
--- /dev/null
+++ b/src/Servant/Clay.hs
@@ -0,0 +1,22 @@
+{-# LANGUAGE DeriveDataTypeable    #-}
+{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeSynonymInstances  #-}
+
+module Servant.Clay where
+
+import Protolude hiding (encodeUtf8)
+
+import           Clay                    (Css, compact, renderWith)
+import           Data.Text.Lazy.Encoding (encodeUtf8)
+import           Data.Typeable           (Typeable)
+import qualified Network.HTTP.Media      as M
+import           Servant.API             (Accept (..), MimeRender (..))
+
+data CSS deriving Typeable
+
+instance Accept CSS where
+  contentType _ = "test" M.// "css" M./: ("charset","utf-8")
+
+instance MimeRender CSS Css where
+  mimeRender _ = encodeUtf8 . renderWith compact []