diff --git a/src/Vervis/Discussion.hs b/src/Vervis/Discussion.hs
index 57947dc..aff4bdb 100644
--- a/src/Vervis/Discussion.hs
+++ b/src/Vervis/Discussion.hs
@@ -35,8 +35,9 @@ import Data.Tree.Local (sortForestOn)
import Vervis.Foundation
import Vervis.Model
-getMessages :: DiscussionId -> Handler [(Entity Message, Sharer)]
-getMessages did = fmap (map $ second entityVal) $ runDB $
+getMessages :: AppDB DiscussionId -> Handler [(Entity Message, Sharer)]
+getMessages getdid = fmap (map $ second entityVal) $ runDB $ do
+ did <- getdid
select $ from $ \ (message, person, sharer) -> do
where_ $
message ^. MessageRoot ==. val did &&.
@@ -67,5 +68,5 @@ sortByTime = sortForestOn $ messageCreated . fst
-- | Get the tree of messages in a given discussion, with siblings sorted from
-- old to new.
-getDiscussionTree :: DiscussionId -> Handler (Forest (Message, Sharer))
-getDiscussionTree did = sortByTime . discussionTree <$> getMessages did
+getDiscussionTree :: AppDB DiscussionId -> Handler (Forest (Message, Sharer))
+getDiscussionTree getdid = sortByTime . discussionTree <$> getMessages getdid
diff --git a/src/Vervis/Handler/Discussion.hs b/src/Vervis/Handler/Discussion.hs
index ba26664..8041960 100644
--- a/src/Vervis/Handler/Discussion.hs
+++ b/src/Vervis/Handler/Discussion.hs
@@ -35,17 +35,18 @@ import Yesod.Form.Types (FormResult (..))
import Yesod.Persist.Core (runDB, get404, getBy404)
import Vervis.Form.Discussion
-import Vervis.Foundation (App, Handler)
+import Vervis.Foundation (App, Handler, AppDB)
import Vervis.Model
import Vervis.Settings (widgetFile)
import Vervis.Widget.Discussion
-getDiscussion :: (Int -> Route App) -> DiscussionId -> Handler Html
-getDiscussion reply did = defaultLayout $ discussionW did reply
+getDiscussion :: (Int -> Route App) -> AppDB DiscussionId -> Handler Html
+getDiscussion reply getdid = defaultLayout $ discussionW getdid reply
-getMessage :: (Int -> Route App) -> DiscussionId -> Int -> Handler Html
-getMessage reply did num = do
+getMessage :: (Int -> Route App) -> AppDB DiscussionId -> Int -> Handler Html
+getMessage reply getdid num = do
(msg, shr) <- runDB $ do
+ did <- getdid
Entity _mid m <- getBy404 $ UniqueMessage did num
p <- get404 $ messageAuthor m
s <- get404 $ personIdent p
@@ -56,11 +57,12 @@ getMessage reply did num = do
getReply
:: (Int -> Route App)
-> (Int -> Route App)
- -> DiscussionId
+ -> AppDB DiscussionId
-> Int
-> Handler Html
-getReply replyG replyP did num = do
+getReply replyG replyP getdid num = do
(msg, shr) <- runDB $ do
+ did <- getdid
Entity _mid m <- getBy404 $ UniqueMessage did num
p <- get404 $ messageAuthor m
s <- get404 $ personIdent p
@@ -73,16 +75,17 @@ postReply
:: (Int -> Route App)
-> (Int -> Route App)
-> (Int -> Route App)
- -> DiscussionId
+ -> AppDB DiscussionId
-> Int
-> Handler Html
-postReply replyG replyP after did cnum = do
+postReply replyG replyP after getdid cnum = do
((result, widget), enctype) <- runFormPost newMessageForm
now <- liftIO getCurrentTime
case result of
FormSuccess nm -> do
author <- requireAuthId
mnum <- runDB $ do
+ did <- getdid
(parent, next) <- do
discussion <- get404 did
Entity mid _message <- getBy404 $ UniqueMessage did cnum
@@ -103,6 +106,7 @@ postReply replyG replyP after did cnum = do
FormMissing -> do
setMessage "Field(s) missing."
(msg, shr) <- runDB $ do
+ did <- getdid
Entity _mid m <- getBy404 $ UniqueMessage did cnum
p <- get404 $ messageAuthor m
s <- get404 $ personIdent p
@@ -111,6 +115,7 @@ postReply replyG replyP after did cnum = do
FormFailure _l -> do
setMessage "Message submission failed, see errors below."
(msg, shr) <- runDB $ do
+ did <- getdid
Entity _mid m <- getBy404 $ UniqueMessage did cnum
p <- get404 $ messageAuthor m
s <- get404 $ personIdent p
diff --git a/src/Vervis/Handler/Ticket.hs b/src/Vervis/Handler/Ticket.hs
index dc2aa01..ff65c4c 100644
--- a/src/Vervis/Handler/Ticket.hs
+++ b/src/Vervis/Handler/Ticket.hs
@@ -192,33 +192,34 @@ selectDiscussionId shar proj tnum = do
return $ ticketDiscuss ticket
getTicketDiscussionR :: Text -> Text -> Int -> Handler Html
-getTicketDiscussionR shar proj num = do
- did <- runDB $ selectDiscussionId shar proj num
- getDiscussion (TicketReplyR shar proj num) did
+getTicketDiscussionR shar proj num =
+ getDiscussion
+ (TicketReplyR shar proj num)
+ (selectDiscussionId shar proj num)
getTicketMessageR :: Text -> Text -> Int -> Int -> Handler Html
-getTicketMessageR shar proj tnum cnum = do
- did <- runDB $ selectDiscussionId shar proj tnum
- getMessage (TicketReplyR shar proj tnum) did cnum
+getTicketMessageR shar proj tnum cnum =
+ getMessage
+ (TicketReplyR shar proj tnum)
+ (selectDiscussionId shar proj tnum)
+ cnum
postTicketMessageR :: Text -> Text -> Int -> Int -> Handler Html
-postTicketMessageR shar proj tnum cnum = do
- did <- runDB $ selectDiscussionId shar proj tnum
+postTicketMessageR shar proj tnum cnum =
postReply
(TicketReplyR shar proj tnum)
(TicketMessageR shar proj tnum)
(const $ TicketR shar proj tnum)
- did
+ (selectDiscussionId shar proj tnum)
cnum
getTicketTopReplyR :: Text -> Text -> Int -> Handler Html
getTicketTopReplyR shar proj num = error "Not implemented yet"
getTicketReplyR :: Text -> Text -> Int -> Int -> Handler Html
-getTicketReplyR shar proj tnum cnum = do
- did <- runDB $ selectDiscussionId shar proj tnum
+getTicketReplyR shar proj tnum cnum =
getReply
(TicketReplyR shar proj tnum)
(TicketMessageR shar proj tnum)
- did
+ (selectDiscussionId shar proj tnum)
cnum
diff --git a/src/Vervis/Widget/Discussion.hs b/src/Vervis/Widget/Discussion.hs
index 9b1e988..94c4b10 100644
--- a/src/Vervis/Widget/Discussion.hs
+++ b/src/Vervis/Widget/Discussion.hs
@@ -61,9 +61,9 @@ messageTreeW reply cReplies now t = go t
^{go tree}
|]
-discussionW :: DiscussionId -> (Int -> Route App) -> Widget
-discussionW did reply = do
- forest <- handlerToWidget $ getDiscussionTree did
+discussionW :: AppDB DiscussionId -> (Int -> Route App) -> Widget
+discussionW getdid reply = do
+ forest <- handlerToWidget $ getDiscussionTree getdid
cReplies <- newIdent
now <- liftIO getCurrentTime
toWidget $(cassiusFile "templates/discussion/widget/tree.cassius")
diff --git a/templates/ticket/one.hamlet b/templates/ticket/one.hamlet
index 941a61e..109f8b0 100644
--- a/templates/ticket/one.hamlet
+++ b/templates/ticket/one.hamlet
@@ -37,4 +37,4 @@ $#