Post.hs

{-# 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
import Bamboo.Type.Extension
import Bamboo.Model.Counter
import qualified Bamboo.Type.Cache as Cache


data Post = Post 
  { uid :: String     -- blog/08-09-04 blog title
  , title :: String
  , body :: String
  , tags :: [String]
  , comment_size :: Int
  , reader :: Reader
  , count :: Int
  , cache_output :: String
  }
  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 def def

instance FlatRead Post where
  flat_read x = do
    t <- x.Cache.cache etag_data get_body
    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
      }
      .fill_stat

instance Listable Post where
  list = list_ids >>= mapM get
  cheat_list = fast_list

etag_post x' = do
  x <- x'.fill_stat
  let id = x.uid
  let path = id.id_to_path
  mtime <- path.file_mtime ^ httpdate
  size <- path.file_size ^ show
  return $ [id, mtime, size, x.comment_size.show, x.count.show] .join ","

etag_post_list xs = xs.mapM etag_post ^ join ","
  
list_ids = ls G.post_uri ^ rsort ^ map (G.post_id /)
fast_list = list_ids ^ map (\x -> def {uid = x, title = x.get_title})

fill_stat x | has_extension Counter = do
    c <- x.uid.read_stat
    x {count = c} .return
fill_stat x = return x

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