Commit cf121cae authored by Ibnu Daru Aji's avatar Ibnu Daru Aji

administer report. report handler.

parent 24c0c6cb
......@@ -2,7 +2,7 @@
--
-- see: https://github.com/sol/hpack
--
-- hash: 62d7c6c506dc8823a51cbe13d0a09a1cf64d63da543b3fda96391eff8a67dfb3
-- hash: bee8b7a4958f96c7910c49ecaf6f03251589c8132d7447159ba6b32fbb46179f
name: Cirkeltrek
version: 0.0.0
......@@ -17,6 +17,7 @@ library
DBOp.CRUDForum
DBOp.CRUDGroup
DBOp.CRUDPost
DBOp.CRUDReport
DBOp.CRUDTopic
DBOp.CRUDUser
Flux.Adm.Ban
......
......@@ -4,7 +4,6 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
module DBOp.CRUDPost where
import Import hiding (Value, groupBy, on,
......@@ -88,6 +87,7 @@ selectPostAndItsParentsInfo pid = do
, topic ^. TopicsSubject
, post)
updatePostContent :: MonadIO m => Key Posts -> Text -> ReaderT SqlBackend m ()
updatePostContent pid content = do
update $ \post -> do
set post [PostsContent =. val content]
......
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
module DBOp.CRUDReport where
import Import hiding (Value, groupBy, on,
update, (=.), (==.))
import Database.Esqueleto
import Database.Esqueleto.PostgreSQL
insertReport ::
(BaseBackend backend ~ SqlBackend, PersistStoreWrite backend, MonadIO m)
=> Key Posts
-> Key Topics
-> Key Forums
-> Key Users
-> UTCTime
-> Text
-> Maybe UTCTime
-> Maybe (Key Users)
-> ReaderT backend m ()
insertReport pid tid fid username now message nothing nothing' = do
insert_ $ Reports pid tid fid username now message nothing nothing'
......@@ -10,6 +10,7 @@ import Import hiding (Value)
import Database.Esqueleto
import DBOp.CRUDPost
import DBOp.CRUDTopic
import DBOp.CRUDReport
getPostsInTopic ::
( BackendCompatible SqlBackend (YesodPersistBackend (HandlerSite m))
......@@ -83,3 +84,19 @@ editPostByUidGroupAndContent _ Banned _ _ _ =
editPostByUidGroupAndContent uid Member pid uid' content
| uid /= uid' = permissionDenied "You're not allowed to edit this post."
| otherwise = liftHandler $ runDB $ updatePostContent pid content
createReport ::
( BaseBackend (YesodPersistBackend (HandlerSite m)) ~ SqlBackend
, PersistStoreWrite (YesodPersistBackend (HandlerSite m))
, YesodPersist (HandlerSite m)
, MonadHandler m
)
=> Key Posts
-> Key Topics
-> Key Forums
-> Key Users
-> Text
-> m ()
createReport pid tid fid uid message = do
now <- liftIO getCurrentTime
liftHandler $ runDB $ insertReport pid tid fid uid now message Nothing Nothing
......@@ -53,6 +53,7 @@ mkYesodData
/topic/#Int64/#Int64 TopicPageR GET
/post/#Int64 PostR GET
/post/#Int64/edit PostEditR GET POST
/post/#Int64/report PostReportR GET POST
|]
type Form a = Html -> MForm (HandlerFor App) (FormResult a, Widget)
......
......@@ -14,13 +14,6 @@ import Flux.Forum
import Flux.Post
import Flux.Topic
getPostR :: Int64 -> Handler Html
getPostR pid = do
(uid, name, group) <- allowedToPost
(Entity _ (Posts tid num _ _ _ _)) <- getPostById $ toSqlKey pid
let page = floor $ (toRational num - 1) / 25 + 1 :: Int64
redirect $ TopicPageR (fromSqlKey tid) page :#: ("post-" <> show num)
data EditPostForm = EditPostForm
{ editPostFormContent :: Textarea
} deriving (Show)
......@@ -30,6 +23,21 @@ editPostForm content =
renderDivs $
EditPostForm <$> areq textareaField "Post's Content" (Just . Textarea $ content)
data ReportPostForm = ReportPostForm
{ reportPostFormComplaint :: Textarea
}
reportPostForm :: Form ReportPostForm
reportPostForm =
renderDivs $ ReportPostForm <$> areq textareaField "Your Complaints?" Nothing
getPostR :: Int64 -> Handler Html
getPostR pid = do
(uid, name, group) <- allowedToPost
(Entity _ (Posts tid num _ _ _ _)) <- getPostById $ toSqlKey pid
let page = floor $ (toRational num - 1) / 25 + 1 :: Int64
redirect $ TopicPageR (fromSqlKey tid) page :#: ("post-" <> show num)
getPostEditR :: Int64 -> Handler Html
getPostEditR pid = do
(uid, name, group) <- allowedToPost
......@@ -54,3 +62,25 @@ postPostEditR pid = do
(unTextarea $ editPostFormContent c)
redirect $ PostR pid
_ -> invalidArgs ["Come on..."]
getPostReportR :: Int64 -> Handler Html
getPostReportR pid = do
(uid, name, group) <- allowedToPost
(Value fname, Value fid, Value tsub, (Entity pid' (Posts tid num name' uid' t content))) <-
getPostParentInformation $ toSqlKey pid
(wid, enct) <- generateFormPost reportPostForm
defaultLayout $ do
setTitle "Complaining, LOL"
$(widgetFile "post-report")
postPostReportR :: Int64 -> Handler Html
postPostReportR pid = do
(uid, name, group) <- allowedToPost
(Value fname, Value fid, Value tsub, (Entity pid' (Posts tid num name' uid' t content))) <-
getPostParentInformation $ toSqlKey pid
((res, wid), enct) <- runFormPost reportPostForm
case res of
FormSuccess r -> do
createReport pid' tid fid uid (unTextarea $ reportPostFormComplaint r)
redirect $ PostR pid
_ -> invalidArgs ["Please complaint correctly."]
<h4>
<a [email protected]{HomeR}> Index
<span> »
<a [email protected]{ForumR $ fromSqlKey $ fid}> #{fname}
<span> »
<a [email protected]{TopicR $ fromSqlKey $ tid}> #{tsub}
<span> »
<a [email protected]{PostR pid}> This Post
<span> »
<span> Your Complaints
<form [email protected]{PostReportR pid} method=post enctype=#{enct}>
^{wid}
<input .button-primary name=edit value=report type=submit>
......@@ -23,7 +23,8 @@ $forall (Entity pid (Posts tid n uname posterid t content)) <- posts
<a [email protected]{PostEditR $ fromSqlKey pid}> Edit
$else
<.column.column-10>
<span .float-right #post-#{n}> Report
<span .float-right #post-#{n}>
<a [email protected]{PostReportR $ fromSqlKey pid}> Report
<form method=post [email protected]{TopicR tid} enctype=#{enct}>
^{wid}
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment