Turn boolean ticketDone into TicketStatus enum

config/models

@@ -172,7 +172,6 @@ WorkflowField
     enm      WorkflowFieldEnumId Maybe
     required Bool
     constant Bool
-    -- filter   TicketStatusFilterId
 
     UniqueWorkflowField workflow ident
 
@@ -213,7 +212,7 @@ Ticket
     title    Text
     desc     Text -- Assume this is Pandoc Markdown
     assignee PersonId     Maybe
-    done     Bool
+    status   TicketStatus
     closed   UTCTime
     closer   PersonId
     discuss  DiscussionId

src/Vervis/Form/Ticket.hs

@@ -129,7 +129,7 @@ editTicketContentAForm ticket = Ticket
             (Just $ Just $ Textarea $ ticketDesc ticket)
         )
     <*> pure (ticketAssignee ticket)
-    <*> pure (ticketDone ticket)
+    <*> pure (ticketStatus ticket)
     <*> pure (ticketClosed ticket)
     <*> pure (ticketCloser ticket)
     <*> pure (ticketDiscuss ticket)
@@ -210,10 +210,7 @@ claimRequestForm = renderDivs claimRequestAForm
 
 ticketFilterAForm :: AForm Handler TicketFilter
 ticketFilterAForm = TicketFilter
-    <$> areq (selectFieldList status) "Status*" (Just Nothing)
+    <$> aopt (selectField optionsEnum) "Status*" (Just Nothing)
-    where
-    status :: [(Text, Maybe Bool)]
-    status = [("Open", Just False), ("Closed", Just True), ("All", Nothing)]
 
 ticketFilterForm :: Form TicketFilter
 ticketFilterForm = renderDivs ticketFilterAForm

src/Vervis/Handler/Ticket.hs

@@ -86,6 +86,7 @@ import Vervis.GraphProxy (ticketDepGraph)
 import Vervis.MediaType (MediaType (Markdown))
 import Vervis.Model
 import Vervis.Model.Ident
+import Vervis.Model.Ticket
 import Vervis.Model.Workflow
 import Vervis.Render (renderSourceT)
 import Vervis.Settings (widgetFile)
@@ -116,7 +117,7 @@ getTicketsR shar proj = do
             ( ticket ^. TicketNumber
             , sharer
             , ticket ^. TicketTitle
-            , ticket ^. TicketDone
+            , ticket ^. TicketStatus
             )
     defaultLayout $(widgetFile "ticket/list")
 
@@ -145,7 +146,7 @@ postTicketsR shar proj = do
                         , ticketTitle    = ntTitle nt
                         , ticketDesc     = ntDesc nt
                         , ticketAssignee = Nothing
-                        , ticketDone     = False
+                        , ticketStatus   = TSNew
                         , ticketClosed   = UTCTime (ModifiedJulianDay 0) 0
                         , ticketCloser   = author
                         , ticketDiscuss  = did
@@ -221,11 +222,11 @@ getTicketR shar proj num = do
                 sharer <- get404 $ personIdent person
                 return (sharer, fromMaybe False $ (== apid) <$> mpid)
             closer <-
-                if ticketDone ticket
+                case ticketStatus ticket of
-                    then do
+                    TSClosed -> do
                         person <- get404 $ ticketCloser ticket
                         get404 $ personIdent person
-                    else return author
+                    _ -> return author
             tparams <- getTicketTextParams tid wid
             eparams <- getTicketEnumParams tid wid
             deps <- select $ from $ \ (dep `InnerJoin` t) -> do
@@ -331,12 +332,12 @@ postTicketCloseR shr prj num = do
             Entity s _ <- getBy404 $ UniqueSharer shr
             Entity p _ <- getBy404 $ UniqueProject prj s
             getBy404 $ UniqueTicket p num
-        if ticketDone ticket
+        case ticketStatus ticket of
-            then return False
+            TSClosed -> return False
-            else do
+            _        -> do
                 update tid
                     [ TicketAssignee =. Nothing
-                    , TicketDone     =. True
+                    , TicketStatus   =. TSClosed
                     , TicketClosed   =. now
                     , TicketCloser   =. pid
                     ]
@@ -356,14 +357,14 @@ postTicketOpenR shr prj num = do
             Entity s _ <- getBy404 $ UniqueSharer shr
             Entity p _ <- getBy404 $ UniqueProject prj s
             getBy404 $ UniqueTicket p num
-        if ticketDone ticket
+        case ticketStatus ticket of
-            then do
+            TSClosed -> do
                 update tid
-                    [ TicketDone   =. False
+                    [ TicketStatus =. TSTodo
                     , TicketCloser =. ticketCreator ticket
                     ]
                 return True
-            else return False
+            _        -> return False
     setMessage $
         if succ
             then "Ticket reopened"
@@ -378,14 +379,17 @@ postTicketClaimR shr prj num = do
             Entity s _ <- getBy404 $ UniqueSharer shr
             Entity p _ <- getBy404 $ UniqueProject prj s
             getBy404 $ UniqueTicket p num
-        case (ticketDone ticket, ticketAssignee ticket) of
+        case (ticketStatus ticket, ticketAssignee ticket) of
-            (True, _) ->
+            (TSNew, _) ->
+                return $
+                Just "The ticket isn’t accepted yet. Can’t claim it."
+            (TSClosed, _) ->
                 return $
                 Just "The ticket is closed. Can’t claim closed tickets."
-            (False, Just _) ->
+            (TSTodo, Just _) ->
                 return $
                 Just "The ticket is already assigned to someone."
-            (False, Nothing) -> do
+            (TSTodo, Nothing) -> do
                 update tid [TicketAssignee =. Just pid]
                 return Nothing
     setMessage $ fromMaybe "The ticket is now assigned to you." mmsg
@@ -399,16 +403,20 @@ postTicketUnclaimR shr prj num = do
             Entity s _ <- getBy404 $ UniqueSharer shr
             Entity p _ <- getBy404 $ UniqueProject prj s
             getBy404 $ UniqueTicket p num
-        case ((== pid) <$> ticketAssignee ticket, ticketDone ticket) of
+        case ((== pid) <$> ticketAssignee ticket, ticketStatus ticket) of
             (Nothing, _) ->
                 return $ Just "The ticket is already unassigned."
             (Just False, _) ->
                 return $ Just "The ticket is assigned to someone else."
-            (Just True, True) -> do
+            (Just True, TSNew) -> do
+                $logWarn "Found a new claimed ticket, this is invalid"
+                return $
+                    Just "The ticket isn’t accepted yet. Can’t unclaim it."
+            (Just True, TSClosed) -> do
                 $logWarn "Found a closed claimed ticket, this is invalid"
                 return $
                     Just "The ticket is closed. Can’t unclaim closed tickets."
-            (Just True, False) -> do
+            (Just True, TSTodo) -> do
                 update tid [TicketAssignee =. Nothing]
                 return Nothing
     setMessage $ fromMaybe "The ticket is now unassigned." mmsg
@@ -425,10 +433,11 @@ getTicketAssignR shr prj num = do
     let msg t = do
             setMessage t
             redirect $ TicketR shr prj num
-    case (ticketDone ticket, ticketAssignee ticket) of
+    case (ticketStatus ticket, ticketAssignee ticket) of
-        (True, _) -> msg "The ticket is closed. Can’t assign closed tickets."
+        (TSNew, _) -> msg "The ticket isn’t accepted yet. Can’t assign it."
-        (False, Just _) -> msg "The ticket is already assigned to someone."
+        (TSClosed, _) -> msg "The ticket is closed. Can’t assign it."
-        (False, Nothing) -> do
+        (TSTodo, Just _) -> msg "The ticket is already assigned to someone."
+        (TSTodo, Nothing) -> do
             ((_result, widget), enctype) <-
                 runFormPost $ assignTicketForm vpid jid
             defaultLayout $(widgetFile "ticket/assign")
@@ -444,10 +453,11 @@ postTicketAssignR shr prj num = do
     let msg t = do
             setMessage t
             redirect $ TicketR shr prj num
-    case (ticketDone ticket, ticketAssignee ticket) of
+    case (ticketStatus ticket, ticketAssignee ticket) of
-        (True, _) -> msg "The ticket is closed. Can’t assign closed tickets."
+        (TSNew, _) -> msg "The ticket isn’t accepted yet. Can’t assign it."
-        (False, Just _) -> msg "The ticket is already assigned to someone."
+        (TSClosed, _) -> msg "The ticket is closed. Can’t assign it."
-        (False, Nothing) -> do
+        (TSTodo, Just _) -> msg "The ticket is already assigned to someone."
+        (TSTodo, Nothing) -> do
             ((result, widget), enctype) <-
                 runFormPost $ assignTicketForm vpid jid
             case result of
@@ -474,16 +484,20 @@ postTicketUnassignR shr prj num = do
             Entity s _ <- getBy404 $ UniqueSharer shr
             Entity p _ <- getBy404 $ UniqueProject prj s
             getBy404 $ UniqueTicket p num
-        case ((== pid) <$> ticketAssignee ticket, ticketDone ticket) of
+        case ((== pid) <$> ticketAssignee ticket, ticketStatus ticket) of
             (Nothing, _) ->
                 return $ Just "The ticket is already unassigned."
             (Just True, _) ->
                 return $ Just "The ticket is assigned to you, unclaim instead."
-            (Just False, True) -> do
+            (Just False, TSNew) -> do
+                $logWarn "Found a new claimed ticket, this is invalid"
+                return $
+                    Just "The ticket isn’t accepted yet. Can’t unclaim it."
+            (Just False, TSClosed) -> do
                 $logWarn "Found a closed claimed ticket, this is invalid"
                 return $
                     Just "The ticket is closed. Can’t unclaim closed tickets."
-            (Just False, False) -> do
+            (Just False, TSTodo) -> do
                 update tid [TicketAssignee =. Nothing]
                 return Nothing
     setMessage $ fromMaybe "The ticket is now unassigned." mmsg
@@ -658,7 +672,7 @@ getTicketDeps forward shr prj num = do
                     ( ticket ^. TicketNumber
                     , sharer
                     , ticket ^. TicketTitle
-                    , ticket ^. TicketDone
+                    , ticket ^. TicketStatus
                     )
     defaultLayout $(widgetFile "ticket/dep/list")
 

src/Vervis/Model.hs

@@ -29,6 +29,7 @@ import Vervis.Model.Group
 import Vervis.Model.Ident
 import Vervis.Model.Repo
 import Vervis.Model.Role
+import Vervis.Model.Ticket
 import Vervis.Model.Workflow
 
 -- You can define all of your database entities in the entities file.

src/Vervis/Model/Ticket.hs

@@ -0,0 +1,28 @@
+{- 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/>.
+ -}
+
+module Vervis.Model.Ticket
+    ( TicketStatus (..)
+    )
+where
+
+import Prelude
+
+import Database.Persist.TH
+
+data TicketStatus = TSNew | TSTodo | TSClosed
+    deriving (Eq, Show, Read, Bounded, Enum)
+
+derivePersistField "TicketStatus"

src/Vervis/Ticket.hs

@@ -48,7 +48,7 @@ getTicketSummaries jid = do
                 , tsCreatedBy = s
                 , tsCreatedAt = c
                 , tsTitle     = t
-                , tsDone      = d
+                , tsStatus    = d
                 , tsComments  = r
                 }
     fmap (map toSummary) $ select $ from $
@@ -62,7 +62,7 @@ getTicketSummaries jid = do
                 , s
                 , t ^. TicketCreated
                 , t ^. TicketTitle
-                , t ^. TicketDone
+                , t ^. TicketStatus
                 , d ^. DiscussionNextMessage -. val 1
                 )
 

src/Vervis/TicketFilter.hs

@@ -25,9 +25,10 @@ import Data.Default.Class
 import Database.Esqueleto
 
 import Vervis.Model
+import Vervis.Model.Ticket
 
 data TicketFilter = TicketFilter
-    { tfStatus :: Maybe Bool
+    { tfStatus :: Maybe TicketStatus
     }
 
 instance Default TicketFilter where
@@ -43,7 +44,7 @@ ticketFilter
 ticketFilter tf ticket =
     case tfStatus tf of
         Nothing -> Nothing
-        Just t  -> Just $ ticket ^. TicketDone ==. val t
+        Just t  -> Just $ ticket ^. TicketStatus ==. val t
 
 filterTickets
     :: Esqueleto q e b

src/Vervis/Widget/Ticket.hs

@@ -41,6 +41,7 @@ import Data.Graph.DirectedAcyclic.View.Tree
 import Vervis.Foundation
 import Vervis.Model
 import Vervis.Model.Ident
+import Vervis.Model.Ticket
 import Vervis.Settings (widgetFile)
 import Vervis.Style
 import Vervis.Time (showDate)
@@ -51,14 +52,15 @@ data TicketSummary = TicketSummary
     , tsCreatedBy :: Sharer
     , tsCreatedAt :: UTCTime
     , tsTitle     :: Text
-    , tsDone      :: Bool
+    , tsStatus    :: TicketStatus
     , tsComments  :: Int
     }
 
 ticketDepW :: ShrIdent -> PrjIdent -> Ticket -> Widget
 ticketDepW shr prj ticket = do
+    cNew <- newIdent
     cTodo <- newIdent
-    cDone <- newIdent
+    cClosed <- newIdent
     $(widgetFile "ticket/widget/dep")
 
 ticketSummaryW
@@ -68,8 +70,9 @@ ticketSummaryW
     -> Maybe (HashMap Int Int)
     -> Widget
 ticketSummaryW shr prj ts mcs = do
+    cNew <- newIdent
     cTodo <- newIdent
-    cDone <- newIdent
+    cClosed <- newIdent
     let tshow = T.pack . show
         mparams = map (tshow *** tshow) . M.toList <$> mcs
     mroute <- getCurrentRoute

templates/ticket/dep/list.hamlet

@@ -17,10 +17,10 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
     <th>Number
     <th>Author
     <th>Title
-    <th>Done
+    <th>Status
     $if forward
       <th>Remove dependency
-  $forall (Value number, Entity _ author, Value title, Value done) <- rows
+  $forall (Value number, Entity _ author, Value title, Value status) <- rows
     <tr>
       <td>
         <a href=@{TicketR shr prj number}>#{number}
@@ -29,7 +29,7 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
       <td>
         <a href=@{TicketR shr prj number}>#{title}
       <td>
-        #{done}
+        #{show status}
       $if forward
         <td>
           <form method=POST action=@{TicketDepR shr prj num number}>

templates/ticket/list.hamlet

@@ -27,8 +27,8 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
     <th>Number
     <th>Author
     <th>Title
-    <th>Done
+    <th>Status
-  $forall (Value number, Entity _ author, Value title, Value done) <- rows
+  $forall (Value number, Entity _ author, Value title, Value status) <- rows
     <tr>
       <td>
         <a href=@{TicketR shar proj number}>#{number}
@@ -37,4 +37,4 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
       <td>
         <a href=@{TicketR shar proj number}>#{title}
       <td>
-        #{done}
+        #{show status}

templates/ticket/one.hamlet

@@ -45,7 +45,7 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
   Created on #{showDate $ ticketCreated ticket} by
   ^{personLinkW author}
 
-$if not $ ticketDone ticket
+$if ticketStatus ticket /= TSClosed
   <p>
     $maybe (assignee, me) <- massignee
       $if me
@@ -84,17 +84,23 @@ $if not $ ticketDone ticket
 
 <p>
   Status: #
-  $if ticketDone ticket
+  $case ticketStatus ticket
-    Closed on #{showDate $ ticketClosed ticket} by
+    $of TSNew
-    ^{personLinkW closer}.
+      Open, new.
 
-    <form method=POST action=@{TicketOpenR shar proj num}>
+      <form method=POST action=@{TicketCloseR shar proj num}>
-      <input type=submit value="Reopen this ticket">
+        <input type=submit value="Close this ticket">
-  $else
+    $of TSTodo
-    Open.
+      Open, to do.
 
-    <form method=POST action=@{TicketCloseR shar proj num}>
+      <form method=POST action=@{TicketCloseR shar proj num}>
-      <input type=submit value="Close this ticket">
+        <input type=submit value="Close this ticket">
+    $of TSClosed
+      Closed on #{showDate $ ticketClosed ticket} by
+      ^{personLinkW closer}.
+
+      <form method=POST action=@{TicketOpenR shar proj num}>
+        <input type=submit value="Reopen this ticket">
 
 <h2>#{ticketTitle ticket}
 

templates/ticket/widget/dep.cassius

@@ -13,8 +13,11 @@
  * <http://creativecommons.org/publicdomain/zero/1.0/>.
  */
 
+.#{cNew}
+    color: #{dark yellow}
+
 .#{cTodo}
     color: #{dark red}
 
-.#{cDone}
+.#{cClosed}
     color: #{dark green}

templates/ticket/widget/dep.hamlet

@@ -12,11 +12,15 @@ $# 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/>.
 
-$if ticketDone ticket
+$case ticketStatus ticket
-  <span .#{cDone}>
+  $of TSNew
-    ☒
+    <span .#{cNew}>
-$else
+      ⬚
-  <span .#{cTodo}>
+  $of TSTodo
-    ☐
+    <span .#{cTodo}>
+      ☐
+  $of TSClosed
+    <span .#{cClosed}>
+      ☒
 <a href=@{TicketR shr prj $ ticketNumber ticket}>
   #{ticketTitle ticket}

templates/ticket/widget/summary.cassius

@@ -13,8 +13,11 @@
  * <http://creativecommons.org/publicdomain/zero/1.0/>.
  */
 
+.#{cNew}
+    color: #{dark yellow}
+
 .#{cTodo}
     color: #{dark red}
 
-.#{cDone}
+.#{cClosed}
     color: #{dark green}

templates/ticket/widget/summary.hamlet

@@ -13,12 +13,16 @@ $# with this software. If not, see
 $# <http://creativecommons.org/publicdomain/zero/1.0/>.
 
 <div>
-  $if tsDone ts
+  $case tsStatus ts
-    <span .#{cDone}>
+    $of TSNew
-      ☒
+      <span .#{cNew}>
-  $else
+        ⬚
-    <span .#{cTodo}>
+    $of TSTodo
-      ☐
+      <span .#{cTodo}>
+        ☐
+    $of TSClosed
+      <span .#{cClosed}>
+        ☒
 
   <a href=@{TicketR shr prj $ tsNumber ts}>
     #{tsNumber ts}

vervis.cabal

@@ -149,6 +149,7 @@ library
                        Vervis.Model.Ident
                        Vervis.Model.Repo
                        Vervis.Model.Role
+                       Vervis.Model.Ticket
                        Vervis.Model.Workflow
                        Vervis.Paginate
                        Vervis.Palette