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
9e6a5d5e
Commit
9e6a5d5e
authored
May 07, 2018
by
Ibnu Daru Aji
Browse files
amended previous commit.
parent
01218ec6
Changes
4
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
6 additions
and
5 deletions
+6
-5
src/Flux/Post.hs
src/Flux/Post.hs
+1
-1
src/Flux/Topic.hs
src/Flux/Topic.hs
+2
-2
src/Handler/Forum.hs
src/Handler/Forum.hs
+2
-1
src/Handler/Topic.hs
src/Handler/Topic.hs
+1
-1
No files found.
src/Flux/Post.hs
View file @
9e6a5d5e
...
...
@@ -18,7 +18,7 @@ getPostsInTopic ::
,
YesodPersist
(
HandlerSite
m
)
,
MonadHandler
m
)
=>
Key
Post
s
=>
Key
Topic
s
->
Int64
->
m
[
Entity
Posts
]
getPostsInTopic
tid
page
...
...
src/Flux/Topic.hs
View file @
9e6a5d5e
...
...
@@ -38,7 +38,7 @@ replyTopicByPosting uid uname tid content = do
let
fid
=
topicsForumId
$
entityVal
topic
num
=
topicsRepliesCount
$
entityVal
topic
page
=
floor
$
(
toRational
num
)
/
25
+
1
::
Int64
pid
<-
liftHandler
$
runDB
$
insertPost
tid
(
num
+
1
)
uname
uid
content
pid
<-
liftHandler
$
runDB
$
insertPost
tid
(
num
+
2
)
uname
uid
content
liftHandler
$
runDB
$
do
updateForumIncrementReplyAndLasts
...
...
@@ -47,4 +47,4 @@ replyTopicByPosting uid uname tid content = do
pid
now
updateTopicIncrementReplyAndLasts
tid
uname
pid
now
return
(
tid
,
page
,
num
+
1
)
return
(
tid
,
page
,
num
+
2
)
src/Handler/Forum.hs
View file @
9e6a5d5e
...
...
@@ -10,6 +10,7 @@ import Data.Time.LocalTime
import
Database.Esqueleto
import
Flux.Forum
import
Handler.Topic
data
CreateTopicForm
=
CreateTopicForm
{
createTopicFormSubject
::
Text
...
...
@@ -60,6 +61,6 @@ postForumR fid = do
name
(
createTopicFormSubject
r
)
(
unTextarea
$
createTopicFormContent
r
)
redirect
$
ForumR
fid
-- we will back to it later.
redirect
$
TopicPageR
(
fromSqlKey
tid
)
1
_
->
invalidArgs
[
"Come on..."
]
_
->
invalidArgs
[
"Make up your mind!"
]
src/Handler/Topic.hs
View file @
9e6a5d5e
...
...
@@ -39,8 +39,8 @@ postTopicR tid = do
getTopicPageR
::
Int64
->
Int64
->
Handler
Html
getTopicPageR
tid
page
=
do
(
uid
,
name
,
group
)
<-
allowedToPost
posts
<-
getPostsInTopic
(
toSqlKey
tid
)
page
topic
<-
getTopicById
$
toSqlKey
tid
posts
<-
getPostsInTopic
(
toSqlKey
tid
)
page
forum
<-
getForumsInformation
.
topicsForumId
.
entityVal
$
topic
(
wid
,
enct
)
<-
generateFormPost
postForm
defaultLayout
$
(
widgetFile
"topic"
)
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