Commit 3dbd3965 authored by Ibnu Daru Aji's avatar Ibnu Daru Aji

lock unlocked topic.

parent e45b6107
......@@ -2,7 +2,7 @@
--
-- see: https://github.com/sol/hpack
--
-- hash: 8544cbec364e66ad92188c1912b6afa41c8b90ea1da6ef8ef064e72ae96f5172
-- hash: 8146799c97967808e50779a0ee879c0e0efa4025b3146f3a23d42319258bc009
name: Cirkeltrek
version: 0.0.0
......@@ -20,6 +20,7 @@ library
Flux.AdmForum
Flux.Forum
Flux.Home
Flux.Topic
Foundation
Handler.Adm.Category
Handler.Adm.Forum
......
......@@ -8,7 +8,7 @@
module DBOp.CRUDTopic where
import Import hiding (Value, groupBy, on,
(==.))
update, (=.), (==.))
import Database.Esqueleto
import Database.Esqueleto.PostgreSQL
......@@ -31,3 +31,14 @@ insertTopic fid poster subject = do
topicsLastPoster = Nothing
topicsIsLocked = False
insert Topics {..}
selectTopicById tid = do
select $ from $ \topic -> do
where_ (topic ^. TopicsId ==. val tid)
limit 1
return topic
updateTopicIsLocked tid locked = do
update $ \topic -> do
set topic [TopicsIsLocked =. val locked]
where_ (topic ^. TopicsId ==. val tid)
......@@ -10,8 +10,10 @@ import Import hiding (Value)
import Database.Esqueleto
import DBOp.CRUDForum
import DBOp.CRUDTopic
import DBOp.CRUDPost
import DBOp.CRUDTopic
import Flux.Topic
getForumsInformation ::
( BackendCompatible SqlBackend (YesodPersistBackend (HandlerSite m))
......@@ -38,7 +40,7 @@ getTopicsInForum ::
=> Key Forums
-> Int64
-> m [Entity Topics]
getTopicsInForum fid page | page < 0 = invalidArgs ["Yo! You can't look at negative value!"]
getTopicsInForum fid page | page < 1 = invalidArgs ["Yo! Have you seen negative page before? Me neither."]
getTopicsInForum fid page = liftHandler $ runDB $ selectTopicsByForumIdPage fid page
createTopicByPosting ::
......@@ -59,3 +61,23 @@ createTopicByPosting fid userid username subject content = do
pid <- liftHandler $ runDB $ insertPost tid 1 username userid content
return tid
lockUnlockTopic ::
( YesodPersistBackend (HandlerSite m) ~ SqlBackend
, PersistUniqueRead (YesodPersistBackend (HandlerSite m))
, BackendCompatible SqlBackend (YesodPersistBackend (HandlerSite m))
, PersistQueryRead (YesodPersistBackend (HandlerSite m))
, MonadHandler m
, YesodPersist (HandlerSite m)
)
=> Bool
-> Grouping
-> Text
-> m ()
lockUnlockTopic lock group tid
| group == Administrator || group == Moderator = do
topic <- getTopicById . toSqlKey . forceTextToInt64 $ tid
if (topicsIsLocked $ entityVal topic) == lock
then invalidArgs ["You can only switch the lock of the topic."]
else liftHandler $
runDB $ updateTopicIsLocked (toSqlKey . forceTextToInt64 $ tid) lock
lockUnlockTopic _ lock _ = permissionDenied "You're not allowed to lock this topic."
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module Flux.Topic where
import Import hiding (Value)
import Database.Esqueleto
import DBOp.CRUDPost
import DBOp.CRUDTopic
getTopicById ::
( BackendCompatible SqlBackend (YesodPersistBackend (HandlerSite m))
, PersistQueryRead (YesodPersistBackend (HandlerSite m))
, PersistUniqueRead (YesodPersistBackend (HandlerSite m))
, YesodPersist (HandlerSite m)
, MonadHandler m
)
=> Key Topics
-> m (Entity Topics)
getTopicById tid = do
topics <- liftHandler $ runDB $ selectTopicById tid
case topics of
[x] -> return x
_ -> notFound
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
module Handler.Forum where
......@@ -26,6 +27,7 @@ getForumR fid = redirect $ ForumPageR fid 1
getForumPageR :: Int64 -> Int64 -> Handler Html
getForumPageR fid page = do
(uid, name, group) <- allowedToPost
forum <- getForumsInformation (toSqlKey fid)
topics <- getTopicsInForum (toSqlKey fid ) page
(wid, enct) <- generateFormPost createTopicForm
......@@ -36,15 +38,28 @@ getForumPageR fid page = do
postForumR :: Int64 -> Handler Html
postForumR fid = do
(uid, name, group) <- allowedToPost
((res, wid), enct) <- runFormPost createTopicForm
case res of
FormSuccess r -> do
tid <-
createTopicByPosting
(toSqlKey fid)
uid
name
(createTopicFormSubject r)
(unTextarea $ createTopicFormContent r)
redirect $ ForumR fid -- we will back to it later.
_ -> invalidArgs ["Come on..."]
lock <- lookupPostParam "lock-topic"
unlock <- lookupPostParam "unlock-topic"
create <- lookupPostParam "create-topic"
topicids <- lookupPostParams "topic-id"
case (lock, unlock, create) of
(Just _, Nothing, Nothing) -> do
forM_ topicids $ lockUnlockTopic True group
redirect $ ForumR fid
(Nothing, Just _, Nothing) -> do
forM_ topicids $ lockUnlockTopic False group
redirect $ ForumR fid
(Nothing, Nothing, Just _) -> do
((res, wid), enct) <- runFormPost createTopicForm
case res of
FormSuccess r -> do
tid <-
createTopicByPosting
(toSqlKey fid)
uid
name
(createTopicFormSubject r)
(unTextarea $ createTopicFormContent r)
redirect $ ForumR fid -- we will back to it later.
_ -> invalidArgs ["Come on..."]
_ -> invalidArgs ["Make up your mind!"]
......@@ -2,35 +2,63 @@
<a [email protected]{HomeR}> Index
<span> »
<a [email protected]{ForumR fid}> #{forumsName $ entityVal forum}
<table>
<thead>
<tr>
<th width="60%"> Subject
<th width="20%"> Replies Count
<th width="30%"> Last Active
<tbody>
$forall (Entity key (Topics fid p s rc st lp lpid lposter lock)) <- topics
<form [email protected]{ForumR fid} method=post>
<table>
<thead>
<tr>
<td>
<strong>
<a [email protected]{HomeR}> #{s}
<span>
<small> by #{p}
<td> #{rc}
$maybe lastpost <- lp
$maybe lastpostid <- lpid
$maybe lastposter <- lposter
<td>
<a [email protected]{HomeR}#post-#{rc}>
#{show $ utcToLocalTime timeZone lastpost}
<small> by #{lastposter}
<th width="60%"> Subject
<th width="10%"> Replies Count
<th width="20%"> Last Active
$case group
$of Administrator
<th width="10%"> Lock.
$of Moderator
<th width="10%"> Lock.
$of _
<tbody>
$forall (Entity key (Topics fid p s rc st lp lpid lposter lock)) <- topics
<tr>
<td>
<strong>
<a [email protected]{HomeR}> #{s}
<span>
<small> by #{p}
<td> #{rc}
$maybe lastpost <- lp
$maybe lastpostid <- lpid
$maybe lastposter <- lposter
<td>
<a [email protected]{HomeR}#post-#{rc}>
#{show $ utcToLocalTime timeZone lastpost}
<small> by #{lastposter}
$nothing
<td> Empty
$nothing
<td> Empty
$nothing
<td> Empty
$nothing
<td> Empty
$case group
$of Administrator
<td width="5%"> <input name=topic-id value=#{fromSqlKey key} type=checkbox>
$if lock
<td width="5%"> Locked
$else
<td>
$of Moderator
<td width="5%"> <input name=topic-id value=#{fromSqlKey key} type=checkbox>
$if lock
<td width="5%"> Locked
$else
<td>
$of _
$case group
$of Administrator
<input .button name=lock-topic value=lock type=submit>
<input .button name=unlock-topic value=unlock type=submit>
$of Moderator
<input .button name=lock-topic value=lock type=submit>
<input .button name=unlock-topic value=unlock type=submit>
$of _
<form method=post [email protected]{ForumR fid}>
^{wid}
<input .button-primary value=submit type=submit>
\ No newline at end of file
<input .button-primary name=create-topic value=submit type=submit>
\ No newline at end of file
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