diff --git a/config/models b/config/models index bf21d84..99d21ea 100644 --- a/config/models +++ b/config/models @@ -162,6 +162,16 @@ Workflow UniqueWorkflow sharer ident +WorkflowField + workflow WorkflowId + ident FldIdent + name Text + desc Text Maybe + type WorkflowFieldType + -- filter TicketStatusFilterId + + UniqueWorkflowField workflow ident + Ticket project ProjectId number Int diff --git a/config/routes b/config/routes index c78f900..0015964 100644 --- a/config/routes +++ b/config/routes @@ -99,6 +99,9 @@ /s/#ShrIdent/w WorkflowsR GET POST /s/#ShrIdent/w/!new WorkflowNewR GET /s/#ShrIdent/w/#WflIdent WorkflowR GET DELETE POST +/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/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 28a8967..c2327ad 100644 --- a/src/Vervis/Field/Workflow.hs +++ b/src/Vervis/Field/Workflow.hs @@ -15,6 +15,7 @@ module Vervis.Field.Workflow ( newWorkflowIdentField + , newFieldIdentField ) where @@ -25,7 +26,7 @@ import Data.Char.Local (isAsciiLetter) import Data.Text (split) import Database.Esqueleto -import Vervis.Model.Ident (WflIdent, wfl2text, text2wfl) +import Vervis.Model.Ident checkTemplate :: Field Handler Text -> Field Handler Text checkTemplate = @@ -33,14 +34,14 @@ checkTemplate = wordOk w = (not . null) w && all charOk w identOk t = (not . null) t && all wordOk (split (== '-') t) msg :: Text - msg = - "The workflow identifier must be a sequence of one or more words \ + msg = "The identifier must be a sequence of one or more words \ \separated by hyphens (‘-’), and each such word may contain \ \ASCII letters and digits." in checkBool identOk msg -checkUniqueCI :: SharerId -> Field Handler WflIdent -> Field Handler WflIdent -checkUniqueCI sid = checkM $ \ wfl -> do +checkWflUniqueCI + :: SharerId -> Field Handler WflIdent -> Field Handler WflIdent +checkWflUniqueCI sid = checkM $ \ wfl -> do sames <- runDB $ select $ from $ \ workflow -> do where_ $ workflow ^. WorkflowSharer ==. val sid &&. @@ -55,4 +56,23 @@ workflowIdentField :: Field Handler WflIdent workflowIdentField = convertField text2wfl wfl2text $ checkTemplate textField newWorkflowIdentField :: SharerId -> Field Handler WflIdent -newWorkflowIdentField sid = checkUniqueCI sid workflowIdentField +newWorkflowIdentField sid = checkWflUniqueCI sid workflowIdentField + +checkFldUniqueCI + :: WorkflowId -> Field Handler FldIdent -> Field Handler FldIdent +checkFldUniqueCI wid = checkM $ \ fld -> do + sames <- runDB $ select $ from $ \ field -> do + where_ $ + field ^. WorkflowFieldWorkflow ==. val wid &&. + lower_ (field ^. WorkflowFieldIdent) ==. lower_ (val fld) + limit 1 + return () + return $ if null sames + then Right fld + else Left ("There is already a field by that name" :: Text) + +fieldIdentField :: Field Handler FldIdent +fieldIdentField = convertField text2fld fld2text $ checkTemplate textField + +newFieldIdentField :: WorkflowId -> Field Handler FldIdent +newFieldIdentField wid = checkFldUniqueCI wid fieldIdentField diff --git a/src/Vervis/Form/Workflow.hs b/src/Vervis/Form/Workflow.hs index 1bbfd25..193d5df 100644 --- a/src/Vervis/Form/Workflow.hs +++ b/src/Vervis/Form/Workflow.hs @@ -16,6 +16,8 @@ module Vervis.Form.Workflow ( NewWorkflow (..) , newWorkflowForm + , NewField (..) + , newFieldForm ) where @@ -28,6 +30,7 @@ import qualified Database.Esqueleto as E ((==.)) import Vervis.Field.Workflow import Vervis.Model import Vervis.Model.Ident +import Vervis.Model.Workflow data NewWorkflow = NewWorkflow { nwIdent :: WflIdent @@ -43,3 +46,20 @@ newWorkflowAForm sid = NewWorkflow newWorkflowForm :: SharerId -> Form NewWorkflow newWorkflowForm sid = renderDivs $ newWorkflowAForm sid + +data NewField = NewField + { nfIdent :: FldIdent + , nfName :: Text + , nfDesc :: Maybe Text + , nfType :: WorkflowFieldType + } + +newFieldAForm :: WorkflowId -> AForm Handler NewField +newFieldAForm wid = NewField + <$> areq (newFieldIdentField wid) "Identifier*" Nothing + <*> areq textField "Name*" Nothing + <*> aopt textField "Description" Nothing + <*> areq (selectField optionsEnum) "Type*" Nothing + +newFieldForm :: WorkflowId -> Form NewField +newFieldForm wid = renderDivs $ newFieldAForm wid diff --git a/src/Vervis/Foundation.hs b/src/Vervis/Foundation.hs index 525bc25..34b8c8f 100644 --- a/src/Vervis/Foundation.hs +++ b/src/Vervis/Foundation.hs @@ -168,6 +168,9 @@ instance Yesod App where (WorkflowsR shr , _ ) -> personOrGroupAdmin shr (WorkflowNewR shr , _ ) -> personOrGroupAdmin shr (WorkflowR shr _wfl , _ ) -> personOrGroupAdmin shr + (WorkflowFieldsR shr _ , _ ) -> personOrGroupAdmin shr + (WorkflowFieldNewR shr _ , _ ) -> personOrGroupAdmin shr + (WorkflowFieldR shr _ _ , _ ) -> personOrGroupAdmin shr (TicketsR shar _ , True) -> person shar (TicketNewR _ _ , _ ) -> personAny @@ -468,6 +471,15 @@ instance YesodBreadcrumbs App where WorkflowR shr wfl -> ( wfl2text wfl , Just $ WorkflowsR shr ) + WorkflowFieldsR shr wfl -> ( "Fields" + , Just $ WorkflowR shr wfl + ) + WorkflowFieldNewR shr wfl -> ( "New" + , Just $ WorkflowFieldsR shr wfl + ) + WorkflowFieldR shr wfl fld -> ( fld2text fld + , Just $ WorkflowFieldsR 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 2abd2e2..c2e5392 100644 --- a/src/Vervis/Handler/Workflow.hs +++ b/src/Vervis/Handler/Workflow.hs @@ -20,6 +20,12 @@ module Vervis.Handler.Workflow , getWorkflowR , deleteWorkflowR , postWorkflowR + , getWorkflowFieldsR + , postWorkflowFieldsR + , getWorkflowFieldNewR + , getWorkflowFieldR + , deleteWorkflowFieldR + , postWorkflowFieldR ) where @@ -95,3 +101,66 @@ postWorkflowR shr wfl = do case mmethod of Just "DELETE" -> deleteWorkflowR shr wfl _ -> notFound + +getWorkflowFieldsR :: ShrIdent -> WflIdent -> Handler Html +getWorkflowFieldsR shr wfl = do + fs <- runDB $ do + Entity sid _ <- getBy404 $ UniqueSharer shr + Entity wid _ <- getBy404 $ UniqueWorkflow sid wfl + selectList [WorkflowFieldWorkflow ==. wid] [] + defaultLayout $(widgetFile "workflow/field/list") + +postWorkflowFieldsR :: ShrIdent -> WflIdent -> Handler Html +postWorkflowFieldsR shr wfl = do + wid <- runDB $ do + Entity sid _ <- getBy404 $ UniqueSharer shr + 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 + } + runDB $ insert_ field + 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") + +getWorkflowFieldNewR :: ShrIdent -> WflIdent -> Handler Html +getWorkflowFieldNewR shr wfl = do + wid <- runDB $ do + Entity sid _ <- getBy404 $ UniqueSharer shr + Entity wid _ <- getBy404 $ UniqueWorkflow sid wfl + return wid + ((_result, widget), enctype) <- runFormPost $ newFieldForm wid + defaultLayout $(widgetFile "workflow/field/new") + +getWorkflowFieldR :: ShrIdent -> WflIdent -> FldIdent -> Handler Html +getWorkflowFieldR shr wfl fld = do + f <- runDB $ do + Entity sid _ <- getBy404 $ UniqueSharer shr + Entity wid _ <- getBy404 $ UniqueWorkflow sid wfl + Entity _ f <- getBy404 $ UniqueWorkflowField wid fld + return f + defaultLayout $(widgetFile "workflow/field/one") + +deleteWorkflowFieldR :: ShrIdent -> WflIdent -> FldIdent -> Handler Html +deleteWorkflowFieldR shr wfl fld = + error "Not implemented, not sure whether to allow it" + +postWorkflowFieldR :: ShrIdent -> WflIdent -> FldIdent -> Handler Html +postWorkflowFieldR shr wfl fld = do + mmethod <- lookupPostParam "_method" + case mmethod of + Just "DELETE" -> deleteWorkflowFieldR shr wfl fld + _ -> notFound diff --git a/src/Vervis/Model.hs b/src/Vervis/Model.hs index 20b5df9..9d4e3bc 100644 --- a/src/Vervis/Model.hs +++ b/src/Vervis/Model.hs @@ -29,6 +29,7 @@ import Vervis.Model.Group import Vervis.Model.Ident import Vervis.Model.Repo import Vervis.Model.Role +import Vervis.Model.Workflow -- You can define all of your database entities in the entities file. -- You can find more information on persistent and how to declare entities at: diff --git a/src/Vervis/Model/Ident.hs b/src/Vervis/Model/Ident.hs index 5d683a5..408ad0a 100644 --- a/src/Vervis/Model/Ident.hs +++ b/src/Vervis/Model/Ident.hs @@ -34,6 +34,9 @@ module Vervis.Model.Ident , WflIdent (..) , wfl2text , text2wfl + , FldIdent (..) + , fld2text + , text2fld ) where @@ -112,3 +115,13 @@ wfl2text = CI.original . unWflIdent text2wfl :: Text -> WflIdent text2wfl = WflIdent . CI.mk + +newtype FldIdent = FldIdent { unFldIdent :: CI Text } + deriving + (Eq, Show, Read, PersistField, PersistFieldSql, SqlString, PathPiece) + +fld2text :: FldIdent -> Text +fld2text = CI.original . unFldIdent + +text2fld :: Text -> FldIdent +text2fld = FldIdent . CI.mk diff --git a/src/Vervis/Model/Workflow.hs b/src/Vervis/Model/Workflow.hs new file mode 100644 index 0000000..7824f3a --- /dev/null +++ b/src/Vervis/Model/Workflow.hs @@ -0,0 +1,28 @@ +{- 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 + - . + -} + +module Vervis.Model.Workflow + ( WorkflowFieldType (..) + ) +where + +import Prelude + +import Database.Persist.TH + +data WorkflowFieldType = WFTText + deriving (Eq, Show, Read, Bounded, Enum) + +derivePersistField "WorkflowFieldType" diff --git a/templates/workflow/field/list.hamlet b/templates/workflow/field/list.hamlet new file mode 100644 index 0000000..bfb7a76 --- /dev/null +++ b/templates/workflow/field/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 +$# . + +