Turn boolean ticketDone into TicketStatus enum

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)
-    where
-    status :: [(Text, Maybe Bool)]
-    status = [("Open", Just False), ("Closed", Just True), ("All", Nothing)]
+    <$> aopt (selectField optionsEnum) "Status*" (Just 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
-                    then do
+                case ticketStatus ticket of
+                    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
-            then return False
-            else do
+        case ticketStatus ticket of
+            TSClosed -> return False
+            _        -> 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
-            then do
+        case ticketStatus ticket of
+            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
-            (True, _) ->
+        case (ticketStatus ticket, ticketAssignee ticket) of
+            (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
-        (True, _) -> msg "The ticket is closed. Can’t assign closed tickets."
-        (False, Just _) -> msg "The ticket is already assigned to someone."
-        (False, Nothing) -> do
+    case (ticketStatus ticket, ticketAssignee ticket) of
+        (TSNew, _) -> msg "The ticket isn’t accepted yet. Can’t assign it."
+        (TSClosed, _) -> msg "The ticket is closed. Can’t assign it."
+        (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
-        (True, _) -> msg "The ticket is closed. Can’t assign closed tickets."
-        (False, Just _) -> msg "The ticket is already assigned to someone."
-        (False, Nothing) -> do
+    case (ticketStatus ticket, ticketAssignee ticket) of
+        (TSNew, _) -> msg "The ticket isn’t accepted yet. Can’t assign it."
+        (TSClosed, _) -> msg "The ticket is closed. Can’t assign it."
+        (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