92 lines
4.3 KiB
Haskell
92 lines
4.3 KiB
Haskell
module Handler.Utils.Workflow.CanonicalRoute where
|
|
|
|
import Import.NoFoundation
|
|
import Foundation.Type
|
|
import Foundation.Routes
|
|
|
|
|
|
data WorkflowScopeRoute
|
|
= WorkflowInstanceListR
|
|
| WorkflowInstanceNewR
|
|
| WorkflowInstanceR WorkflowInstanceName WorkflowInstanceR
|
|
| WorkflowWorkflowListR
|
|
| WorkflowWorkflowR CryptoFileNameWorkflowWorkflow WorkflowWorkflowR
|
|
deriving (Eq, Ord, Read, Show, Generic, Typeable)
|
|
|
|
data WorkflowInstanceR
|
|
= WIEditR | WIDeleteR | WIWorkflowsR | WIInitiateR
|
|
deriving (Eq, Ord, Read, Show, Generic, Typeable)
|
|
|
|
data WorkflowWorkflowR
|
|
= WWWorkflowR | WWFilesR WorkflowPayloadLabel CryptoUUIDWorkflowStateIndex | WWEditR | WWDeleteR
|
|
deriving (Eq, Ord, Read, Show, Generic, Typeable)
|
|
|
|
|
|
_WorkflowScopeRoute :: Prism'
|
|
( Route UniWorX )
|
|
( WorkflowScope TermId SchoolId (TermId, SchoolId, CourseShorthand)
|
|
, WorkflowScopeRoute
|
|
)
|
|
_WorkflowScopeRoute = prism' (uncurry toRoute) toWorkflowScopeRoute
|
|
where
|
|
toRoute = \case
|
|
WSGlobal -> \case
|
|
WorkflowInstanceListR -> GlobalWorkflowInstanceListR
|
|
WorkflowInstanceNewR -> GlobalWorkflowInstanceNewR
|
|
WorkflowInstanceR win subRoute -> GlobalWorkflowInstanceR win $ case subRoute of
|
|
WIEditR -> GWIEditR
|
|
WIDeleteR -> GWIDeleteR
|
|
WIWorkflowsR -> GWIWorkflowsR
|
|
WIInitiateR -> GWIInitiateR
|
|
WorkflowWorkflowListR -> GlobalWorkflowWorkflowListR
|
|
WorkflowWorkflowR wwCID subRoute -> GlobalWorkflowWorkflowR wwCID $ case subRoute of
|
|
WWWorkflowR -> GWWWorkflowR
|
|
WWFilesR wpl stCID -> GWWFilesR wpl stCID
|
|
WWEditR -> GWWEditR
|
|
WWDeleteR -> GWWDeleteR
|
|
WSSchool ssh -> SchoolR ssh . \case
|
|
WorkflowInstanceListR -> SchoolWorkflowInstanceListR
|
|
WorkflowInstanceNewR -> SchoolWorkflowInstanceNewR
|
|
WorkflowInstanceR win subRoute -> SchoolWorkflowInstanceR win $ case subRoute of
|
|
WIEditR -> SWIEditR
|
|
WIDeleteR -> SWIDeleteR
|
|
WIWorkflowsR -> SWIWorkflowsR
|
|
WIInitiateR -> SWIInitiateR
|
|
WorkflowWorkflowListR -> SchoolWorkflowWorkflowListR
|
|
WorkflowWorkflowR wwCID subRoute -> SchoolWorkflowWorkflowR wwCID $ case subRoute of
|
|
WWWorkflowR -> SWWWorkflowR
|
|
WWFilesR wpl stCID -> SWWFilesR wpl stCID
|
|
WWEditR -> SWWEditR
|
|
WWDeleteR -> SWWDeleteR
|
|
other -> error $ "not implemented _WorkflowScopeRoute for: " <> show other
|
|
toWorkflowScopeRoute = \case
|
|
GlobalWorkflowInstanceListR -> Just ( WSGlobal, WorkflowInstanceListR )
|
|
GlobalWorkflowInstanceNewR -> Just ( WSGlobal, WorkflowInstanceNewR )
|
|
GlobalWorkflowInstanceR win subRoute -> Just . (WSGlobal, ) . WorkflowInstanceR win $ case subRoute of
|
|
GWIEditR -> WIEditR
|
|
GWIDeleteR -> WIDeleteR
|
|
GWIWorkflowsR -> WIWorkflowsR
|
|
GWIInitiateR -> WIInitiateR
|
|
GlobalWorkflowWorkflowListR -> Just ( WSGlobal, WorkflowWorkflowListR )
|
|
GlobalWorkflowWorkflowR wwCID subRoute -> Just . (WSGlobal, ) . WorkflowWorkflowR wwCID $ case subRoute of
|
|
GWWWorkflowR -> WWWorkflowR
|
|
GWWFilesR wpl stCID -> WWFilesR wpl stCID
|
|
GWWEditR -> WWEditR
|
|
GWWDeleteR -> WWDeleteR
|
|
SchoolR ssh sRoute -> case sRoute of
|
|
SchoolWorkflowInstanceListR -> Just ( WSSchool ssh, WorkflowInstanceListR )
|
|
SchoolWorkflowInstanceNewR -> Just ( WSSchool ssh, WorkflowInstanceNewR )
|
|
SchoolWorkflowInstanceR win subRoute -> Just . (WSSchool ssh, ) . WorkflowInstanceR win $ case subRoute of
|
|
SWIEditR -> WIEditR
|
|
SWIDeleteR -> WIDeleteR
|
|
SWIWorkflowsR -> WIWorkflowsR
|
|
SWIInitiateR -> WIInitiateR
|
|
SchoolWorkflowWorkflowListR -> Just ( WSSchool ssh, WorkflowWorkflowListR )
|
|
SchoolWorkflowWorkflowR wwCID subRoute -> Just . (WSSchool ssh, ) . WorkflowWorkflowR wwCID $ case subRoute of
|
|
SWWWorkflowR -> WWWorkflowR
|
|
SWWFilesR wpl stCID -> WWFilesR wpl stCID
|
|
SWWEditR -> WWEditR
|
|
SWWDeleteR -> WWDeleteR
|
|
_other -> Nothing
|
|
_other -> Nothing
|