Per-workflow custom ticket field enum types

This commit is contained in:
fr33domlover 2016-08-08 14:48:38 +00:00
parent 01385c480b
commit 7ee28b97d2
11 changed files with 220 additions and 1 deletions

View file

@ -172,6 +172,14 @@ WorkflowField
UniqueWorkflowField workflow ident
WorkflowFieldEnum
workflow WorkflowId
ident EnmIdent
name Text
desc Text Maybe
UniqueWorkflowFieldEnum workflow ident
Ticket
project ProjectId
number Int

View file

@ -102,6 +102,9 @@
/s/#ShrIdent/w/#WflIdent/f WorkflowFieldsR GET POST
/s/#ShrIdent/w/#WflIdent/f/!new WorkflowFieldNewR GET
/s/#ShrIdent/w/#WflIdent/f/#FldIdent WorkflowFieldR GET DELETE POST
/s/#ShrIdent/w/#WflIdent/e WorkflowEnumsR GET POST
/s/#ShrIdent/w/#WflIdent/e/!new WorkflowEnumNewR GET
/s/#ShrIdent/w/#WflIdent/e/#EnmIdent WorkflowEnumR GET DELETE POST
/s/#ShrIdent/p/#PrjIdent/t TicketsR GET POST
/s/#ShrIdent/p/#PrjIdent/t/!tree TicketTreeR GET

View file

@ -16,6 +16,7 @@
module Vervis.Field.Workflow
( newWorkflowIdentField
, newFieldIdentField
, newEnumIdentField
)
where
@ -76,3 +77,22 @@ fieldIdentField = convertField text2fld fld2text $ checkTemplate textField
newFieldIdentField :: WorkflowId -> Field Handler FldIdent
newFieldIdentField wid = checkFldUniqueCI wid fieldIdentField
checkEnmUniqueCI
:: WorkflowId -> Field Handler EnmIdent -> Field Handler EnmIdent
checkEnmUniqueCI wid = checkM $ \ enm -> do
sames <- runDB $ select $ from $ \ enum -> do
where_ $
enum ^. WorkflowFieldEnumWorkflow ==. val wid &&.
lower_ (enum ^. WorkflowFieldEnumIdent) ==. lower_ (val enm)
limit 1
return ()
return $ if null sames
then Right enm
else Left ("There is already an enum by that name" :: Text)
enumIdentField :: Field Handler EnmIdent
enumIdentField = convertField text2enm enm2text $ checkTemplate textField
newEnumIdentField :: WorkflowId -> Field Handler EnmIdent
newEnumIdentField wid = checkEnmUniqueCI wid enumIdentField

View file

@ -18,6 +18,8 @@ module Vervis.Form.Workflow
, newWorkflowForm
, NewField (..)
, newFieldForm
, NewEnum (..)
, newEnumForm
)
where
@ -63,3 +65,18 @@ newFieldAForm wid = NewField
newFieldForm :: WorkflowId -> Form NewField
newFieldForm wid = renderDivs $ newFieldAForm wid
data NewEnum = NewEnum
{ neIdent :: EnmIdent
, neName :: Text
, neDesc :: Maybe Text
}
newEnumAForm :: WorkflowId -> AForm Handler NewEnum
newEnumAForm wid = NewEnum
<$> areq (newEnumIdentField wid) "Identifier*" Nothing
<*> areq textField "Name*" Nothing
<*> aopt textField "Description" Nothing
newEnumForm :: WorkflowId -> Form NewEnum
newEnumForm wid = renderDivs $ newEnumAForm wid

View file

@ -171,6 +171,9 @@ instance Yesod App where
(WorkflowFieldsR shr _ , _ ) -> personOrGroupAdmin shr
(WorkflowFieldNewR shr _ , _ ) -> personOrGroupAdmin shr
(WorkflowFieldR shr _ _ , _ ) -> personOrGroupAdmin shr
(WorkflowEnumsR shr _ , _ ) -> personOrGroupAdmin shr
(WorkflowEnumNewR shr _ , _ ) -> personOrGroupAdmin shr
(WorkflowEnumR shr _ _ , _ ) -> personOrGroupAdmin shr
(TicketsR shar _ , True) -> person shar
(TicketNewR _ _ , _ ) -> personAny
@ -480,6 +483,15 @@ instance YesodBreadcrumbs App where
WorkflowFieldR shr wfl fld -> ( fld2text fld
, Just $ WorkflowFieldsR shr wfl
)
WorkflowEnumsR shr wfl -> ( "Enums"
, Just $ WorkflowR shr wfl
)
WorkflowEnumNewR shr wfl -> ( "New"
, Just $ WorkflowEnumsR shr wfl
)
WorkflowEnumR shr wfl fld -> ( enm2text fld
, Just $ WorkflowEnumsR shr wfl
)
TicketsR shar proj -> ( "Tickets"
, Just $ ProjectR shar proj

View file

@ -14,18 +14,27 @@
-}
module Vervis.Handler.Workflow
( getWorkflowsR
( -- * Workflow
getWorkflowsR
, postWorkflowsR
, getWorkflowNewR
, getWorkflowR
, deleteWorkflowR
, postWorkflowR
-- * Field
, getWorkflowFieldsR
, postWorkflowFieldsR
, getWorkflowFieldNewR
, getWorkflowFieldR
, deleteWorkflowFieldR
, postWorkflowFieldR
-- * Enum
, getWorkflowEnumsR
, postWorkflowEnumsR
, getWorkflowEnumNewR
, getWorkflowEnumR
, deleteWorkflowEnumR
, postWorkflowEnumR
)
where
@ -49,6 +58,10 @@ import Vervis.Model.Ident
import Vervis.Settings
import Vervis.Widget.Sharer
-------------------------------------------------------------------------------
-- Workflow
-------------------------------------------------------------------------------
getWorkflowsR :: ShrIdent -> Handler Html
getWorkflowsR shr = do
ws <- runDB $ do
@ -102,6 +115,10 @@ postWorkflowR shr wfl = do
Just "DELETE" -> deleteWorkflowR shr wfl
_ -> notFound
-------------------------------------------------------------------------------
-- Field
-------------------------------------------------------------------------------
getWorkflowFieldsR :: ShrIdent -> WflIdent -> Handler Html
getWorkflowFieldsR shr wfl = do
fs <- runDB $ do
@ -164,3 +181,69 @@ postWorkflowFieldR shr wfl fld = do
case mmethod of
Just "DELETE" -> deleteWorkflowFieldR shr wfl fld
_ -> notFound
-------------------------------------------------------------------------------
-- Enum
-------------------------------------------------------------------------------
getWorkflowEnumsR :: ShrIdent -> WflIdent -> Handler Html
getWorkflowEnumsR shr wfl = do
es <- runDB $ do
Entity sid _ <- getBy404 $ UniqueSharer shr
Entity wid _ <- getBy404 $ UniqueWorkflow sid wfl
selectList [WorkflowFieldEnumWorkflow ==. wid] []
defaultLayout $(widgetFile "workflow/enum/list")
postWorkflowEnumsR :: ShrIdent -> WflIdent -> Handler Html
postWorkflowEnumsR shr wfl = do
wid <- runDB $ do
Entity sid _ <- getBy404 $ UniqueSharer shr
Entity wid _ <- getBy404 $ UniqueWorkflow sid wfl
return wid
((result, widget), enctype) <- runFormPost $ newEnumForm wid
case result of
FormSuccess ne -> do
let enum = WorkflowFieldEnum
{ workflowFieldEnumWorkflow = wid
, workflowFieldEnumIdent = neIdent ne
, workflowFieldEnumName = neName ne
, workflowFieldEnumDesc = neDesc ne
}
runDB $ insert_ enum
setMessage "Workflow field enum added."
redirect $ WorkflowEnumR shr wfl (neIdent ne)
FormMissing -> do
setMessage "Field(s) missing"
defaultLayout $(widgetFile "workflow/enum/new")
FormFailure _l -> do
setMessage "Workflow field enum creation failed, see below"
defaultLayout $(widgetFile "workflow/enum/new")
getWorkflowEnumNewR :: ShrIdent -> WflIdent -> Handler Html
getWorkflowEnumNewR shr wfl = do
wid <- runDB $ do
Entity sid _ <- getBy404 $ UniqueSharer shr
Entity wid _ <- getBy404 $ UniqueWorkflow sid wfl
return wid
((_result, widget), enctype) <- runFormPost $ newEnumForm wid
defaultLayout $(widgetFile "workflow/enum/new")
getWorkflowEnumR :: ShrIdent -> WflIdent -> EnmIdent -> Handler Html
getWorkflowEnumR shr wfl enm = do
e <- runDB $ do
Entity sid _ <- getBy404 $ UniqueSharer shr
Entity wid _ <- getBy404 $ UniqueWorkflow sid wfl
Entity _ e <- getBy404 $ UniqueWorkflowFieldEnum wid enm
return e
defaultLayout $(widgetFile "workflow/enum/one")
deleteWorkflowEnumR :: ShrIdent -> WflIdent -> EnmIdent -> Handler Html
deleteWorkflowEnumR shr wfl enm =
error "Not implemented, not sure whether to allow it"
postWorkflowEnumR :: ShrIdent -> WflIdent -> EnmIdent -> Handler Html
postWorkflowEnumR shr wfl enm = do
mmethod <- lookupPostParam "_method"
case mmethod of
Just "DELETE" -> deleteWorkflowEnumR shr wfl enm
_ -> notFound

View file

@ -37,6 +37,9 @@ module Vervis.Model.Ident
, FldIdent (..)
, fld2text
, text2fld
, EnmIdent (..)
, enm2text
, text2enm
)
where
@ -125,3 +128,13 @@ fld2text = CI.original . unFldIdent
text2fld :: Text -> FldIdent
text2fld = FldIdent . CI.mk
newtype EnmIdent = EnmIdent { unEnmIdent :: CI Text }
deriving
(Eq, Show, Read, PersistField, PersistFieldSql, SqlString, PathPiece)
enm2text :: EnmIdent -> Text
enm2text = CI.original . unEnmIdent
text2enm :: Text -> EnmIdent
text2enm = EnmIdent . CI.mk

View file

@ -0,0 +1,19 @@
$# 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/>.
<ul>
$forall Entity _eid e <- es
<li>
<a href=@{WorkflowEnumR shr wfl $ workflowFieldEnumIdent e}>
#{workflowFieldEnumName e}

View file

@ -0,0 +1,17 @@
$# 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/>.
<form method="POST" action=@{WorkflowEnumsR shr wfl} enctype=#{enctype}>
^{widget}
<input type="submit">

View file

@ -0,0 +1,24 @@
$# 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/>.
<p>
<form method="POST" action=@{WorkflowEnumR shr wfl enm}>
<input type="hidden" name="_method" value="DELETE">
<input type="submit" value="Delete this enum">
<ul>
<li>
Display name: #{workflowFieldEnumName e}
<li>
Description: #{fromMaybe "(none)" $ workflowFieldEnumDesc e}

View file

@ -25,3 +25,6 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
<li>
<a href=@{WorkflowFieldsR shr $ workflowIdent w}>
Fields
<li>
<a href=@{WorkflowEnumsR shr $ workflowIdent w}>
Enums