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.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