Field enums aren't useful if you can't define values

config/models

@@ -180,6 +180,13 @@ WorkflowFieldEnum
 
     UniqueWorkflowFieldEnum workflow ident
 
+WorkflowFieldEnumCtor
+    enum WorkflowFieldEnumId
+    name Text
+    desc Text                Maybe
+
+    UniqueWorkflowFieldEnumCtor enum name
+
 Ticket
     project  ProjectId
     number   Int

config/routes

@@ -105,6 +105,9 @@
 /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/w/#WflIdent/e/#EnmIdent/c       WorkflowEnumCtorsR    GET POST
+/s/#ShrIdent/w/#WflIdent/e/#EnmIdent/c/!new  WorkflowEnumCtorNewR  GET
+/s/#ShrIdent/w/#WflIdent/e/#EnmIdent/c/#Text WorkflowEnumCtorR     PUT DELETE POST
 
 /s/#ShrIdent/p/#PrjIdent/t                   TicketsR              GET POST
 /s/#ShrIdent/p/#PrjIdent/t/!tree             TicketTreeR           GET

src/Vervis/Field/Workflow.hs

@@ -17,12 +17,13 @@ module Vervis.Field.Workflow
     ( newWorkflowIdentField
     , newFieldIdentField
     , newEnumIdentField
+    , newCtorNameField
     )
 where
 
 import Vervis.Import hiding ((==.))
 
-import Data.Char (isDigit)
+import Data.Char (isDigit, isAlphaNum)
 import Data.Char.Local (isAsciiLetter)
 import Data.Text (split)
 import Database.Esqueleto
@@ -96,3 +97,25 @@ enumIdentField = convertField text2enm enm2text $ checkTemplate textField
 
 newEnumIdentField :: WorkflowId -> Field Handler EnmIdent
 newEnumIdentField wid = checkEnmUniqueCI wid enumIdentField
+
+checkCtorName :: Field Handler Text -> Field Handler Text
+checkCtorName =
+    let charOk c = isAlphaNum c || c == ' '
+        nameOk t = (not . null) t && all charOk t
+        msg :: Text
+        msg = "The name may contain only letters, digits and spaces."
+    in  checkBool nameOk msg
+
+checkCtorUnique
+    :: WorkflowFieldEnumId -> Field Handler Text -> Field Handler Text
+checkCtorUnique eid = checkM $ \ name -> do
+    mc <- runDB $ getBy $ UniqueWorkflowFieldEnumCtor eid name
+    return $ case mc of
+        Nothing -> Right name
+        Just _  -> Left ("There is already an enum ctor by that name" :: Text)
+
+ctorNameField :: Field Handler Text
+ctorNameField = checkCtorName textField
+
+newCtorNameField :: WorkflowFieldEnumId -> Field Handler Text
+newCtorNameField eid = checkCtorUnique eid ctorNameField

src/Vervis/Form/Workflow.hs

@@ -20,6 +20,8 @@ module Vervis.Form.Workflow
     , newFieldForm
     , NewEnum (..)
     , newEnumForm
+    , NewCtor (..)
+    , newCtorForm
     )
 where
 
@@ -80,3 +82,16 @@ newEnumAForm wid = NewEnum
 
 newEnumForm :: WorkflowId -> Form NewEnum
 newEnumForm wid = renderDivs $ newEnumAForm wid
+
+data NewCtor = NewCtor
+    { ncName :: Text
+    , ncDesc :: Maybe Text
+    }
+
+newCtorAForm :: WorkflowFieldEnumId -> AForm Handler NewCtor
+newCtorAForm eid = NewCtor
+    <$> areq (newCtorNameField eid) "name*"       Nothing
+    <*> aopt textField              "Description" Nothing
+
+newCtorForm :: WorkflowFieldEnumId -> Form NewCtor
+newCtorForm eid = renderDivs $ newCtorAForm eid

src/Vervis/Foundation.hs

@@ -174,6 +174,9 @@ instance Yesod App where
         (WorkflowEnumsR shr _      , _   ) -> personOrGroupAdmin shr
         (WorkflowEnumNewR shr _    , _   ) -> personOrGroupAdmin shr
         (WorkflowEnumR shr _ _     , _   ) -> personOrGroupAdmin shr
+        (WorkflowEnumCtorsR shr _ _   , _   ) -> personOrGroupAdmin shr
+        (WorkflowEnumCtorNewR shr _ _ , _   ) -> personOrGroupAdmin shr
+        (WorkflowEnumCtorR shr _ _ _  , _   ) -> personOrGroupAdmin shr
 
         (TicketsR shar _           , True) -> person shar
         (TicketNewR _ _            , _   ) -> personAny
@@ -489,9 +492,20 @@ instance YesodBreadcrumbs App where
         WorkflowEnumNewR shr wfl         -> ( "New"
                                             , Just $ WorkflowEnumsR shr wfl
                                             )
-        WorkflowEnumR shr wfl fld        -> ( enm2text fld
+        WorkflowEnumR shr wfl enm        -> ( enm2text enm
                                             , Just $ WorkflowEnumsR shr wfl
                                             )
+        WorkflowEnumCtorsR shr wfl enm   -> ( "Ctors"
+                                            , Just $ WorkflowEnumR shr wfl enm
+                                            )
+        WorkflowEnumCtorNewR shr wfl enm -> ( "New"
+                                            , Just $
+                                              WorkflowEnumCtorsR shr wfl enm
+                                            )
+        WorkflowEnumCtorR shr wfl enm c  -> ( c
+                                            , Just $
+                                              WorkflowEnumCtorsR shr wfl enm
+                                            )
 
         TicketsR shar proj               -> ( "Tickets"
                                             , Just $ ProjectR shar proj

src/Vervis/Handler/Workflow.hs

@@ -35,6 +35,13 @@ module Vervis.Handler.Workflow
     , getWorkflowEnumR
     , deleteWorkflowEnumR
     , postWorkflowEnumR
+      -- * Ctor
+    , getWorkflowEnumCtorsR
+    , postWorkflowEnumCtorsR
+    , getWorkflowEnumCtorNewR
+    , putWorkflowEnumCtorR
+    , deleteWorkflowEnumCtorR
+    , postWorkflowEnumCtorR
     )
 where
 
@@ -247,3 +254,69 @@ postWorkflowEnumR shr wfl enm = do
     case mmethod of
         Just "DELETE" -> deleteWorkflowEnumR shr wfl enm
         _             -> notFound
+
+-------------------------------------------------------------------------------
+-- Ctor
+-------------------------------------------------------------------------------
+
+getWorkflowEnumCtorsR :: ShrIdent -> WflIdent -> EnmIdent -> Handler Html
+getWorkflowEnumCtorsR shr wfl enm = do
+    cs <- runDB $ do
+        Entity sid _ <- getBy404 $ UniqueSharer shr
+        Entity wid _ <- getBy404 $ UniqueWorkflow sid wfl
+        Entity eid _ <- getBy404 $ UniqueWorkflowFieldEnum wid enm
+        selectList [WorkflowFieldEnumCtorEnum ==. eid] []
+    defaultLayout $(widgetFile "workflow/enum/ctor/list")
+
+postWorkflowEnumCtorsR :: ShrIdent -> WflIdent -> EnmIdent -> Handler Html
+postWorkflowEnumCtorsR shr wfl enm = do
+    eid <- runDB $ do
+        Entity sid _ <- getBy404 $ UniqueSharer shr
+        Entity wid _ <- getBy404 $ UniqueWorkflow sid wfl
+        Entity eid _ <- getBy404 $ UniqueWorkflowFieldEnum wid enm
+        return eid
+    ((result, widget), etype) <- runFormPost $ newCtorForm eid
+    case result of
+        FormSuccess nc -> do
+            let ctor = WorkflowFieldEnumCtor
+                    { workflowFieldEnumCtorEnum = eid
+                    , workflowFieldEnumCtorName = ncName nc
+                    , workflowFieldEnumCtorDesc = ncDesc nc
+                    }
+            runDB $ insert_ ctor
+            setMessage "Workflow field enum ctor added."
+            redirect $ WorkflowEnumCtorsR shr wfl enm
+        FormMissing -> do
+            setMessage "Field(s) missing"
+            defaultLayout $(widgetFile "workflow/enum/ctor/new")
+        FormFailure _l -> do
+            setMessage "Workflow field enum ctor creation failed, see below"
+            defaultLayout $(widgetFile "workflow/enum/ctor/new")
+
+getWorkflowEnumCtorNewR :: ShrIdent -> WflIdent -> EnmIdent -> Handler Html
+getWorkflowEnumCtorNewR shr wfl enm = do
+    eid <- runDB $ do
+        Entity sid _ <- getBy404 $ UniqueSharer shr
+        Entity wid _ <- getBy404 $ UniqueWorkflow sid wfl
+        Entity eid _ <- getBy404 $ UniqueWorkflowFieldEnum wid enm
+        return eid
+    ((_result, widget), etype) <- runFormPost $ newCtorForm eid
+    defaultLayout $(widgetFile "workflow/enum/ctor/new")
+
+putWorkflowEnumCtorR
+    :: ShrIdent -> WflIdent -> EnmIdent -> Text -> Handler Html
+putWorkflowEnumCtorR shr wfl enm ctor = error "Not implemented yet"
+
+deleteWorkflowEnumCtorR
+    :: ShrIdent -> WflIdent -> EnmIdent -> Text -> Handler Html
+deleteWorkflowEnumCtorR shr wfl enm ctor =
+    error "Not implemented, not sure whether to allow it"
+
+postWorkflowEnumCtorR
+    :: ShrIdent -> WflIdent -> EnmIdent -> Text -> Handler Html
+postWorkflowEnumCtorR shr wfl enm ctor = do
+    mmethod <- lookupPostParam "_method"
+    case mmethod of
+        Just "PUT"    -> putWorkflowEnumCtorR shr wfl enm ctor
+        Just "DELETE" -> deleteWorkflowEnumCtorR shr wfl enm ctor
+        _             -> notFound

templates/workflow/enum/ctor/list.hamlet

@@ -0,0 +1,33 @@
+$# 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>
+  <a href=@{WorkflowEnumCtorNewR shr wfl enm}>
+    Add…
+
+<ul>
+  $forall Entity _cid c <- cs
+    $with name <- workflowFieldEnumCtorName c
+      <li>
+        <div>
+          #{name}
+        <div>
+          #{fromMaybe "(none)" $ workflowFieldEnumCtorDesc c}
+        <div>
+          <form method="POST" action=@{WorkflowEnumCtorR shr wfl enm name}>
+            <input type="hidden" name="_method" value="PUT">
+            <input type="submit" value="Edit this ctor">
+          <form method="POST" action=@{WorkflowEnumCtorR shr wfl enm name}>
+            <input type="hidden" name="_method" value="DELETE">
+            <input type="submit" value="Delete this ctor">

templates/workflow/enum/ctor/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=@{WorkflowEnumCtorsR shr wfl enm} enctype=#{etype}>
+  ^{widget}
+  <input type="submit">

templates/workflow/enum/list.hamlet

@@ -12,6 +12,10 @@ $# 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>
+  <a href=@{WorkflowEnumNewR shr wfl}>
+    Add…
+
 <ul>
   $forall Entity _eid e <- es
     <li>

templates/workflow/enum/one.hamlet

@@ -22,3 +22,6 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
     Display name: #{workflowFieldEnumName e}
   <li>
     Description: #{fromMaybe "(none)" $ workflowFieldEnumDesc e}
+  <li>
+    <a href=@{WorkflowEnumCtorsR shr wfl enm}>
+      Ctors

templates/workflow/field/list.hamlet

@@ -12,6 +12,10 @@ $# 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>
+  <a href=@{WorkflowFieldNewR shr wfl}>
+    Add…
+
 <ul>
   $forall Entity _fid f <- fs
     <li>

templates/workflow/list.hamlet

@@ -12,6 +12,10 @@ $# 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>
+  <a href=@{WorkflowNewR shr}>
+    Add…
+
 <ul>
   $forall Entity _wid w <- ws
     <li>