Split ticket open/close out of TicketEditR into new routes

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

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

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
                                             )

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

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}