module Bamboo.Model.Comment where
import Bamboo.Helper.StateHelper
import Bamboo.Model.Env hiding (Comment, AuthorEmail, author_email, at)
import Bamboo.Type.Reader
import System.Time (getClockTime, toCalendarTime)
import Network.Gravatar
import qualified Bamboo.Model.Post as Post
import qualified Bamboo.Type as C
import qualified Data.ByteString.Char8 as S
data Comment = Comment
{ uid :: String
, author :: String
, body :: S.ByteString
, author_email :: String
, author_link :: String
}
deriving (Show, Eq)
data CommentData =
Author
| AuthorEmail
| AuthorLink
| Body
| PostId
deriving (Show)
data SpamFilter =
HumanHack
| EmptyField
| LeftNumber
| RightNumber
| Operator
deriving (Show)
instance Resource Comment where
resource_title = uid > spaced_url
instance Markable Comment where
markup x = render_to_html Markdown (x.body)
instance Datable Comment where
date x = x.uid.split "/".last.default_parse_date
instance Default Comment where
def = Comment def def def def def
instance FlatRead Comment where
flat_read x = do
t <- x.path.read_bytestring
def {body = t, uid = x} .return
instance Gettable Comment where
get id = do
x <- flat_read id
meta_data <- id.path.meta.parse_config
let at s = meta_data.lookup (s.show_data) .fromJust
let author = at Author
let author_email = at AuthorEmail
let author_link = at AuthorLink
x { author, author_email , author_link } .return
instance Listable Comment where
list_for resource_id = do
ifM (dir_exist d)
(idsM >>= mapM (get :: String -> IO Comment))
(return [])
where
idsM = ls d
^ reject (".meta" `isSuffixOf`)
^ rsort
^ map (static_config.comment_id / r /)
d = static_config.comment_uri / r
r = resource_id.id_to_resource
instance Creatable Comment where
create = write_to
instance Mappable Comment where
from_assoc h = do
let at s = h.lookup (s.show_data) .fromJust
let post_id' = at PostId
timestamp <- ( getClockTime >>= toCalendarTime )
^ format_time (static_config.comment_date_format)
let comment_path = post_id_to_uid post_id'
mkdir_p comment_path
let uid = comment_path / timestamp
def
{ uid
, body = at Body .to_sb
, author = at Author
, author_email = at AuthorEmail
, author_link = at AuthorLink
}
.return
write_to :: Comment -> IO ()
write_to x = do
S.writeFile (x.uid.u2b) (x.body)
write_config (x.uid.meta) meta_data
where
meta_data =
[ (Author, x.author)
, (AuthorLink, x.author_link)
, (AuthorEmail, x.author_email)
] .map_fst show_data
create_comment :: Assoc -> IO ()
create_comment x = x.from_assoc >>= (create :: Comment -> IO ())
from_post_id :: String -> Comment
from_post_id x = def { uid = post_id_to_uid x }
post_id_to_uid :: SC
uid_to_post_id :: SC
post_id_to_uid x =
static_config.flat_uri / static_config.comment_id / x.split "/" .last
uid_to_post_id x = static_config.post_id / x.split "/" .last
fill_comment_size :: Post.Post -> IO Post.Post
fill_comment_size x = do
n <- x.Post.uid.(list_for :: String -> IO [Comment] ) ^ length
return $ x { Post.comment_size = n }
gravatar_link :: Comment -> String
gravatar_link x = gravatarWith (x.author_email) def gravatar_default_size def
where
gravatar_default_size = size 40