Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
7
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Switch to GitLab Next
Sign in / Register
Toggle navigation
Open sidebar
Ibnu Daru Aji
Cirkeltrek
Commits
3dbd3965
Commit
3dbd3965
authored
May 02, 2018
by
Ibnu Daru Aji
Browse files
lock unlocked topic.
parent
e45b6107
Changes
6
Hide whitespace changes
Inline
Side-by-side
Showing
6 changed files
with
145 additions
and
41 deletions
+145
-41
Cirkeltrek.cabal
Cirkeltrek.cabal
+2
-1
src/DBOp/CRUDTopic.hs
src/DBOp/CRUDTopic.hs
+12
-1
src/Flux/Forum.hs
src/Flux/Forum.hs
+24
-2
src/Flux/Topic.hs
src/Flux/Topic.hs
+27
-0
src/Handler/Forum.hs
src/Handler/Forum.hs
+27
-12
templates/forum.hamlet
templates/forum.hamlet
+53
-25
No files found.
Cirkeltrek.cabal
View file @
3dbd3965
...
...
@@ -2,7 +2,7 @@
--
-- see: https://github.com/sol/hpack
--
-- hash: 8
544cbec364e66ad92188c1912b6afa41c8b90ea1da6ef8ef064e72ae96f5172
-- hash: 8
146799c97967808e50779a0ee879c0e0efa4025b3146f3a23d42319258bc009
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
...
...
src/DBOp/CRUDTopic.hs
View file @
3dbd3965
...
...
@@ -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
)
src/Flux/Forum.hs
View file @
3dbd3965
...
...
@@ -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."
src/Flux/Topic.hs
0 → 100644
View file @
3dbd3965
{-# 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
src/Handler/Forum.hs
View file @
3dbd3965
{-# 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!"
]
templates/forum.hamlet
View file @
3dbd3965
...
...
@@ -2,35 +2,63 @@
<a href=@{HomeR}> Index
<span> »
<a href=@{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 action=@{ForumR fid} method=post>
<table>
<thead>
<tr>
<td>
<strong>
<a href=@{HomeR}> #{s}
<span>
<small> by #{p}
<td> #{rc}
$maybe lastpost <- lp
$maybe lastpostid <- lpid
$maybe lastposter <- lposter
<td>
<a href=@{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 href=@{HomeR}> #{s}
<span>
<small> by #{p}
<td> #{rc}
$maybe lastpost <- lp
$maybe lastpostid <- lpid
$maybe lastposter <- lposter
<td>
<a href=@{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 action=@{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
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment