feat(workflows): implement archive routes
This commit is contained in:
parent
97723ad895
commit
441609436a
33
routes
33
routes
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user