feat(workflows): implement archive routes

This commit is contained in:
Sarah Vaupel 2022-05-13 23:20:33 +02:00 committed by Sarah Vaupel
parent 97723ad895
commit 441609436a
2 changed files with 43 additions and 30 deletions

33
routes
View File

@ -76,20 +76,23 @@
/global-workflows/instances GlobalWorkflowInstanceListR GET !free
/global-workflows/instances/new GlobalWorkflowInstanceNewR GET POST
/global-workflows/instances/#WorkflowInstanceName GlobalWorkflowInstanceR:
/edit GWIEditR GET POST
/delete GWIDeleteR GET POST
/workflows GWIWorkflowsR GET !free
/initiate GWIInitiateR GET POST !workflow
/update GWIUpdateR POST
/global-workflows GlobalWorkflowWorkflowListR GET !free
/edit GWIEditR GET POST
/delete GWIDeleteR GET POST
/workflows GWIWorkflowsR GET !free
/workflows-archive GWIWorkflowsArchiveR GET !free
/initiate GWIInitiateR GET POST !workflow
/update GWIUpdateR POST
/global-workflows GlobalWorkflowWorkflowListR GET !free
/global-workflows-archive GlobalWorkflowWorkflowArchiveR GET !free
!/global-workflows/#CryptoFileNameWorkflowWorkflow GlobalWorkflowWorkflowR:
/ GWWWorkflowR GET POST !workflow
/files/#WorkflowPayloadLabel/#CryptoUUIDWorkflowStateIndex GWWFilesR GET !workflow
/edit GWWEditR GET POST
/delete GWWDeleteR GET POST
/workflow-instances TopWorkflowInstanceListR GET !free
/workflows TopWorkflowWorkflowListR GET !free
/workflow-instances TopWorkflowInstanceListR GET !free
/workflows TopWorkflowWorkflowListR GET !free
/workflows-archive TopWorkflowWorkflowArchiveR GET !free
/health HealthR GET !free
/instance InstanceR GET !free
@ -143,12 +146,14 @@
/workflows/instances SchoolWorkflowInstanceListR GET !free
/workflows/instances/new SchoolWorkflowInstanceNewR GET POST
/workflows/instances/#WorkflowInstanceName SchoolWorkflowInstanceR:
/edit SWIEditR GET POST
/delete SWIDeleteR GET POST
/workflows SWIWorkflowsR GET !free
/initiate SWIInitiateR GET POST !workflow
/update SWIUpdateR POST
/workflows SchoolWorkflowWorkflowListR GET !free
/edit SWIEditR GET POST
/delete SWIDeleteR GET POST
/workflows SWIWorkflowsR GET !free
/workflows-archive SWIWorkflowsArchiveR GET !free
/initiate SWIInitiateR GET POST !workflow
/update SWIUpdateR POST
/workflows SchoolWorkflowWorkflowListR GET !free
/workflows-archive SchoolWorkflowWorkflowArchiveR GET !free
!/workflows/#CryptoFileNameWorkflowWorkflow SchoolWorkflowWorkflowR:
/ SWWWorkflowR GET POST !workflow
/files/#WorkflowPayloadLabel/#CryptoUUIDWorkflowStateIndex SWWFilesR GET !workflow

View File

@ -1,14 +1,14 @@
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
module Handler.Workflow.Workflow.List
( getGlobalWorkflowWorkflowListR
, getSchoolWorkflowWorkflowListR
( getGlobalWorkflowWorkflowListR, getGlobalWorkflowWorkflowArchiveR
, getSchoolWorkflowWorkflowListR, getSchoolWorkflowWorkflowArchiveR
, workflowWorkflowListR
, getGWIWorkflowsR
, getSWIWorkflowsR
, getGWIWorkflowsR, getGWIWorkflowsArchiveR
, getSWIWorkflowsR, getSWIWorkflowsArchiveR
, workflowInstanceWorkflowsR
, getAdminWorkflowWorkflowListR
, getTopWorkflowWorkflowListR
, getTopWorkflowWorkflowListR, getTopWorkflowWorkflowArchiveR
) where
import Import hiding (Last(..), WriterT)
@ -65,11 +65,13 @@ restrictOnArchived workflowWorkflow now = maybe E.true $ \archived -> E.maybe
(workflowWorkflow E.^. WorkflowWorkflowArchived)
getGlobalWorkflowWorkflowListR :: Handler Html
getGlobalWorkflowWorkflowListR = workflowWorkflowListR (Just False) WSGlobal
getGlobalWorkflowWorkflowListR, getGlobalWorkflowWorkflowArchiveR :: Handler Html
getGlobalWorkflowWorkflowListR = workflowWorkflowListR (Just False) WSGlobal
getGlobalWorkflowWorkflowArchiveR = workflowWorkflowListR (Just True ) WSGlobal
getSchoolWorkflowWorkflowListR :: SchoolId -> Handler Html
getSchoolWorkflowWorkflowListR = workflowWorkflowListR (Just False) . WSSchool
getSchoolWorkflowWorkflowListR, getSchoolWorkflowWorkflowArchiveR :: SchoolId -> Handler Html
getSchoolWorkflowWorkflowListR = workflowWorkflowListR (Just False) . WSSchool
getSchoolWorkflowWorkflowArchiveR = workflowWorkflowListR (Just True ) . WSSchool
workflowWorkflowListR :: Maybe Bool -- ^ archived/non-archived workflows only?
-> RouteWorkflowScope
@ -89,11 +91,13 @@ workflowWorkflowListR mArchived rScope = workflowsDisabledWarning (headings ^. _
headings = (MsgWorkflowWorkflowListScopeTitle rScope, MsgWorkflowWorkflowListScopeHeading rScope)
getGWIWorkflowsR :: WorkflowInstanceName -> Handler Html
getGWIWorkflowsR = workflowInstanceWorkflowsR (Just False) WSGlobal
getGWIWorkflowsR, getGWIWorkflowsArchiveR :: WorkflowInstanceName -> Handler Html
getGWIWorkflowsR = workflowInstanceWorkflowsR (Just False) WSGlobal
getGWIWorkflowsArchiveR = workflowInstanceWorkflowsR (Just True ) WSGlobal
getSWIWorkflowsR :: SchoolId -> WorkflowInstanceName -> Handler Html
getSWIWorkflowsR ssh = workflowInstanceWorkflowsR (Just False) $ WSSchool ssh
getSWIWorkflowsR, getSWIWorkflowsArchiveR :: SchoolId -> WorkflowInstanceName -> Handler Html
getSWIWorkflowsR = workflowInstanceWorkflowsR (Just False) . WSSchool
getSWIWorkflowsArchiveR = workflowInstanceWorkflowsR (Just True ) . WSSchool
workflowInstanceWorkflowsR :: Maybe Bool -- ^ archived/non-archived workflows only?
-> RouteWorkflowScope
@ -130,10 +134,14 @@ getAdminWorkflowWorkflowListR :: Handler Html
getAdminWorkflowWorkflowListR = workflowWorkflowList headings def $ const E.true -- archived workflows included
where headings = (MsgAdminWorkflowWorkflowListTitle, MsgAdminWorkflowWorkflowListHeading)
getTopWorkflowWorkflowListR :: Handler Html
getTopWorkflowWorkflowListR = do
getTopWorkflowWorkflowListR, getTopWorkflowWorkflowArchiveR :: Handler Html
getTopWorkflowWorkflowListR = topWorkflowWorkflowListR (Just False)
getTopWorkflowWorkflowArchiveR = topWorkflowWorkflowListR (Just True)
topWorkflowWorkflowListR :: Maybe Bool -> Handler Html
topWorkflowWorkflowListR mArchived = do
now <- liftIO getCurrentTime
workflowsDisabledWarning (headings ^. _1) (headings ^. _2) . workflowWorkflowList headings def . views queryWorkflowWorkflow $ \workflowWorkflow -> isTopWorkflowScopeSql (workflowWorkflow E.^. WorkflowWorkflowScope) E.&&. restrictOnArchived workflowWorkflow now (Just False)
workflowsDisabledWarning (headings ^. _1) (headings ^. _2) . workflowWorkflowList headings def . views queryWorkflowWorkflow $ \workflowWorkflow -> isTopWorkflowScopeSql (workflowWorkflow E.^. WorkflowWorkflowScope) E.&&. restrictOnArchived workflowWorkflow now mArchived
where headings = (MsgWorkflowWorkflowListTopTitle, MsgWorkflowWorkflowListTopHeading)