Make Post render User directly

Add clay as a lib

web/src/Main.hs

@@ -37,7 +37,7 @@ main = do
         S.middleware $ RequestLogger.logStdout
 
         S.get S.root $
-            S.html $ toStrict (renderMarkup (Materialize.render "The OP" (Post.render h (User.render user))))
+            S.html $ toStrict (renderMarkup (Materialize.render "The OP" (Post.render h user)))
 
         S.get "user" $
             S.html $ toStrict (renderMarkup (Materialize.render "The first poster" (User.render user)))

web/src/Within/DBMemorial/Post.hs

@@ -9,6 +9,7 @@ import           Text.Blaze.Html5               ((!))
 import qualified Text.Blaze.Html5               as H
 import qualified Text.Blaze.Html5.Attributes    as A
 import           Text.Pandoc
+import qualified Within.DBMemorial.User as User
 
 data Post = Post
           { id       :: Int
@@ -22,15 +23,24 @@ data Post = Post
 instance FromRow Post where
     fromRow = Post <$> field <*> field <*> field <*> field <*> field <*> field
 
-render :: Post -> H.Html -> H.Html
+render :: Post -> User.User -> H.Html
-render post authorCard =
+render post user =
     let state = case readTextile def (unpack $ body post) of
           Right v -> v
           Left err -> error (show err)
 
     in do
-        H.div ! A.class_ "card blue-grey darken-1" $ do
+        H.div ! A.class_ "card-panel blue-grey darken-1" $ do
           H.div ! A.class_ "card-content white-text" $ do
             H.div ! A.class_ "row" $ do
-              H.div ! A.class_ "col s12 m3" $ authorCard
+              H.div ! A.class_ "col s12 m3" $ User.render user
-              H.div ! A.class_ "col s12 m9" $ writeHtml def state
+              H.div ! A.class_ "col s12 m6" $ writeHtml def state
+              H.div ! A.class_ "col s12 m3" $ do
+                  H.div ! A.class_ "card blue-grey darken-5" $ do
+                      H.div ! A.class_ "card-content info-card center" $ do
+                          H.h5 $ "More information"
+                      H.div ! A.class_ "card-action blue-text" $ do
+                          H.a ! A.href (H.toValue ("/users/" ++ (unpack (User.oID user)))) $ "All their posts"
+                          H.br
+                          H.a ! A.href (H.toValue ("https://derpibooru.org/profiles/" ++ (unpack (User.oID user)))) $ "Derpibooru profile"
+                          H.br

web/src/Within/DBMemorial/User.hs

@@ -21,9 +21,9 @@ instance FromRow User where
 
 render :: User -> H.Html
 render user = do
-    H.div ! A.class_ "card blue-grey darken-3" $ do
+    H.div ! A.class_ "card-panel blue-grey darken-3" $ do
-      H.div ! A.class_ "card-content white-text center" $ do
+      H.div ! A.class_ "card-content white-text center user-card" $ do
-        H.span ! A.class_ "card-title" $ H.toHtml $ unpack (name user)
+        H.h5 $ H.toHtml $ unpack (name user)
         H.br
         H.a ! A.href (H.toValue ("https://derpibooru.org/profiles/" ++ unpack (oID user))) $ do
           H.img ! A.src (H.toValue $ unpack $ avatar user) ! A.width "125"

web/src/Within/DBMemorial/Views/Thread.hs

@@ -22,4 +22,4 @@ render pageNumber posts users = do
                 Just u -> u
                 Nothing -> error "Can't find user? Impossible state."
 
-        Post.render post (User.render user)
+        Post.render post user

web/time-wasting-thread-memorial.cabal

@@ -69,6 +69,7 @@ executable time-wasting-thread-memorial
                      , mtl >=2.2.1
                      , containers >=0.5.0.0
                      , transformers >=0.4.3.0
+                     , clay >=0.10.1
 
   -- Directories containing source files.
   hs-source-dirs:      src