module Panda.Model.Comment where

-- env
import Panda.Helper.Env hiding (title, body, size, path, meta)
import Prelude hiding ((.), (/), (^), id, readFile, writeFile)
import qualified Panda.Config.Global as G
import Panda.Type.Reader
import qualified Panda.Model.Post as Post
import System.Directory
import Panda.Helper.StateHelper
import Network.Gravatar

data Comment = Comment
  { uid    :: String     -- comment/08-09-04 blog title
  , author :: String
  , body   :: String
  , 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
list_for post_id = do
  has_comments <- doesDirectoryExist d
  if has_comments
    then ls d ^ reject (match "\\.meta$" >>> isJust) ^ rsort ^ map (G.comment_id / r /) >>= mapM (from_utf8 >>> get)
    else return []
  where
    d = (G.comment_uri / r)
    r = post_id.id_to_resource.to_utf8

path id = G.flat_uri / id.to_utf8
meta = (++ ".meta")

get id = do
  meta_exists <- id.path.meta.doesFileExist
  if meta_exists
    then get_from_new_format id
    else get_from_old_format id

get_from_new_format id = do
  body <- id.path.readFile
  meta <- id.path.meta.parse_config_io
  let at s         = meta.lookup (s.show_data) .fromJust
  let author       = at Author
  let author_email = at AuthorEmail
  let author_link  = at AuthorLink
  return $ Comment id author body author_email author_link

get_from_old_format id = do
  xs <- id.path.readFile ^ lines
  let author = xs.first
  let author_email = ""
  let author_link = xs.drop 2.first
  let body = xs.drop 4.unlines
  return $ Comment id author body author_email author_link

create h = do
  let at s = h.lookup (s.show_data) .fromJust
  let body        = at Body
  let post_id     = at PostId

  timestamp <- ( getClockTime >>= toCalendarTime ) ^ format_date G.comment_date_format
  let comment_path = post_id_to_uid post_id .to_utf8
  createDirectoryIfMissing True comment_path
  
  let uid = comment_path / timestamp
  writeFile uid body
  let meta = [Author, AuthorLink, AuthorEmail] .labeling at .map_fst show_data
  write_config_io (uid ++ ".meta") meta

-- extra
from_post_id x = def { uid = post_id_to_uid x }

post_id_to_uid x = G.flat_uri / G.comment_id / x.split "/" .last
uid_to_post_id x = G.post_id / x.split "/" .last

fill_comment_size x = do
  size <- x.Post.uid.list_for ^ length 
  return $ x { Post.comment_size = size }

gravatar_default_size = size 40
gravatar_link x       = gravatarWith (x.author_email) def gravatar_default_size def