Have rendering a post take its author too
This commit is contained in:
parent
7d5adcba66
commit
ebf71ed675
|
@ -19,7 +19,7 @@ main = do
|
||||||
-- Simple tests to prove we're reading from SQLite
|
-- Simple tests to prove we're reading from SQLite
|
||||||
r <- Db.query_ conn "SELECT * FROM Posts WHERE page=1" :: IO [Post.Post]
|
r <- Db.query_ conn "SELECT * FROM Posts WHERE page=1" :: IO [Post.Post]
|
||||||
let h = head r
|
let h = head r
|
||||||
users <- Db.query_ conn "SELECT * FROM Users WHERE id=1" :: IO [User.User]
|
users <- Db.query_ conn "SELECT * FROM Users WHERE oid='51315c97a4c72da155001b9a' LIMIT 1" :: IO [User.User]
|
||||||
let user = head users
|
let user = head users
|
||||||
|
|
||||||
-- Set up the URL router
|
-- Set up the URL router
|
||||||
|
@ -28,7 +28,7 @@ main = do
|
||||||
S.middleware $ RequestLogger.logStdout
|
S.middleware $ RequestLogger.logStdout
|
||||||
|
|
||||||
S.get S.root $
|
S.get S.root $
|
||||||
S.html $ toStrict (renderMarkup (Materialize.base "The OP" (Post.render h)))
|
S.html $ toStrict (renderMarkup (Materialize.base "The OP" (Post.render h (User.render user))))
|
||||||
|
|
||||||
S.get "user" $
|
S.get "user" $
|
||||||
S.html $ toStrict (renderMarkup (Materialize.base "The first poster" (User.render user)))
|
S.html $ toStrict (renderMarkup (Materialize.base "The first poster" (User.render user)))
|
||||||
|
|
|
@ -22,8 +22,8 @@ data Post = Post
|
||||||
instance FromRow Post where
|
instance FromRow Post where
|
||||||
fromRow = Post <$> field <*> field <*> field <*> field <*> field <*> field
|
fromRow = Post <$> field <*> field <*> field <*> field <*> field <*> field
|
||||||
|
|
||||||
render :: Post -> H.Html
|
render :: Post -> H.Html -> H.Html
|
||||||
render post =
|
render post authorCard =
|
||||||
let state = case readTextile def (unpack $ body post) of
|
let state = case readTextile def (unpack $ body post) of
|
||||||
Right v -> v
|
Right v -> v
|
||||||
Left err -> error (show err)
|
Left err -> error (show err)
|
||||||
|
@ -31,6 +31,6 @@ render post =
|
||||||
in do
|
in do
|
||||||
H.div ! A.class_ "card blue-grey darken-1" $ do
|
H.div ! A.class_ "card blue-grey darken-1" $ do
|
||||||
H.div ! A.class_ "card-content white-text" $ do
|
H.div ! A.class_ "card-content white-text" $ do
|
||||||
H.span ! A.class_ "card-title" $ H.toHtml $ unpack (author post)
|
H.div ! A.class_ "row" $ do
|
||||||
|
H.div ! A.class_ "col s12 m3" $ authorCard
|
||||||
do writeHtml def state
|
H.div ! A.class_ "col s12 m9" $ writeHtml def state
|
||||||
|
|
Loading…
Reference in New Issue