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

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