diff --git a/config/models b/config/models index 15a3fab..ad475e6 100644 --- a/config/models +++ b/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 diff --git a/config/routes b/config/routes index 63daf0f..96f34c7 100644 --- a/config/routes +++ b/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 diff --git a/src/Vervis/Field/Workflow.hs b/src/Vervis/Field/Workflow.hs index 9fab4dd..335089a 100644 --- a/src/Vervis/Field/Workflow.hs +++ b/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 diff --git a/src/Vervis/Form/Workflow.hs b/src/Vervis/Form/Workflow.hs index 99fac25..571bc54 100644 --- a/src/Vervis/Form/Workflow.hs +++ b/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 diff --git a/src/Vervis/Foundation.hs b/src/Vervis/Foundation.hs index e1dfb36..7da9241 100644 --- a/src/Vervis/Foundation.hs +++ b/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 diff --git a/src/Vervis/Handler/Workflow.hs b/src/Vervis/Handler/Workflow.hs index 32e099e..02a3a1d 100644 --- a/src/Vervis/Handler/Workflow.hs +++ b/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 diff --git a/templates/workflow/enum/ctor/list.hamlet b/templates/workflow/enum/ctor/list.hamlet new file mode 100644 index 0000000..68d8005 --- /dev/null +++ b/templates/workflow/enum/ctor/list.hamlet @@ -0,0 +1,33 @@ +$# This file is part of Vervis. +$# +$# Written in 2016 by fr33domlover . +$# +$# ♡ 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 +$# . + +

+ + Add… + +