diff --git a/config/models b/config/models index 99d21ea..15a3fab 100644 --- a/config/models +++ b/config/models @@ -172,6 +172,14 @@ WorkflowField UniqueWorkflowField workflow ident +WorkflowFieldEnum + workflow WorkflowId + ident EnmIdent + name Text + desc Text Maybe + + UniqueWorkflowFieldEnum workflow ident + Ticket project ProjectId number Int diff --git a/config/routes b/config/routes index 0015964..63daf0f 100644 --- a/config/routes +++ b/config/routes @@ -102,6 +102,9 @@ /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/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/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 c2327ad..9fab4dd 100644 --- a/src/Vervis/Field/Workflow.hs +++ b/src/Vervis/Field/Workflow.hs @@ -16,6 +16,7 @@ module Vervis.Field.Workflow ( newWorkflowIdentField , newFieldIdentField + , newEnumIdentField ) where @@ -76,3 +77,22 @@ fieldIdentField = convertField text2fld fld2text $ checkTemplate textField newFieldIdentField :: WorkflowId -> Field Handler FldIdent newFieldIdentField wid = checkFldUniqueCI wid fieldIdentField + +checkEnmUniqueCI + :: WorkflowId -> Field Handler EnmIdent -> Field Handler EnmIdent +checkEnmUniqueCI wid = checkM $ \ enm -> do + sames <- runDB $ select $ from $ \ enum -> do + where_ $ + enum ^. WorkflowFieldEnumWorkflow ==. val wid &&. + lower_ (enum ^. WorkflowFieldEnumIdent) ==. lower_ (val enm) + limit 1 + return () + return $ if null sames + then Right enm + else Left ("There is already an enum by that name" :: Text) + +enumIdentField :: Field Handler EnmIdent +enumIdentField = convertField text2enm enm2text $ checkTemplate textField + +newEnumIdentField :: WorkflowId -> Field Handler EnmIdent +newEnumIdentField wid = checkEnmUniqueCI wid enumIdentField diff --git a/src/Vervis/Form/Workflow.hs b/src/Vervis/Form/Workflow.hs index 193d5df..99fac25 100644 --- a/src/Vervis/Form/Workflow.hs +++ b/src/Vervis/Form/Workflow.hs @@ -18,6 +18,8 @@ module Vervis.Form.Workflow , newWorkflowForm , NewField (..) , newFieldForm + , NewEnum (..) + , newEnumForm ) where @@ -63,3 +65,18 @@ newFieldAForm wid = NewField newFieldForm :: WorkflowId -> Form NewField newFieldForm wid = renderDivs $ newFieldAForm wid + +data NewEnum = NewEnum + { neIdent :: EnmIdent + , neName :: Text + , neDesc :: Maybe Text + } + +newEnumAForm :: WorkflowId -> AForm Handler NewEnum +newEnumAForm wid = NewEnum + <$> areq (newEnumIdentField wid) "Identifier*" Nothing + <*> areq textField "Name*" Nothing + <*> aopt textField "Description" Nothing + +newEnumForm :: WorkflowId -> Form NewEnum +newEnumForm wid = renderDivs $ newEnumAForm wid diff --git a/src/Vervis/Foundation.hs b/src/Vervis/Foundation.hs index 34b8c8f..e1dfb36 100644 --- a/src/Vervis/Foundation.hs +++ b/src/Vervis/Foundation.hs @@ -171,6 +171,9 @@ instance Yesod App where (WorkflowFieldsR shr _ , _ ) -> personOrGroupAdmin shr (WorkflowFieldNewR shr _ , _ ) -> personOrGroupAdmin shr (WorkflowFieldR shr _ _ , _ ) -> personOrGroupAdmin shr + (WorkflowEnumsR shr _ , _ ) -> personOrGroupAdmin shr + (WorkflowEnumNewR shr _ , _ ) -> personOrGroupAdmin shr + (WorkflowEnumR shr _ _ , _ ) -> personOrGroupAdmin shr (TicketsR shar _ , True) -> person shar (TicketNewR _ _ , _ ) -> personAny @@ -480,6 +483,15 @@ instance YesodBreadcrumbs App where WorkflowFieldR shr wfl fld -> ( fld2text fld , Just $ WorkflowFieldsR shr wfl ) + WorkflowEnumsR shr wfl -> ( "Enums" + , Just $ WorkflowR shr wfl + ) + WorkflowEnumNewR shr wfl -> ( "New" + , Just $ WorkflowEnumsR shr wfl + ) + WorkflowEnumR shr wfl fld -> ( enm2text fld + , Just $ WorkflowEnumsR shr wfl + ) TicketsR shar proj -> ( "Tickets" , Just $ ProjectR shar proj diff --git a/src/Vervis/Handler/Workflow.hs b/src/Vervis/Handler/Workflow.hs index c2e5392..32e099e 100644 --- a/src/Vervis/Handler/Workflow.hs +++ b/src/Vervis/Handler/Workflow.hs @@ -14,18 +14,27 @@ -} module Vervis.Handler.Workflow - ( getWorkflowsR + ( -- * Workflow + getWorkflowsR , postWorkflowsR , getWorkflowNewR , getWorkflowR , deleteWorkflowR , postWorkflowR + -- * Field , getWorkflowFieldsR , postWorkflowFieldsR , getWorkflowFieldNewR , getWorkflowFieldR , deleteWorkflowFieldR , postWorkflowFieldR + -- * Enum + , getWorkflowEnumsR + , postWorkflowEnumsR + , getWorkflowEnumNewR + , getWorkflowEnumR + , deleteWorkflowEnumR + , postWorkflowEnumR ) where @@ -49,6 +58,10 @@ import Vervis.Model.Ident import Vervis.Settings import Vervis.Widget.Sharer +------------------------------------------------------------------------------- +-- Workflow +------------------------------------------------------------------------------- + getWorkflowsR :: ShrIdent -> Handler Html getWorkflowsR shr = do ws <- runDB $ do @@ -102,6 +115,10 @@ postWorkflowR shr wfl = do Just "DELETE" -> deleteWorkflowR shr wfl _ -> notFound +------------------------------------------------------------------------------- +-- Field +------------------------------------------------------------------------------- + getWorkflowFieldsR :: ShrIdent -> WflIdent -> Handler Html getWorkflowFieldsR shr wfl = do fs <- runDB $ do @@ -164,3 +181,69 @@ postWorkflowFieldR shr wfl fld = do case mmethod of Just "DELETE" -> deleteWorkflowFieldR shr wfl fld _ -> notFound + +------------------------------------------------------------------------------- +-- Enum +------------------------------------------------------------------------------- + +getWorkflowEnumsR :: ShrIdent -> WflIdent -> Handler Html +getWorkflowEnumsR shr wfl = do + es <- runDB $ do + Entity sid _ <- getBy404 $ UniqueSharer shr + Entity wid _ <- getBy404 $ UniqueWorkflow sid wfl + selectList [WorkflowFieldEnumWorkflow ==. wid] [] + defaultLayout $(widgetFile "workflow/enum/list") + +postWorkflowEnumsR :: ShrIdent -> WflIdent -> Handler Html +postWorkflowEnumsR shr wfl = do + wid <- runDB $ do + Entity sid _ <- getBy404 $ UniqueSharer shr + Entity wid _ <- getBy404 $ UniqueWorkflow sid wfl + return wid + ((result, widget), enctype) <- runFormPost $ newEnumForm wid + case result of + FormSuccess ne -> do + let enum = WorkflowFieldEnum + { workflowFieldEnumWorkflow = wid + , workflowFieldEnumIdent = neIdent ne + , workflowFieldEnumName = neName ne + , workflowFieldEnumDesc = neDesc ne + } + runDB $ insert_ enum + setMessage "Workflow field enum added." + redirect $ WorkflowEnumR shr wfl (neIdent ne) + FormMissing -> do + setMessage "Field(s) missing" + defaultLayout $(widgetFile "workflow/enum/new") + FormFailure _l -> do + setMessage "Workflow field enum creation failed, see below" + defaultLayout $(widgetFile "workflow/enum/new") + +getWorkflowEnumNewR :: ShrIdent -> WflIdent -> Handler Html +getWorkflowEnumNewR shr wfl = do + wid <- runDB $ do + Entity sid _ <- getBy404 $ UniqueSharer shr + Entity wid _ <- getBy404 $ UniqueWorkflow sid wfl + return wid + ((_result, widget), enctype) <- runFormPost $ newEnumForm wid + defaultLayout $(widgetFile "workflow/enum/new") + +getWorkflowEnumR :: ShrIdent -> WflIdent -> EnmIdent -> Handler Html +getWorkflowEnumR shr wfl enm = do + e <- runDB $ do + Entity sid _ <- getBy404 $ UniqueSharer shr + Entity wid _ <- getBy404 $ UniqueWorkflow sid wfl + Entity _ e <- getBy404 $ UniqueWorkflowFieldEnum wid enm + return e + defaultLayout $(widgetFile "workflow/enum/one") + +deleteWorkflowEnumR :: ShrIdent -> WflIdent -> EnmIdent -> Handler Html +deleteWorkflowEnumR shr wfl enm = + error "Not implemented, not sure whether to allow it" + +postWorkflowEnumR :: ShrIdent -> WflIdent -> EnmIdent -> Handler Html +postWorkflowEnumR shr wfl enm = do + mmethod <- lookupPostParam "_method" + case mmethod of + Just "DELETE" -> deleteWorkflowEnumR shr wfl enm + _ -> notFound diff --git a/src/Vervis/Model/Ident.hs b/src/Vervis/Model/Ident.hs index 408ad0a..940ec7b 100644 --- a/src/Vervis/Model/Ident.hs +++ b/src/Vervis/Model/Ident.hs @@ -37,6 +37,9 @@ module Vervis.Model.Ident , FldIdent (..) , fld2text , text2fld + , EnmIdent (..) + , enm2text + , text2enm ) where @@ -125,3 +128,13 @@ fld2text = CI.original . unFldIdent text2fld :: Text -> FldIdent text2fld = FldIdent . CI.mk + +newtype EnmIdent = EnmIdent { unEnmIdent :: CI Text } + deriving + (Eq, Show, Read, PersistField, PersistFieldSql, SqlString, PathPiece) + +enm2text :: EnmIdent -> Text +enm2text = CI.original . unEnmIdent + +text2enm :: Text -> EnmIdent +text2enm = EnmIdent . CI.mk diff --git a/templates/workflow/enum/list.hamlet b/templates/workflow/enum/list.hamlet new file mode 100644 index 0000000..b96e820 --- /dev/null +++ b/templates/workflow/enum/list.hamlet @@ -0,0 +1,19 @@ +$# 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 +$# . + +