parent
1f6f5fc809
commit
8dcc285307
|
@ -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)))
|
||||
|
|
|
@ -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 authorCard =
|
||||
render :: Post -> User.User -> H.Html
|
||||
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 m9" $ writeHtml def state
|
||||
H.div ! A.class_ "col s12 m3" $ User.render user
|
||||
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
|
||||
|
|
|
@ -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-content white-text center" $ do
|
||||
H.span ! A.class_ "card-title" $ H.toHtml $ unpack (name user)
|
||||
H.div ! A.class_ "card-panel blue-grey darken-3" $ do
|
||||
H.div ! A.class_ "card-content white-text center user-card" $ do
|
||||
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"
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue