{-# LANGUAGE NoImplicitPrelude #-} -- what about performance? -- Haskell takes care of that, since IOs are also lazy. -- Posts are not read unless specifically required, i.e. after pagination module Bamboo.Model.Post where -- env import Bamboo.Helper.StateHelper hiding (uri) import Bamboo.Model.Counter import Bamboo.Model.Env hiding (match, title, body) import Bamboo.Type.Reader import qualified Bamboo.Helper.ByteString as BS import qualified Data.ByteString.Char8 as S 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 x = render_to_html (x.reader) (x.body) 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 > BS.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 -- extra id_to_uri :: SC id_to_uri id = static_config.root / ( pretty_date ++ static_config.url_date_title_seperator ++ formatted_title ++ ext ) where formatted_title = static_config.url_title_subs.map (\(a,b) -> gsub a b).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 / (d ++ " " ++ t) where (raw_d, (_, title_with_sep)) = s.MPS.match (static_config.url_date_matcher).fromJust.fst raw_t = title_with_sep.drop (static_config.url_date_title_seperator.length) t = static_config.url_title_subs.map (\(a,b) -> gsub b a) .inject raw_t apply d = raw_d.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