module Bamboo.Model.Post where
import Bamboo.Helper.StateHelper hiding (uri)
import Bamboo.Model.Counter
import Bamboo.Model.Env hiding (match)
import Bamboo.Type.Reader
import System.Time (CalendarTime)
import Text.XHtml.Strict ((+++), (<<), hotlink, p)
import qualified Bamboo.Helper.ByteString as BS
import qualified Data.ByteString.Char8 as S
import qualified MPS as MPS
data Post = Post
{ uid :: String
, title :: String
, body :: S.ByteString
, tags :: [String]
, comment_size :: Int
, reader :: Reader
, count :: Int
}
deriving (Show, Eq)
instance Resource Post where
resource_title = title
resource_type = const $ static_config.post_id
instance Markable Post where
markup = (reader &&& full) > splash render_to_html
instance Datable Post where
date = uid > get_date
instance Addressable Post where
uri = uid > id_to_uri
instance Default Post where
def = Post def def def def def def def
instance FlatRead Post where
flat_read x = do
t <- get_body x
def {body = t, uid = x} .return
instance Gettable Post where
get id = do
x <- flat_read id
x {
title = get_title id
, reader = def
}
.fill_stat
instance Listable Post where
list = list_ids >>= mapM get
cheat_list = fast_list
list_ids :: IO [String]
list_ids = ls (static_config.post_uri) ^ rsort ^ map (static_config.post_id /)
fast_list :: IO [Post]
fast_list = list_ids ^ map (\x -> def {uid = x, title = x.get_title})
fill_stat :: Post -> IO Post
fill_stat x | has_extension Counter = do
c <- x.uid.read_stat
x {count = c} .return
fill_stat x = return x
get_title :: SC
get_title id = id.words.tail.unwords.drop_known_extension
get_date :: String -> CalendarTime
get_date id = id.words.first.split "/".last.default_parse_date
match :: String -> Post -> Bool
match s x = [title > to_sb, body]
.map (send_to x > BS.lower > S.isInfixOf (s.lower.to_sb))
.or
search :: String -> IO [Post]
search "" = return []
search s = list ^ filter (match s)
summary :: Post -> S.ByteString
summary x = x.body.S.lines.takeWhile (is_cut > not) .S.unlines
full :: Post -> S.ByteString
full x | x.body.match_cut.not = x.body
full x = ( xs.takeWhile not_cut ++ xs.dropWhile not_cut .tail ).S.unlines
where
not_cut = is_cut > not
xs = x.body.S.lines
has_continue :: Post -> Bool
has_continue = body > match_cut
latest :: Int -> IO [Post]
latest n = cheat_list ^ take n
id_to_uri :: SC
id_to_uri id =
[ pretty_date
, static_config.url_date_title_seperator
, formatted_title
, ext
]
.join'
where
formatted_title =
static_config
.url_title_subs
.map (splash gsub)
.inject (id.get_title) apply
pretty_date = id.get_date.format_time (static_config.url_date_format)
ext = id.take_known_extension
uri_to_id :: SC
uri_to_id s = static_config.post_id / (date' ++ " " ++ title')
where
(raw_date, (_, title_with_sep)) =
s.MPS.match (static_config.url_date_matcher).fromJust.fst
raw_title =
title_with_sep
.drop (static_config.url_date_title_seperator.length)
title' =
static_config
.url_title_subs
.map (\(a,b) -> gsub b a)
.inject raw_title apply
date' =
raw_date
.parse_date (static_config.url_date_format)
.fromJust
.format_time (static_config.post_date_format)
markup_summary :: Post -> Html
markup_summary x = post_summary +++ rest where
post_summary = render_to_html (x.reader) (x.summary)
rest =
if x.has_continue
then toHtml $ p << hotlink (x.uri) << "Read the rest of the post ยป"
else empty_html