2015-07-28 06:18:58 +00:00
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module Within.DBMemorial.Post where
|
|
|
|
|
2015-07-28 07:00:18 +00:00
|
|
|
import Control.Applicative
|
|
|
|
import Data.Monoid ()
|
|
|
|
import Data.Text
|
|
|
|
import Database.SQLite.Simple.FromRow
|
2015-07-28 15:38:30 +00:00
|
|
|
import Text.Blaze.Html5 ((!))
|
|
|
|
import qualified Text.Blaze.Html5 as H
|
|
|
|
import qualified Text.Blaze.Html5.Attributes as A
|
2015-07-28 16:50:07 +00:00
|
|
|
import Text.Pandoc
|
2015-07-28 06:18:58 +00:00
|
|
|
|
2015-07-28 06:47:39 +00:00
|
|
|
data Post = Post
|
2015-07-28 06:53:11 +00:00
|
|
|
{ id :: Int
|
|
|
|
, oID :: Text
|
|
|
|
, body :: Text
|
|
|
|
, markdown :: Text
|
|
|
|
, author :: Text
|
|
|
|
, page :: Int
|
2015-07-28 06:47:39 +00:00
|
|
|
} deriving (Show, Eq)
|
2015-07-28 06:18:58 +00:00
|
|
|
|
|
|
|
instance FromRow Post where
|
|
|
|
fromRow = Post <$> field <*> field <*> field <*> field <*> field <*> field
|
2015-07-28 15:38:30 +00:00
|
|
|
|
|
|
|
render :: Post -> H.Html
|
2015-07-28 17:06:09 +00:00
|
|
|
render post =
|
|
|
|
let state = case readTextile def (unpack $ body post) of
|
|
|
|
Right v -> v
|
|
|
|
Left err -> error (show err)
|
2015-07-28 16:50:07 +00:00
|
|
|
|
2015-07-28 17:06:09 +00:00
|
|
|
in do
|
|
|
|
H.div ! A.class_ "card blue-grey darken-1" $ do
|
|
|
|
H.div ! A.class_ "card-content white-text" $ do
|
|
|
|
H.span ! A.class_ "card-title" $ H.toHtml $ unpack (author post)
|
2015-07-28 16:50:07 +00:00
|
|
|
|
2015-07-28 17:06:09 +00:00
|
|
|
H.p $ writeHtml def state
|