{-# LANGUAGE NoImplicitPrelude #-} 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 -- blog/08-09-04 blog title , 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 -- CRUD 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) -- summary 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