forge/Vervis
1
0
Fork 0
Code Pull requests Activity

Turn boolean ticketDone into TicketStatus enum

Browse source
This commit is contained in:
fr33domlover 2016-08-11 00:44:11 +00:00
parent 26624404ca
commit 3329b49b2e
16 changed files with 140 additions and 76 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
config/models
View file

@ -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

7
src/Vervis/Form/Ticket.hs
View file

@ -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

78
src/Vervis/Handler/Ticket.hs
View file

@ -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")

1
src/Vervis/Model.hs
View file

@ -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.

28
src/Vervis/Model/Ticket.hs Normal file
View file

@ -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"

4
src/Vervis/Ticket.hs
View file

@ -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
)

5
src/Vervis/TicketFilter.hs
View file

@ -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

9
src/Vervis/Widget/Ticket.hs
View file

@ -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

6
templates/ticket/dep/list.hamlet
View file

@ -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}>

6
templates/ticket/list.hamlet
View file

@ -27,8 +27,8 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
<th>Number
<th>Author
<th>Title
<th>Done
$forall (Value number, Entity _ author, Value title, Value done) <- rows
<th>Status
$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}

20
templates/ticket/one.hamlet
View file

@ -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
$of TSNew
Open, new.
<form method=POST action=@{TicketCloseR shar proj num}>
<input type=submit value="Close this ticket">
$of TSTodo
Open, to do.
<form method=POST action=@{TicketCloseR shar proj num}>
<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">
$else
Open.
<form method=POST action=@{TicketCloseR shar proj num}>
<input type=submit value="Close this ticket">
<h2>#{ticketTitle ticket}

5
templates/ticket/widget/dep.cassius
View file

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

12
templates/ticket/widget/dep.hamlet
View file

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

5
templates/ticket/widget/summary.cassius
View file

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

12
templates/ticket/widget/summary.hamlet
View file

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

1
vervis.cabal
View file

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