{-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE NamedFieldPuns #-} module Bamboo.Controller.Comment where import Bamboo.Controller.Env import Hack.Contrib.Response (redirect) import Hack.Contrib.Utils (unescape_uri) import System.FilePath (equalFilePath, takeDirectory) import qualified Bamboo.Model.Comment as Comment import qualified Bamboo.Model.Post as Post import qualified Bamboo.Type.State as S import MPS (trace') comment_create :: Application comment_create env = do let post_uid = static_config.post_id key = show_data Comment.PostId nothing = post_uid / "nothing" uid = env.input_with_default key nothing exists <- (static_config.flat_uri / uid) .file_exist let valid_path = equalFilePath post_uid (takeDirectory uid) checked = check_create when ([checked, valid_path, exists].and) $ env.inputs.Comment.create_comment return $ def.redirect ((uid.Post.id_to_uri.u2b).unescape_uri.("/" /)) Nothing .trace' 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 = get_input_data s .maybe False f