Make Post render User directly

Add clay as a lib
This commit is contained in:
Christine Dodrill 2015-07-29 18:01:25 -07:00
parent 1f6f5fc809
commit 8dcc285307
5 changed files with 21 additions and 10 deletions

View File

@ -37,7 +37,7 @@ main = do
S.middleware $ RequestLogger.logStdout S.middleware $ RequestLogger.logStdout
S.get S.root $ 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.get "user" $
S.html $ toStrict (renderMarkup (Materialize.render "The first poster" (User.render user))) S.html $ toStrict (renderMarkup (Materialize.render "The first poster" (User.render user)))

View File

@ -9,6 +9,7 @@ import Text.Blaze.Html5 ((!))
import qualified Text.Blaze.Html5 as H import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as A import qualified Text.Blaze.Html5.Attributes as A
import Text.Pandoc import Text.Pandoc
import qualified Within.DBMemorial.User as User
data Post = Post data Post = Post
{ id :: Int { id :: Int
@ -22,15 +23,24 @@ 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 -> H.Html render :: Post -> User.User -> H.Html
render post authorCard = render post user =
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)
in do 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_ "card-content white-text" $ do
H.div ! A.class_ "row" $ 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

View File

@ -21,9 +21,9 @@ instance FromRow User where
render :: User -> H.Html render :: User -> H.Html
render user = do 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.br
H.a ! A.href (H.toValue ("https://derpibooru.org/profiles/" ++ unpack (oID user))) $ do 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" H.img ! A.src (H.toValue $ unpack $ avatar user) ! A.width "125"

View File

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

View File

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