Ticket update form

config/models

@@ -72,5 +72,7 @@ Ticket
     title   Text
     desc    Text -- Assume this is Pandoc Markdown
     done    Bool
+    closed  UTCTime
+    closer  PersonId
 
     UniqueTicket project number

src/Vervis/Form/Ticket.hs

@@ -15,6 +15,7 @@
 
 module Vervis.Form.Ticket
     ( newTicketForm
+    , editTicketForm
     )
 where
 
@@ -22,7 +23,8 @@ import Prelude
 
 import Control.Monad.IO.Class (liftIO)
 import Control.Monad.Trans.Class (lift)
-import Data.Time.Clock (getCurrentTime)
+import Data.Time.Calendar (Day (..))
+import Data.Time.Clock (getCurrentTime, UTCTime (..))
 import Yesod.Form
 
 import Vervis.Foundation (Form, Handler)
@@ -32,15 +34,53 @@ import Vervis.Model
 --TODO stuff like number and created - do I generate them here using monadic
 --     form or do I rely on handler to provide? which approach is better?
 
+defTime :: UTCTime
+defTime = UTCTime (ModifiedJulianDay 0) 0
+
+now :: AForm Handler UTCTime
+now = lift $ liftIO getCurrentTime
+
 newTicketAForm :: ProjectId -> Int -> PersonId -> AForm Handler Ticket
 newTicketAForm pid number author = Ticket
     <$> pure pid
     <*> pure number
-    <*> lift (liftIO getCurrentTime)
+    <*> now
     <*> pure author
     <*> areq textField "Title*" Nothing
-    <*> (maybe "" unTextarea <$> aopt textareaField "Description (Markdown)" Nothing)
+    <*> ( maybe "" unTextarea <$>
+          aopt textareaField "Description (Markdown)" Nothing
+        )
     <*> pure False
+    <*> pure defTime
+    <*> pure author
 
 newTicketForm :: ProjectId -> Int -> PersonId -> Form Ticket
 newTicketForm pid number author = renderDivs $ newTicketAForm pid number author
+
+editTicketAForm :: Ticket -> PersonId -> AForm Handler Ticket
+editTicketAForm ticket pid = fmap fixDone $ 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)
+        )
+    <*> areq checkBoxField "Done*" (Just $ ticketDone ticket)
+    <*> now
+    <*> pure (ticketCloser ticket)
+    where
+    fixDone result = case (ticketDone ticket, ticketDone result) of
+        (True,  True)  -> result { ticketClosed = ticketClosed ticket }
+        (False, False) -> result { ticketClosed = ticketClosed ticket }
+        (False, True)  -> result { ticketCloser = pid }
+        (True,  False) -> result { ticketClosed = defTime
+                                 , ticketCloser = ticketCreator ticket
+                                 }
+
+editTicketForm :: Ticket -> PersonId -> Form Ticket
+editTicketForm t p = renderDivs $ editTicketAForm t p

src/Vervis/Foundation.hs

@@ -116,6 +116,10 @@ instance Yesod App where
     isAuthorized (KeyNewR user) _ =
         loggedInAs user "You can’t add keys for other users"
     isAuthorized (TicketNewR _ _) _ = loggedIn
+    isAuthorized (TicketR user _ _) True =
+        loggedInAs user "Only project members can modify this ticket"
+    isAuthorized (TicketEditR user _ _) _ =
+        loggedInAs user "Only project members can modify this ticket"
     isAuthorized _ _ = return Authorized
 
     -- This function creates static content files in the static folder

src/Vervis/Handler/Ticket.hs

@@ -34,7 +34,7 @@ import Database.Persist
 import Text.Blaze.Html (Html, toHtml)
 import Yesod.Auth (requireAuthId)
 import Yesod.Core (defaultLayout)
-import Yesod.Core.Handler (redirectUltDest, setMessage)
+import Yesod.Core.Handler (setMessage, redirect)
 import Yesod.Core.Widget (setTitle)
 import Yesod.Form.Functions (runFormPost)
 import Yesod.Form.Types (FormResult (..))
@@ -50,10 +50,6 @@ import Vervis.Settings (widgetFile)
 
 getTicketsR :: Text -> Text -> Handler Html
 getTicketsR shar proj = do
-    --tickets <- runDB $ do
-    --    Entity sid _sharer <- getBy404 $ UniqueSharerIdent shar
-    --    Entity pid _project <- getBy404 $ UniqueProject proj sid
-    --    selectList [TicketProject ==. pid] [Asc TicketNumber]
     rows <- runDB $ select $ from $ \ (ticket, person, sharer) -> do
         where_ $
             ticket ^. TicketCreator E.==. person ^. PersonId &&.
@@ -84,7 +80,7 @@ postTicketsR shar proj = do
                 update pid [ProjectNextTicket +=. 1]
                 insert_ ticket
             setMessage "Ticket created."
-            redirectUltDest HomeR
+            redirect $ TicketR shar proj (ticketNumber ticket)
         FormMissing -> do
             setMessage "Field(s) missing."
             defaultLayout $(widgetFile "ticket/new")
@@ -106,23 +102,59 @@ getTicketNewR shar proj = do
 
 getTicketR :: Text -> Text -> Int -> Handler Html
 getTicketR shar proj num = do
-    (author, ticket) <- runDB $ do
+    (author, closer, ticket) <- runDB $ do
         Entity sid _sharer <- getBy404 $ UniqueSharerIdent shar
         Entity pid _project <- getBy404 $ UniqueProject proj sid
         Entity _tid ticket <- getBy404 $ UniqueTicket pid num
         person <- get404 $ ticketCreator ticket
         author <- get404 $ personIdent person
-        return (author, ticket)
+        closer <-
+            if ticketDone ticket
+                then do
+                    person' <- get404 $ ticketCloser ticket
+                    get404 $ personIdent person'
+                else return author
+        return (author, closer, ticket)
     defaultLayout $ do
         setTitle $ toHtml $ T.intercalate " :: "
             [shar, proj, "Tickets", T.pack ('#' : show num)]
         $(widgetFile "ticket/one")
 
 putTicketR :: Text -> Text -> Int -> Handler Html
-putTicketR shar proj num = error "Not implemented"
+putTicketR shar proj num = do
+    Entity tid ticket <- runDB $ do
+        Entity sid _sharer <- getBy404 $ UniqueSharerIdent shar
+        Entity pid _project <- getBy404 $ UniqueProject proj sid
+        getBy404 $ UniqueTicket pid num
+    user <- requireAuthId
+    ((result, widget), enctype) <- runFormPost $ editTicketForm ticket user
+    case result of
+        FormSuccess ticket' -> do
+            runDB $ replace tid ticket'
+            setMessage "Ticket created."
+            redirect $ TicketR shar proj num
+        FormMissing -> do
+            setMessage "Field(s) missing."
+            defaultLayout $(widgetFile "ticket/edit")
+        FormFailure _l -> do
+            setMessage "Ticket update failed, see errors below."
+            defaultLayout $(widgetFile "ticket/edit")
 
 deleteTicketR :: Text -> Text -> Int -> Handler Html
-deleteTicketR shar proj num = error "Not implemented"
+deleteTicketR shar proj num =
+    --TODO: I can easily implement this, but should it even be possible to
+    --delete tickets?
+    error "Not implemented"
 
 getTicketEditR :: Text -> Text -> Int -> Handler Html
-getTicketEditR shar proj num = error "Not implemented"
+getTicketEditR shar proj num = do
+    Entity _tid ticket <- runDB $ do
+        Entity sid _sharer <- getBy404 $ UniqueSharerIdent shar
+        Entity pid _project <- getBy404 $ UniqueProject proj sid
+        getBy404 $ UniqueTicket pid num
+    user <- requireAuthId
+    ((_result, widget), enctype) <- runFormPost $ editTicketForm ticket user
+    defaultLayout $ do
+        setTitle $ toHtml $ T.intercalate " :: "
+            [shar, proj, "Tickets", T.pack ('#' : show num), "Edit"]
+        $(widgetFile "ticket/edit")

templates/ticket/edit.hamlet

@@ -0,0 +1,21 @@
+$# This file is part of Vervis.
+$#
+$# Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
+$#
+$# ♡ 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
+$# <http://creativecommons.org/publicdomain/zero/1.0/>.
+
+<h1>#{shar} :: #{proj} :: Tickets :: ##{num} :: Edit
+
+Enter the details and click "Submit" to update the ticket.
+
+<form method=PUT action=@{TicketR shar proj num} enctype=#{enctype}>
+  ^{widget}
+  <input type=submit>

templates/ticket/one.hamlet

@@ -24,7 +24,13 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
   Created on #{formatTime defaultTimeLocale "%F" $ ticketCreated ticket} by
   #{fromMaybe (sharerIdent author) $ sharerName author}
 
-<p>Done: #{ticketDone ticket}
+<p>
+  Status:
+  $if ticketDone ticket
+    Closed on #{formatTime defaultTimeLocale "%F" $ ticketClosed ticket} by
+    #{fromMaybe (sharerIdent closer) $ sharerName closer}
+  $else
+    Open
 
 <h2>#{ticketTitle ticket}