Comment.hs

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

module Bamboo.Controller.Comment where

import Bamboo.Controller.Env hiding (checked)
import qualified Bamboo.Model.Comment as Comment
import qualified Bamboo.Model.Post as Post
import qualified Bamboo.Type as T
import qualified Bamboo.Type.State as S
import Hack.Contrib.Response (redirect)


comment_create :: Application
comment_create env = do
  let post_id = static_config.T.post_id
      key     = show_data Comment.PostId
      nothing = post_id / "nothing"
      uid     = env.input_with_default key nothing

  exists <- (static_config.flat_uri / uid) .file_exist
  
  let valid_path = equalFilePath post_id (takeDirectory uid) 
      checked    = check_create
  
  if [checked, valid_path, exists].and
      then env.inputs.Comment.create_comment
      else return ()
  
  return $ def.redirect ((uid.Post.id_to_uri.u2b).urlEncode) Nothing
  
  where
    get_input_data s = env.get_input (s.show_data)

    check_human = S.simple_eval (l.read) (r.read) (op.S.read_op) .is (h.read)
      where
        [l, r, op, h] = 
          [ Comment.LeftNumber
          , Comment.RightNumber
          , Comment.Operator
          , Comment.HumanHack
          ] .map (get_input_data > fromMaybe "0")
      
    check_create =
      [ validate Comment.Author       ( length > (`gt` 0))
      , validate Comment.AuthorLink   ( const True)
      , validate Comment.Body         ( length > (`gt` 0))
      , validate Comment.EmptyField   ( empty )
      , validate Comment.LeftNumber   ( belongs_to (S.nums.map show))
      , validate Comment.RightNumber  ( belongs_to (S.nums.map show))
      , validate Comment.Operator     ( belongs_to (S.ops.map S.display_op))
      , validate Comment.HumanHack    ( belongs_to (S.nums.map show))
      , check_human
      ]
      .and


    validate s f =
      let maybe_s = get_input_data s in
      case maybe_s of
        Nothing -> False
        Just v  -> f v