diff --git a/config/routes b/config/routes
index bdbeb46..d91a10f 100644
--- a/config/routes
+++ b/config/routes
@@ -92,6 +92,8 @@
/s/#ShrIdent/p/#PrjIdent/t/!new TicketNewR GET
/s/#ShrIdent/p/#PrjIdent/t/#Int TicketR GET PUT DELETE POST
/s/#ShrIdent/p/#PrjIdent/t/#Int/edit TicketEditR GET
+/s/#ShrIdent/p/#PrjIdent/t/#Int/close TicketCloseR POST
+/s/#ShrIdent/p/#PrjIdent/t/#Int/open TicketOpenR POST
/s/#ShrIdent/p/#PrjIdent/t/#Int/d TicketDiscussionR GET POST
/s/#ShrIdent/p/#PrjIdent/t/#Int/d/#Int TicketMessageR GET POST
/s/#ShrIdent/p/#PrjIdent/t/#Int/d/!reply TicketTopReplyR GET
diff --git a/src/Vervis/Form/Ticket.hs b/src/Vervis/Form/Ticket.hs
index bd625c1..8b9809b 100644
--- a/src/Vervis/Form/Ticket.hs
+++ b/src/Vervis/Form/Ticket.hs
@@ -16,7 +16,7 @@
module Vervis.Form.Ticket
( NewTicket (..)
, newTicketForm
- , editTicketForm
+ , editTicketContentForm
, ticketFilterForm
)
where
@@ -57,6 +57,7 @@ newTicketAForm = NewTicket
newTicketForm :: Form NewTicket
newTicketForm = renderDivs newTicketAForm
+{-
editTicketAForm :: Ticket -> PersonId -> AForm Handler Ticket
editTicketAForm ticket pid = fmap fixDone $ Ticket
<$> pure (ticketProject ticket)
@@ -83,9 +84,29 @@ editTicketAForm ticket pid = fmap fixDone $ Ticket
(True, False) -> result { ticketClosed = defTime
, ticketCloser = ticketCreator ticket
}
+-}
-editTicketForm :: Ticket -> PersonId -> Form Ticket
-editTicketForm t p = renderDivs $ editTicketAForm t p
+editTicketContentAForm :: Ticket -> AForm Handler Ticket
+editTicketContentAForm ticket = Ticket
+ <$> pure (ticketProject ticket)
+ <*> pure (ticketNumber ticket)
+ <*> pure (ticketCreated ticket)
+ <*> pure (ticketCreator ticket)
+ <*> areq textField "Title*" (Just $ ticketTitle ticket)
+ <*> ( maybe "" unTextarea <$>
+ aopt
+ textareaField
+ "Description (Markdown)"
+ (Just $ Just $ Textarea $ ticketDesc ticket)
+ )
+ <*> pure (ticketAssignee ticket)
+ <*> pure (ticketDone ticket)
+ <*> pure (ticketClosed ticket)
+ <*> pure (ticketCloser ticket)
+ <*> pure (ticketDiscuss ticket)
+
+editTicketContentForm :: Ticket -> Form Ticket
+editTicketContentForm t = renderDivs $ editTicketContentAForm t
ticketFilterAForm :: AForm Handler TicketFilter
ticketFilterAForm = TicketFilter
diff --git a/src/Vervis/Foundation.hs b/src/Vervis/Foundation.hs
index 3d045c8..c1dd2a6 100644
--- a/src/Vervis/Foundation.hs
+++ b/src/Vervis/Foundation.hs
@@ -158,6 +158,8 @@ instance Yesod App where
(TicketNewR _ _ , _ ) -> personAny
(TicketR user _ _ , True) -> person user
(TicketEditR user _ _ , _ ) -> person user
+ (TicketCloseR user _ _ , _ ) -> person user
+ (TicketOpenR user _ _ , _ ) -> person user
(TicketDiscussionR _ _ _ , True) -> personAny
(TicketMessageR _ _ _ _ , True) -> personAny
(TicketTopReplyR _ _ _ , _ ) -> personAny
@@ -372,6 +374,8 @@ instance YesodBreadcrumbs App where
TicketEditR shar proj num -> ( "Edit"
, Just $ TicketR shar proj num
)
+ TicketCloseR _shar _proj _num -> ("", Nothing)
+ TicketOpenR _shar _proj _num -> ("", Nothing)
TicketDiscussionR shar proj num -> ( "Discussion"
, Just $ TicketR shar proj num
)
diff --git a/src/Vervis/Handler/Ticket.hs b/src/Vervis/Handler/Ticket.hs
index 570588b..f00bb28 100644
--- a/src/Vervis/Handler/Ticket.hs
+++ b/src/Vervis/Handler/Ticket.hs
@@ -22,6 +22,8 @@ module Vervis.Handler.Ticket
, deleteTicketR
, postTicketR
, getTicketEditR
+ , postTicketCloseR
+ , postTicketOpenR
, getTicketDiscussionR
, postTicketDiscussionR
, getTicketMessageR
@@ -41,7 +43,7 @@ import Data.Time.Calendar (Day (..))
import Data.Time.Clock (UTCTime (..), getCurrentTime)
import Data.Time.Format (formatTime, defaultTimeLocale)
import Data.Traversable (for)
-import Database.Esqueleto hiding ((==.), (+=.), update)
+import Database.Esqueleto hiding ((==.), (=.), (+=.), update)
import Database.Persist
import Text.Blaze.Html (Html, toHtml)
import Yesod.Auth (requireAuthId)
@@ -170,8 +172,7 @@ putTicketR shar proj num = do
Entity sid _sharer <- getBy404 $ UniqueSharer shar
Entity pid _project <- getBy404 $ UniqueProject proj sid
getBy404 $ UniqueTicket pid num
- user <- requireAuthId
- ((result, widget), enctype) <- runFormPost $ editTicketForm ticket user
+ ((result, widget), enctype) <- runFormPost $ editTicketContentForm ticket
case result of
FormSuccess ticket' -> do
runDB $ replace tid ticket'
@@ -204,10 +205,56 @@ getTicketEditR shar proj num = do
Entity sid _sharer <- getBy404 $ UniqueSharer shar
Entity pid _project <- getBy404 $ UniqueProject proj sid
getBy404 $ UniqueTicket pid num
- user <- requireAuthId
- ((_result, widget), enctype) <- runFormPost $ editTicketForm ticket user
+ ((_result, widget), enctype) <- runFormPost $ editTicketContentForm ticket
defaultLayout $(widgetFile "ticket/edit")
+postTicketCloseR :: ShrIdent -> PrjIdent -> Int -> Handler Html
+postTicketCloseR shr prj num = do
+ pid <- requireAuthId
+ now <- liftIO getCurrentTime
+ succ <- runDB $ do
+ Entity tid ticket <- do
+ Entity s _ <- getBy404 $ UniqueSharer shr
+ Entity p _ <- getBy404 $ UniqueProject prj s
+ getBy404 $ UniqueTicket p num
+ if ticketDone ticket
+ then return False
+ else do
+ update tid
+ [ TicketDone =. True
+ , TicketClosed =. now
+ , TicketCloser =. pid
+ ]
+ return True
+ setMessage $
+ if succ
+ then "Ticket closed."
+ else "Ticket is already closed."
+ redirect $ TicketR shr prj num
+
+postTicketOpenR :: ShrIdent -> PrjIdent -> Int -> Handler Html
+postTicketOpenR shr prj num = do
+ pid <- requireAuthId
+ now <- liftIO getCurrentTime
+ succ <- runDB $ do
+ Entity tid ticket <- do
+ Entity s _ <- getBy404 $ UniqueSharer shr
+ Entity p _ <- getBy404 $ UniqueProject prj s
+ getBy404 $ UniqueTicket p num
+ if ticketDone ticket
+ then do
+ update tid
+ [ TicketDone =. False
+ , TicketCloser =. ticketCreator ticket
+ ]
+ return True
+ else return False
+ setMessage $
+ if succ
+ then "Ticket reopened"
+ else "Ticket is already open."
+ redirect $ TicketR shr prj num
+
selectDiscussionId :: ShrIdent -> PrjIdent -> Int -> AppDB DiscussionId
selectDiscussionId shar proj tnum = do
Entity sid _sharer <- getBy404 $ UniqueSharer shar
diff --git a/templates/ticket/one.hamlet b/templates/ticket/one.hamlet
index 47e5646..7684020 100644
--- a/templates/ticket/one.hamlet
+++ b/templates/ticket/one.hamlet
@@ -33,9 +33,15 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
Status:
$if ticketDone ticket
Closed on #{formatTime defaultTimeLocale "%F" $ ticketClosed ticket} by
- ^{personLinkW closer}
+ ^{personLinkW closer}.
+
+ <form method=POST action=@{TicketOpenR shar proj num}>
+ <input type=submit value="Reopen this ticket.">
$else
- Open
+ Open.
+
+ <form method=POST action=@{TicketCloseR shar proj num}>
+ <input type=submit value="Close this ticket.">
<h2>#{ticketTitle ticket}