diff --git a/config/routes b/config/routes index b8a3f28..c245b92 100644 --- a/config/routes +++ b/config/routes @@ -60,7 +60,7 @@ /u/#Text/p/#Text/t/!new TicketNewR GET /u/#Text/p/#Text/t/#Int TicketR GET PUT DELETE POST /u/#Text/p/#Text/t/#Int/edit TicketEditR GET -/u/#Text/p/#Text/t/#Int/d TicketDiscussionR GET +/u/#Text/p/#Text/t/#Int/d TicketDiscussionR GET POST /u/#Text/p/#Text/t/#Int/d/#Int TicketMessageR GET POST /u/#Text/p/#Text/t/#Int/d/!reply TicketTopReplyR GET /u/#Text/p/#Text/t/#Int/d/#Int/reply TicketReplyR GET diff --git a/src/Vervis/Handler/Discussion.hs b/src/Vervis/Handler/Discussion.hs index 8041960..50d17c3 100644 --- a/src/Vervis/Handler/Discussion.hs +++ b/src/Vervis/Handler/Discussion.hs @@ -16,6 +16,8 @@ module Vervis.Handler.Discussion ( getDiscussion , getMessage + , getTopReply + , postTopReply , getReply , postReply ) @@ -54,6 +56,47 @@ getMessage reply getdid num = do now <- liftIO getCurrentTime defaultLayout $ messageW now shr msg reply +getTopReply :: Route App -> Handler Html +getTopReply replyP = do + ((_result, widget), enctype) <- runFormPost newMessageForm + defaultLayout $(widgetFile "discussion/top-reply") + +postTopReply + :: Route App + -> (Int -> Route App) + -> AppDB DiscussionId + -> Handler Html +postTopReply replyP after getdid = do + ((result, widget), enctype) <- runFormPost newMessageForm + now <- liftIO getCurrentTime + case result of + FormSuccess nm -> do + author <- requireAuthId + mnum <- runDB $ do + did <- getdid + next <- do + discussion <- get404 did + return $ discussionNextMessage discussion + update did [DiscussionNextMessage +=. 1] + let message = Message + { messageAuthor = author + , messageCreated = now + , messageContent = nmContent nm + , messageParent = Nothing + , messageRoot = did + , messageNumber = next + } + insert_ message + return $ messageNumber message + setMessage "Message submitted." + redirect $ after mnum + FormMissing -> do + setMessage "Field(s) missing." + defaultLayout $(widgetFile "discussion/top-reply") + FormFailure _l -> do + setMessage "Message submission failed, see errors below." + defaultLayout $(widgetFile "discussion/top-reply") + getReply :: (Int -> Route App) -> (Int -> Route App) diff --git a/src/Vervis/Handler/Ticket.hs b/src/Vervis/Handler/Ticket.hs index ff65c4c..76f12f7 100644 --- a/src/Vervis/Handler/Ticket.hs +++ b/src/Vervis/Handler/Ticket.hs @@ -23,6 +23,7 @@ module Vervis.Handler.Ticket , postTicketR , getTicketEditR , getTicketDiscussionR + , postTicketDiscussionR , getTicketMessageR , postTicketMessageR , getTicketTopReplyR @@ -197,6 +198,13 @@ getTicketDiscussionR shar proj num = (TicketReplyR shar proj num) (selectDiscussionId shar proj num) +postTicketDiscussionR :: Text -> Text -> Int -> Handler Html +postTicketDiscussionR shar proj num = + postTopReply + (TicketDiscussionR shar proj num) + (const $ TicketR shar proj num) + (selectDiscussionId shar proj num) + getTicketMessageR :: Text -> Text -> Int -> Int -> Handler Html getTicketMessageR shar proj tnum cnum = getMessage @@ -214,7 +222,8 @@ postTicketMessageR shar proj tnum cnum = cnum getTicketTopReplyR :: Text -> Text -> Int -> Handler Html -getTicketTopReplyR shar proj num = error "Not implemented yet" +getTicketTopReplyR shar proj num = + getTopReply $ TicketDiscussionR shar proj num getTicketReplyR :: Text -> Text -> Int -> Int -> Handler Html getTicketReplyR shar proj tnum cnum = diff --git a/src/Vervis/Widget/Discussion.hs b/src/Vervis/Widget/Discussion.hs index 94c4b10..7538f93 100644 --- a/src/Vervis/Widget/Discussion.hs +++ b/src/Vervis/Widget/Discussion.hs @@ -32,7 +32,9 @@ import Yesod.Core (Route) import Yesod.Core.Handler (newIdent) import Yesod.Core.Widget (whamlet, toWidget, handlerToWidget) -import Data.EventTime.Local (intervalToEventTime, showEventTime) +import qualified Data.Text as T (filter) + +import Data.EventTime.Local import Data.Time.Clock.Local () import Vervis.Discussion (getDiscussionTree) import Vervis.Foundation @@ -43,7 +45,13 @@ import Vervis.Settings (widgetFile) messageW :: UTCTime -> Sharer -> Message -> (Int -> Route App) -> Widget messageW now shr msg reply = - $(widgetFile "discussion/widget/message") + let showTime = + showEventTime . + intervalToEventTime . + FriendlyConvert . + diffUTCTime now + showContent = renderSourceT Markdown . T.filter (/= '\r') + in $(widgetFile "discussion/widget/message") messageTreeW :: (Int -> Route App) diff --git a/templates/discussion/top-reply.hamlet b/templates/discussion/top-reply.hamlet new file mode 100644 index 0000000..0917ff4 --- /dev/null +++ b/templates/discussion/top-reply.hamlet @@ -0,0 +1,17 @@ +$# This file is part of Vervis. +$# +$# Written in 2016 by fr33domlover . +$# +$# ♡ Copying is an act of love. Please copy, reuse and share. +$# +$# The author(s) have dedicated all copyright and related and neighboring +$# rights to this software to the public domain worldwide. This software is +$# distributed without any warranty. +$# +$# You should have received a copy of the CC0 Public Domain Dedication along +$# with this software. If not, see +$# . + +
+ ^{widget} + diff --git a/templates/discussion/widget/message.hamlet b/templates/discussion/widget/message.hamlet index e92d2a4..a5db0e3 100644 --- a/templates/discussion/widget/message.hamlet +++ b/templates/discussion/widget/message.hamlet @@ -16,8 +16,8 @@ $# . #{fromMaybe (sharerIdent shr) $ sharerName shr}
- #{showEventTime $ intervalToEventTime $ diffUTCTime now (messageCreated msg)} + #{showTime $ messageCreated msg}