time-wasting-thread-memorial/web/src/Within/DBMemorial/Post.hs

47 lines
1.9 KiB
Haskell

{-# LANGUAGE OverloadedStrings #-}
module Within.DBMemorial.Post where
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
import Text.Pandoc
import qualified Within.DBMemorial.User as User
data Post = Post
{ id :: Int
, oID :: Text
, body :: Text
, markdown :: Text
, author :: Text
, page :: Int
} deriving (Show, Eq)
instance FromRow Post where
fromRow = Post <$> field <*> field <*> field <*> field <*> field <*> field
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-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" $ 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