From 846bbe8eef3e472fd7a85d1351fac99f2b29d6d1 Mon Sep 17 00:00:00 2001
From: Christine Dodrill <xena@yolo-swag.com>
Date: Tue, 28 Jul 2015 08:38:30 -0700
Subject: [PATCH] render posts and users

---
 web/src/Main.hs                               | 11 +++++++-
 web/src/Within/DBMemorial/Post.hs             | 10 ++++++++
 web/src/Within/DBMemorial/User.hs             | 10 ++++++++
 web/src/Within/DBMemorial/Utils.hs            |  5 ++++
 .../Within/DBMemorial/Views/Materialize.hs    | 25 +++++++++++++++++++
 5 files changed, 60 insertions(+), 1 deletion(-)
 create mode 100644 web/src/Within/DBMemorial/Utils.hs
 create mode 100644 web/src/Within/DBMemorial/Views/Materialize.hs

diff --git a/web/src/Main.hs b/web/src/Main.hs
index 881d0a9..cbe331f 100644
--- a/web/src/Main.hs
+++ b/web/src/Main.hs
@@ -1,11 +1,16 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Main where
 
+import           Data.Text.Lazy                       (toStrict)
 import qualified Database.SQLite.Simple               as Db
 import qualified Network.Wai.Middleware.RequestLogger as RequestLogger
 import qualified Network.Wai.Middleware.Static        as Static
+import           Text.Blaze.Html.Renderer.Text
+import           Web.Spock.Safe                       ((<//>))
 import qualified Web.Spock.Safe                       as S hiding (head)
 import qualified Within.DBMemorial.Post               as Post
+import qualified Within.DBMemorial.User               as User
+import qualified Within.DBMemorial.Views.Materialize  as Materialize
 
 main :: IO ()
 main = do
@@ -20,4 +25,8 @@ main = do
          S.middleware $ Static.staticPolicy $ Static.addBase "public"
          S.middleware $ RequestLogger.logStdout
          S.get S.root $
-           S.text $ Post.body h
+           S.html $ toStrict (renderHtml (Materialize.base "The OP" (Post.render h)))
+         {-S.get ("users" <//> S.var) $ \id ->
+           S.text renderHtml $ User.render $ do
+             res <- Db.query_ conn "SELECT * FROM Users WHERE id=?" id :: IO [User.User]
+             head res-}
diff --git a/web/src/Within/DBMemorial/Post.hs b/web/src/Within/DBMemorial/Post.hs
index 7971dd8..9be85a2 100644
--- a/web/src/Within/DBMemorial/Post.hs
+++ b/web/src/Within/DBMemorial/Post.hs
@@ -5,6 +5,9 @@ import           Control.Applicative
 import           Data.Monoid                    ()
 import           Data.Text
 import           Database.SQLite.Simple.FromRow
+import           Text.Blaze.Html5               ((!))
+import qualified Text.Blaze.Html5               as H
+import qualified Text.Blaze.Html5.Attributes    as A
 
 data Post = Post
           { id       :: Int
@@ -17,3 +20,10 @@ data Post = Post
 
 instance FromRow Post where
     fromRow = Post <$> field <*> field <*> field <*> field <*> field <*> field
+
+render :: Post -> H.Html
+render post = do
+    H.div ! A.class_ "card blue-grey darken-1" $ do
+      H.div ! A.class_ "card-content white-text" $ do
+        H.span ! A.class_ "card-title" $ H.toHtml $ unpack (author post)
+        H.p $ H.toHtml $ unpack (markdown post)
diff --git a/web/src/Within/DBMemorial/User.hs b/web/src/Within/DBMemorial/User.hs
index 2bb63fb..add2526 100644
--- a/web/src/Within/DBMemorial/User.hs
+++ b/web/src/Within/DBMemorial/User.hs
@@ -5,6 +5,9 @@ import           Control.Applicative
 import           Data.Monoid                    ()
 import           Data.Text
 import           Database.SQLite.Simple.FromRow
+import           Text.Blaze.Html5               ((!))
+import qualified Text.Blaze.Html5               as H
+import qualified Text.Blaze.Html5.Attributes    as A
 
 data User = User
           { id     :: Int
@@ -15,3 +18,10 @@ data User = User
 
 instance FromRow User where
     fromRow = User <$> field <*> field <*> field <*> field
+
+render :: User -> H.Html
+render user = do
+    H.div ! A.class_ "card blue-grey darken-1" $ do
+      H.div ! A.class_ "card-content white-text" $ do
+        H.span ! A.class_ "card-title" $ H.toHtml $ unpack (name user)
+        H.img ! A.src (H.toValue $ unpack $ avatar user)
diff --git a/web/src/Within/DBMemorial/Utils.hs b/web/src/Within/DBMemorial/Utils.hs
new file mode 100644
index 0000000..39b13a7
--- /dev/null
+++ b/web/src/Within/DBMemorial/Utils.hs
@@ -0,0 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Within.DBMemorial.Utils where
+
+fixString :: String -> [Char]
+fixString s = s
diff --git a/web/src/Within/DBMemorial/Views/Materialize.hs b/web/src/Within/DBMemorial/Views/Materialize.hs
new file mode 100644
index 0000000..e5b1e42
--- /dev/null
+++ b/web/src/Within/DBMemorial/Views/Materialize.hs
@@ -0,0 +1,25 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Within.DBMemorial.Views.Materialize where
+
+import           Control.Monad               (forM_)
+import           Data.Monoid
+import           Data.Text
+import           Text.Blaze.Html
+import           Text.Blaze.Html5            as H
+import           Text.Blaze.Html5.Attributes as A
+
+base :: Text -> Html -> Html
+base pageTitle inner =
+    docTypeHtml ! lang "en" $ do
+      H.head $ do
+        H.title $ toHtml pageTitle
+
+        meta ! charset "utf-8"
+        meta ! name "viewport" ! content "width=device-width, initial-scale=1.0"
+        link ! rel "stylesheet" ! href "/materialize/css/materialize.min.css"
+        script ! type_ "text/javascript" ! src "https://code.jquery.com/jquery-2.1.1.min.js" $ mempty
+        script ! src "/materialize/js/materialize.min.js" $ mempty
+      H.body $ do
+        H.div ! class_ "container" $ do
+          inner