{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE NamedFieldPuns #-}

module Bamboo.Model.Comment where

import Bamboo.Helper.StateHelper
import Bamboo.Model.Env hiding (Comment, AuthorEmail, author_email, at)
import Bamboo.Type.Reader
import System.Time (getClockTime, toCalendarTime)
import Network.Gravatar
import qualified Bamboo.Model.Post as Post
import qualified Bamboo.Type as C
import qualified Data.ByteString.Char8 as S


data Comment = Comment
  { uid           :: String     -- comment/08-09-04 blog title
  , author        :: String
  , body          :: S.ByteString
  , author_email  :: String
  , author_link   :: String
  }
  deriving (Show, Eq)

data CommentData = 
    Author
  | AuthorEmail
  | AuthorLink
  | Body
  | PostId
  deriving (Show)

data SpamFilter = 
    HumanHack 
  | EmptyField
  | LeftNumber
  | RightNumber
  | Operator
  deriving (Show)

instance Resource Comment where
  resource_title = uid > spaced_url
  
instance Markable Comment where
  markup x  = render_to_html Markdown (x.body)

instance Datable Comment where
  date x  = x.uid.split "/".last.default_parse_date

instance Default Comment where
  def = Comment def def def def def

-- CRUD
instance FlatRead Comment where
  flat_read x = do
    t <- x.path.read_bytestring
    def {body = t, uid = x} .return

instance Gettable Comment where
  get id = do
    x <- flat_read id
    meta_data <- id.path.meta.parse_config
    let at s         = meta_data.lookup (s.show_data) .fromJust
    let author       = at Author
    let author_email = at AuthorEmail
    let author_link  = at AuthorLink
    x { author, author_email , author_link } .return

instance Listable Comment where
  list_for resource_id = do
    ifM (dir_exist d) 
      (idsM >>= mapM (get :: String -> IO Comment))
      (return [])
    where
      idsM = ls d 
        ^ reject (".meta" `isSuffixOf`) 
        ^ rsort 
        ^ map (static_config.comment_id / r /)
      
      d = static_config.comment_uri / r
      r = resource_id.id_to_resource

instance Creatable Comment where
  create = write_to

instance Mappable Comment where
  from_assoc h = do
    let at s    = h.lookup (s.show_data) .fromJust
    let post_id' = at PostId

    timestamp <- ( getClockTime >>= toCalendarTime )
      ^ format_time (static_config.comment_date_format)
      
    let comment_path = post_id_to_uid post_id'
    mkdir_p comment_path

    let uid  = comment_path / timestamp
    def 
      { uid
      , body = at Body .to_sb
      , author = at Author
      , author_email = at AuthorEmail
      , author_link = at AuthorLink
      }
      .return

write_to :: Comment -> IO ()
write_to x = do
  S.writeFile (x.uid.u2b) (x.body)
  write_config (x.uid.meta) meta_data
  where
    meta_data = 
      [ (Author, x.author)
      , (AuthorLink, x.author_link)
      , (AuthorEmail, x.author_email)
      ] .map_fst show_data

create_comment :: Assoc -> IO ()
create_comment x = x.from_assoc >>= (create :: Comment -> IO ())

-- extra
from_post_id :: String -> Comment
from_post_id x = def { uid = post_id_to_uid x }

post_id_to_uid :: SC
uid_to_post_id :: SC
post_id_to_uid x = 
  static_config.flat_uri / static_config.comment_id / x.split "/" .last
uid_to_post_id x = static_config.post_id / x.split "/" .last

fill_comment_size :: Post.Post -> IO Post.Post
fill_comment_size x = do
  n <- x.Post.uid.(list_for :: String -> IO [Comment] ) ^ length 
  return $ x { Post.comment_size = n }

gravatar_link :: Comment -> String
gravatar_link x = gravatarWith (x.author_email) def gravatar_default_size def
  where
    gravatar_default_size = size 40