Added some styling.

diff --git a/src/CssContentType.hs b/src/CssContentType.hs
index 593d285..92018d8 100644 (file)
--- a/src/CssContentType.hs
+++ b/src/CssContentType.hs
@@ -1,14 +1,14 @@
 module CssContentType where
 
-import Data.Text.Lazy (pack)
 import Data.Text.Lazy.Encoding (encodeUtf8)
 import Network.HTTP.Media ((//), (/:))
 import Servant
+import qualified Clay as C
 
 data CSS
 
 instance Accept CSS where
   contentType _ = "text" // "css" /: ("charset", "utf-8")
 
-instance (Show a) => MimeRender CSS a where
-  mimeRender _ val = encodeUtf8 $ pack $ show val
+instance MimeRender CSS (C.Css) where
+  mimeRender _ val = encodeUtf8 $ C.render val

diff --git a/src/Server.hs b/src/Server.hs
index f215c4b..220d141 100644 (file)
--- a/src/Server.hs
+++ b/src/Server.hs
@@ -7,7 +7,9 @@ import Lucid
 import RenderBlog (renderBlog)
 import Servant
 import Servant.HTML.Lucid (HTML(..))
+import StyleSheet
 import System.Directory (getCurrentDirectory, getDirectoryContents)
+import qualified Clay as C
 import qualified Data.Text as T
 import qualified Data.Text.IO as T
 
@@ -21,8 +23,8 @@ type Api = MainPage :<|> BlogPost :<|> Themes :<|> TestPage
 type MainPage = Get '[HTML] (Html ())
 type BlogPost = "blog" :> Capture "id" BlogId :> Get '[HTML] (Html ())
 type Themes = DarkTheme :<|> LightTheme
-type DarkTheme = "dark" :> Get '[CSS] T.Text
-type LightTheme = "light" :> Get '[CSS] T.Text
+type DarkTheme = "dark" :> Get '[CSS] C.Css
+type LightTheme = "light" :> Get '[CSS] C.Css
 type TestPage = "test" :> Get '[HTML] T.Text
 
 type BlogId = FilePath
@@ -43,12 +45,12 @@ themes :: Server Themes
 themes = darkTheme :<|> lightTheme
 
 -- TODO Modify this endpoint to take in a single hex colour value and produce a stylesheet from it.
-darkTheme :: Handler T.Text
-darkTheme = pure mempty
+darkTheme :: Handler C.Css
+darkTheme = pure $ darkStyle C.saddlebrown
 
 -- TODO Modify this endpoint to take in a single hex colour value and produce a stylesheet from it. The strategy used here should be the inverse of the one used by the dark path.
-lightTheme :: Handler T.Text
-lightTheme = pure mempty
+lightTheme :: Handler C.Css
+lightTheme = pure $ lightStyle C.saddlebrown
 
 htmlContainer :: Html a -> Handler (Html ())
 htmlContainer contents = do

diff --git a/src/StyleSheet.hs b/src/StyleSheet.hs
new file mode 100644 (file)
index 0000000..074e996
--- /dev/null
+++ b/src/StyleSheet.hs
@@ -0,0 +1,20 @@
+module StyleSheet where
+
+import Clay
+
+type ColorAction = Float -> Color -> Color
+
+darkStyle :: Color -> Css
+darkStyle = makeStyle lighten
+
+lightStyle :: Color -> Css
+lightStyle = makeStyle darken
+
+makeStyle :: ColorAction -> Color -> Css
+makeStyle colorAction themeColor = do
+  bodyStyle colorAction themeColor
+
+bodyStyle :: ColorAction -> Color -> Css
+bodyStyle action themeColor = body ? do
+  backgroundColor themeColor
+  fontColor $ action 0.75 themeColor