diff --git a/src/Vervis/Form/Workflow.hs b/src/Vervis/Form/Workflow.hs index 3c8a582..cc0b36b 100644 --- a/src/Vervis/Form/Workflow.hs +++ b/src/Vervis/Form/Workflow.hs @@ -1,6 +1,6 @@ {- This file is part of Vervis. - - - Written in 2016, 2019 by fr33domlover . + - Written in 2016, 2019, 2020 by fr33domlover . - - ♡ Copying is an act of love. Please copy, reuse and share. - @@ -26,6 +26,7 @@ module Vervis.Form.Workflow where import Data.Text (Text) +import Database.Persist import Yesod.Form.Fields import Yesod.Form.Functions import Yesod.Form.Types @@ -58,6 +59,7 @@ data NewField = NewField , nfName :: Text , nfDesc :: Maybe Text , nfType :: WorkflowFieldType + , nfEnum :: Maybe WorkflowFieldEnumId , nfReq :: Bool , nfConst :: Bool , nfNew :: Bool @@ -71,11 +73,18 @@ newFieldAForm wid = NewField <*> areq textField "Name*" Nothing <*> aopt textField "Description" Nothing <*> areq (selectField optionsEnum) "Type*" Nothing + <*> aopt (selectField selectEnum) "Enum*" (Just Nothing) <*> areq checkBoxField "Required*" Nothing <*> areq checkBoxField "Constant*" Nothing <*> areq checkBoxField "Applies to New*" (Just True) <*> areq checkBoxField "Applies to Todo*" (Just True) <*> areq checkBoxField "Applies to Closed*" (Just True) + where + selectEnum = + optionsPersistKey + [WorkflowFieldEnumWorkflow ==. wid] + [Asc WorkflowFieldEnumName] + workflowFieldEnumName newFieldForm :: WorkflowId -> Form NewField newFieldForm wid = renderDivs $ newFieldAForm wid diff --git a/src/Vervis/Handler/Ticket.hs b/src/Vervis/Handler/Ticket.hs index 9005c54..cfc5d33 100644 --- a/src/Vervis/Handler/Ticket.hs +++ b/src/Vervis/Handler/Ticket.hs @@ -1,6 +1,6 @@ {- This file is part of Vervis. - - - Written in 2016, 2018, 2019 by fr33domlover . + - Written in 2016, 2018, 2019, 2020 by fr33domlover . - - ♡ Copying is an act of love. Please copy, reuse and share. - diff --git a/src/Vervis/Handler/Workflow.hs b/src/Vervis/Handler/Workflow.hs index 18f75d3..93c8463 100644 --- a/src/Vervis/Handler/Workflow.hs +++ b/src/Vervis/Handler/Workflow.hs @@ -1,6 +1,6 @@ {- This file is part of Vervis. - - - Written in 2016, 2018 by fr33domlover . + - Written in 2016, 2018, 2020 by fr33domlover . - - ♡ Copying is an act of love. Please copy, reuse and share. - @@ -45,7 +45,7 @@ module Vervis.Handler.Workflow ) where -import Data.Maybe (fromMaybe) +import Data.Maybe import Data.Text (Text) import Database.Persist import Network.HTTP.Types (StdMethod (DELETE, PUT)) @@ -144,30 +144,37 @@ postWorkflowFieldsR shr wfl = do 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 - , workflowFieldEnm = Nothing - , workflowFieldRequired = nfReq nf - , workflowFieldConstant = nfConst nf - , workflowFieldFilterNew = nfNew nf - , workflowFieldFilterTodo = nfTodo nf - , workflowFieldFilterClosed = nfClosed nf - } - runDB $ insert_ field + identOrMsg <- + case result of + FormSuccess nf -> + if (nfType nf == WFTEnum) == isJust (nfEnum nf) + then do + let field = WorkflowField + { workflowFieldWorkflow = wid + , workflowFieldIdent = nfIdent nf + , workflowFieldName = nfName nf + , workflowFieldDesc = nfDesc nf + , workflowFieldType = nfType nf + , workflowFieldEnm = nfEnum nf + , workflowFieldRequired = nfReq nf + , workflowFieldConstant = nfConst nf + , workflowFieldFilterNew = nfNew nf + , workflowFieldFilterTodo = nfTodo nf + , workflowFieldFilterClosed = nfClosed nf + } + runDB $ insert_ field + return $ Right $ nfIdent nf + else return $ Left "Type/Enum mismatch" + FormMissing -> return $ Left "Field(s) missing" + FormFailure _l -> + return $ Left "Workflow field creation failed, see below" + case identOrMsg of + Left msg -> do + setMessage msg + defaultLayout $(widgetFile "workflow/field/new") + Right fld -> do 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") + redirect $ WorkflowFieldR shr wfl fld getWorkflowFieldNewR :: ShrIdent -> WflIdent -> Handler Html getWorkflowFieldNewR shr wfl = do