{-# 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.Env hiding (match, title, body, date) import qualified MPS as MPS import qualified Bamboo.Config.Global as G import Bamboo.Type.Reader import Bamboo.Helper.StateHelper hiding (uri) import Bamboo.Helper.Helper (date) import Bamboo.Model.Helper data Post = Post { uid :: String -- blog/08-09-04 blog title , title :: String , body :: String , tags :: [String] , comment_size :: Int , reader :: Reader } deriving (Show, Eq) instance Resource Post where resource_title = title resource_type = const G.post_id instance Markable Post where markup x = render_to_html (x.reader) (x.full) 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 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 = get_reader id } .return instance Listable Post where list = list_ids >>= mapM get cheat_list = fast_list list_ids = ls G.post_uri ^ rsort ^ map (G.post_id /) fast_list = list_ids ^ map (\x -> def {uid = x, title = x.get_title}) get_title id = id.words.tail.unwords.drop_known_extension get_date id = id.words.first.split "/".last.default_parse_date match s x = [title, body] .map (send_to x > lower > isInfixOf (s.lower)) .or search "" = return [] search s = list ^ filter (match s) summary x = x.body.lines.takeWhile (is_cut > not) .unlines full x | x.body.match_cut.not = x.body full x = ( xs.takeWhile not_cut ++ xs.dropWhile not_cut .tail ).unlines where not_cut = is_cut > not xs = x.body.lines has_continue = body > match_cut latest n = cheat_list ^ take n -- extra id_to_uri id = G.root / ( pretty_date ++ G.url_date_title_seperator ++ formatted_title ++ ext ) where formatted_title = G.url_title_subs.map (\(a,b) -> gsub a b).inject (id.get_title) apply pretty_date = id.get_date.format_time G.url_date_format ext = id.take_known_extension uri_to_id s = G.post_id / (d ++ " " ++ t) where (raw_d, (_, title_with_sep)) = s.MPS.match G.url_date_matcher.fromJust.fst raw_t = title_with_sep.drop (G.url_date_title_seperator.length) t = G.url_title_subs.map (\(a,b) -> gsub b a) .inject raw_t apply d = raw_d.parse_date G.url_date_format .fromJust.format_time G.post_date_format -- summary markup_summary x = post_summary x +++ next where post_summary = (reader &&& summary) > splash render_to_html next = if x.has_continue then toHtml $ p << hotlink (x.uri) << "Read the rest of the post ยป" else empty_html