Per-workflow custom ticket fields

config/models

@@ -162,6 +162,16 @@ Workflow
 
     UniqueWorkflow sharer ident
 
+WorkflowField
+    workflow WorkflowId
+    ident    FldIdent
+    name     Text
+    desc     Text              Maybe
+    type     WorkflowFieldType
+    -- filter   TicketStatusFilterId
+
+    UniqueWorkflowField workflow ident
+
 Ticket
     project  ProjectId
     number   Int

config/routes

@@ -99,6 +99,9 @@
 /s/#ShrIdent/w                               WorkflowsR            GET POST
 /s/#ShrIdent/w/!new                          WorkflowNewR          GET
 /s/#ShrIdent/w/#WflIdent                     WorkflowR             GET DELETE POST
+/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/p/#PrjIdent/t                   TicketsR              GET POST
 /s/#ShrIdent/p/#PrjIdent/t/!tree             TicketTreeR           GET

src/Vervis/Field/Workflow.hs

@@ -15,6 +15,7 @@
 
 module Vervis.Field.Workflow
     ( newWorkflowIdentField
+    , newFieldIdentField
     )
 where
 
@@ -25,7 +26,7 @@ import Data.Char.Local (isAsciiLetter)
 import Data.Text (split)
 import Database.Esqueleto
 
-import Vervis.Model.Ident (WflIdent, wfl2text, text2wfl)
+import Vervis.Model.Ident
 
 checkTemplate :: Field Handler Text -> Field Handler Text
 checkTemplate =
@@ -33,14 +34,14 @@ checkTemplate =
         wordOk w = (not . null) w && all charOk w
         identOk t = (not . null) t && all wordOk (split (== '-') t)
         msg :: Text
-        msg =
+        msg = "The identifier must be a sequence of one or more words \
-            "The workflow identifier must be a sequence of one or more words \
             \separated by hyphens (‘-’), and each such word may contain \
             \ASCII letters and digits."
     in  checkBool identOk msg
 
-checkUniqueCI :: SharerId -> Field Handler WflIdent -> Field Handler WflIdent
+checkWflUniqueCI
-checkUniqueCI sid = checkM $ \ wfl -> do
+    :: SharerId -> Field Handler WflIdent -> Field Handler WflIdent
+checkWflUniqueCI sid = checkM $ \ wfl -> do
     sames <- runDB $ select $ from $ \ workflow -> do
         where_ $
             workflow ^. WorkflowSharer ==. val sid &&.
@@ -55,4 +56,23 @@ workflowIdentField :: Field Handler WflIdent
 workflowIdentField = convertField text2wfl wfl2text $ checkTemplate textField
 
 newWorkflowIdentField :: SharerId -> Field Handler WflIdent
-newWorkflowIdentField sid = checkUniqueCI sid workflowIdentField
+newWorkflowIdentField sid = checkWflUniqueCI sid workflowIdentField
+
+checkFldUniqueCI
+    :: WorkflowId -> Field Handler FldIdent -> Field Handler FldIdent
+checkFldUniqueCI wid = checkM $ \ fld -> do
+    sames <- runDB $ select $ from $ \ field -> do
+        where_ $
+            field ^. WorkflowFieldWorkflow ==. val wid &&.
+            lower_ (field ^. WorkflowFieldIdent) ==. lower_ (val fld)
+        limit 1
+        return ()
+    return $ if null sames
+        then Right fld
+        else Left ("There is already a field by that name" :: Text)
+
+fieldIdentField :: Field Handler FldIdent
+fieldIdentField = convertField text2fld fld2text $ checkTemplate textField
+
+newFieldIdentField :: WorkflowId -> Field Handler FldIdent
+newFieldIdentField wid = checkFldUniqueCI wid fieldIdentField

src/Vervis/Form/Workflow.hs

@@ -16,6 +16,8 @@
 module Vervis.Form.Workflow
     ( NewWorkflow (..)
     , newWorkflowForm
+    , NewField (..)
+    , newFieldForm
     )
 where
 
@@ -28,6 +30,7 @@ import qualified Database.Esqueleto as E ((==.))
 import Vervis.Field.Workflow
 import Vervis.Model
 import Vervis.Model.Ident
+import Vervis.Model.Workflow
 
 data NewWorkflow = NewWorkflow
     { nwIdent :: WflIdent
@@ -43,3 +46,20 @@ newWorkflowAForm sid = NewWorkflow
 
 newWorkflowForm :: SharerId -> Form NewWorkflow
 newWorkflowForm sid = renderDivs $ newWorkflowAForm sid
+
+data NewField = NewField
+    { nfIdent :: FldIdent
+    , nfName  :: Text
+    , nfDesc  :: Maybe Text
+    , nfType  :: WorkflowFieldType
+    }
+
+newFieldAForm :: WorkflowId -> AForm Handler NewField
+newFieldAForm wid = NewField
+    <$> areq (newFieldIdentField wid)  "Identifier*" Nothing
+    <*> areq textField                 "Name*"       Nothing
+    <*> aopt textField                 "Description" Nothing
+    <*> areq (selectField optionsEnum) "Type*"       Nothing
+
+newFieldForm :: WorkflowId -> Form NewField
+newFieldForm wid = renderDivs $ newFieldAForm wid

src/Vervis/Foundation.hs

@@ -168,6 +168,9 @@ instance Yesod App where
         (WorkflowsR shr            , _   ) -> personOrGroupAdmin shr
         (WorkflowNewR shr          , _   ) -> personOrGroupAdmin shr
         (WorkflowR shr _wfl        , _   ) -> personOrGroupAdmin shr
+        (WorkflowFieldsR shr _     , _   ) -> personOrGroupAdmin shr
+        (WorkflowFieldNewR shr _   , _   ) -> personOrGroupAdmin shr
+        (WorkflowFieldR shr _ _    , _   ) -> personOrGroupAdmin shr
 
         (TicketsR shar _           , True) -> person shar
         (TicketNewR _ _            , _   ) -> personAny
@@ -468,6 +471,15 @@ instance YesodBreadcrumbs App where
         WorkflowR shr wfl                -> ( wfl2text wfl
                                             , Just $ WorkflowsR shr
                                             )
+        WorkflowFieldsR shr wfl          -> ( "Fields"
+                                            , Just $ WorkflowR shr wfl
+                                            )
+        WorkflowFieldNewR shr wfl        -> ( "New"
+                                            , Just $ WorkflowFieldsR shr wfl
+                                            )
+        WorkflowFieldR shr wfl fld       -> ( fld2text fld
+                                            , Just $ WorkflowFieldsR shr wfl
+                                            )
 
         TicketsR shar proj               -> ( "Tickets"
                                             , Just $ ProjectR shar proj

src/Vervis/Handler/Workflow.hs

@@ -20,6 +20,12 @@ module Vervis.Handler.Workflow
     , getWorkflowR
     , deleteWorkflowR
     , postWorkflowR
+    , getWorkflowFieldsR
+    , postWorkflowFieldsR
+    , getWorkflowFieldNewR
+    , getWorkflowFieldR
+    , deleteWorkflowFieldR
+    , postWorkflowFieldR
     )
 where
 
@@ -95,3 +101,66 @@ postWorkflowR shr wfl = do
     case mmethod of
         Just "DELETE" -> deleteWorkflowR shr wfl
         _             -> notFound
+
+getWorkflowFieldsR :: ShrIdent -> WflIdent -> Handler Html
+getWorkflowFieldsR shr wfl = do
+    fs <- runDB $ do
+        Entity sid _ <- getBy404 $ UniqueSharer shr
+        Entity wid _ <- getBy404 $ UniqueWorkflow sid wfl
+        selectList [WorkflowFieldWorkflow ==. wid] []
+    defaultLayout $(widgetFile "workflow/field/list")
+
+postWorkflowFieldsR :: ShrIdent -> WflIdent -> Handler Html
+postWorkflowFieldsR shr wfl = do
+    wid <- runDB $ do
+        Entity sid _ <- getBy404 $ UniqueSharer shr
+        Entity wid _ <- getBy404 $ UniqueWorkflow sid wfl
+        return wid
+    ((result, widget), enctype) <- runFormPost $ newFieldForm wid
+    case result of
+        FormSuccess nf -> do
+            let field = WorkflowField
+                    { workflowFieldWorkflow = wid
+                    , workflowFieldIdent    = nfIdent nf
+                    , workflowFieldName     = nfName nf
+                    , workflowFieldDesc     = nfDesc nf
+                    , workflowFieldType     = nfType nf
+                    }
+            runDB $ insert_ field
+            setMessage "Workflow field added."
+            redirect $ WorkflowFieldR shr wfl (nfIdent nf)
+        FormMissing -> do
+            setMessage "Field(s) missing"
+            defaultLayout $(widgetFile "workflow/field/new")
+        FormFailure _l -> do
+            setMessage "Workflow field creation failed, see below"
+            defaultLayout $(widgetFile "workflow/field/new")
+
+getWorkflowFieldNewR :: ShrIdent -> WflIdent -> Handler Html
+getWorkflowFieldNewR shr wfl = do
+    wid <- runDB $ do
+        Entity sid _ <- getBy404 $ UniqueSharer shr
+        Entity wid _ <- getBy404 $ UniqueWorkflow sid wfl
+        return wid
+    ((_result, widget), enctype) <- runFormPost $ newFieldForm wid
+    defaultLayout $(widgetFile "workflow/field/new")
+
+getWorkflowFieldR :: ShrIdent -> WflIdent -> FldIdent -> Handler Html
+getWorkflowFieldR shr wfl fld = do
+    f <- runDB $ do
+        Entity sid _ <- getBy404 $ UniqueSharer shr
+        Entity wid _ <- getBy404 $ UniqueWorkflow sid wfl
+        Entity _ f <- getBy404 $ UniqueWorkflowField wid fld
+        return f
+    defaultLayout $(widgetFile "workflow/field/one")
+
+deleteWorkflowFieldR :: ShrIdent -> WflIdent -> FldIdent -> Handler Html
+deleteWorkflowFieldR shr wfl fld =
+    error "Not implemented, not sure whether to allow it"
+
+postWorkflowFieldR :: ShrIdent -> WflIdent -> FldIdent -> Handler Html
+postWorkflowFieldR shr wfl fld = do
+    mmethod <- lookupPostParam "_method"
+    case mmethod of
+        Just "DELETE" -> deleteWorkflowFieldR shr wfl fld
+        _             -> notFound

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.Workflow
 
 -- You can define all of your database entities in the entities file.
 -- You can find more information on persistent and how to declare entities at:

src/Vervis/Model/Ident.hs

@@ -34,6 +34,9 @@ module Vervis.Model.Ident
     , WflIdent (..)
     , wfl2text
     , text2wfl
+    , FldIdent (..)
+    , fld2text
+    , text2fld
     )
 where
 
@@ -112,3 +115,13 @@ wfl2text = CI.original . unWflIdent
 
 text2wfl :: Text -> WflIdent
 text2wfl = WflIdent . CI.mk
+
+newtype FldIdent = FldIdent { unFldIdent :: CI Text }
+    deriving
+        (Eq, Show, Read, PersistField, PersistFieldSql, SqlString, PathPiece)
+
+fld2text :: FldIdent -> Text
+fld2text = CI.original . unFldIdent
+
+text2fld :: Text -> FldIdent
+text2fld = FldIdent . CI.mk

src/Vervis/Model/Workflow.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.Workflow
+    ( WorkflowFieldType (..)
+    )
+where
+
+import Prelude
+
+import Database.Persist.TH
+
+data WorkflowFieldType = WFTText
+    deriving (Eq, Show, Read, Bounded, Enum)
+
+derivePersistField "WorkflowFieldType"

templates/workflow/field/list.hamlet

@@ -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 _fid f <- fs
+    <li>
+      <a href=@{WorkflowFieldR shr wfl $ workflowFieldIdent f}>
+        #{workflowFieldName f}

templates/workflow/field/new.hamlet

@@ -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=@{WorkflowFieldsR shr wfl} enctype=#{enctype}>
+  ^{widget}
+  <input type="submit">

templates/workflow/field/one.hamlet

@@ -0,0 +1,26 @@
+$# 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=@{WorkflowFieldR shr wfl fld}>
+    <input type="hidden" name="_method" value="DELETE">
+    <input type="submit" value="Delete this field">
+
+<ul>
+  <li>
+    Display name: #{workflowFieldName f}
+  <li>
+    Description: #{fromMaybe "(none)" $ workflowFieldDesc f}
+  <li>
+    Type: #{show $ workflowFieldType f}

templates/workflow/one.hamlet

@@ -22,3 +22,6 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
     Human-friendly name: #{fromMaybe "(none)" $ workflowName w}
   <li>
     Description: #{fromMaybe "(none)" $ workflowDesc w}
+  <li>
+    <a href=@{WorkflowFieldsR shr $ workflowIdent w}>
+      Fields

vervis.cabal

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