From ee6fecb79e4807beceadd15f19e41393f7707135 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Tue, 1 Dec 2020 11:11:48 +0100 Subject: [PATCH] feat(workflows): prepare for admin-workflow-instance-edit --- messages/uniworx/de-de-formal.msg | 1 + messages/uniworx/en-eu.msg | 1 + routes | 2 ++ src/Foundation/Navigation.hs | 2 ++ src/Foundation/Routes.hs | 2 ++ src/Handler/Workflow/Definition/List.hs | 2 +- src/Handler/Workflow/Instance/Edit.hs | 6 ++++++ src/Handler/Workflow/Instance/List.hs | 8 +++++++- test/FoundationSpec.hs | 4 ++++ 9 files changed, 26 insertions(+), 2 deletions(-) diff --git a/messages/uniworx/de-de-formal.msg b/messages/uniworx/de-de-formal.msg index 4299fdf8a..7288730c6 100644 --- a/messages/uniworx/de-de-formal.msg +++ b/messages/uniworx/de-de-formal.msg @@ -1520,6 +1520,7 @@ BreadcrumbAdminWorkflowDefinitionDelete: Löschen BreadcrumbAdminWorkflowDefinitionInstantiate: Instanziieren BreadcrumbAdminWorkflowInstanceList: Workflow-Instanzen BreadcrumbAdminWorkflowInstanceNew: Neue Workflow-Instanz +BreadcrumbAdminWorkflowInstanceEdit: Instanz bearbeiten BreadcrumbAdminWorkflowWorkflowList: Initiierte Workflows BreadcrumbAdminWorkflowWorkflowNew: Workflow initiieren BreadcrumbWorkflowInstanceEdit win@WorkflowInstanceName: #{win} diff --git a/messages/uniworx/en-eu.msg b/messages/uniworx/en-eu.msg index ec78e0e99..e2ed32e5f 100644 --- a/messages/uniworx/en-eu.msg +++ b/messages/uniworx/en-eu.msg @@ -1520,6 +1520,7 @@ BreadcrumbAdminWorkflowDefinitionDelete: Delete BreadcrumbAdminWorkflowDefinitionInstantiate: Instantiate BreadcrumbAdminWorkflowInstanceList: Workflow instances BreadcrumbAdminWorkflowInstanceNew: New workflow-instance +BreadcrumbAdminWorkflowInstanceEdit: Edit instance BreadcrumbAdminWorkflowWorkflowList: Initiated workflows BreadcrumbAdminWorkflowWorkflowNew: Initiate workflow BreadcrumbWorkflowInstanceEdit win: #{win} diff --git a/routes b/routes index 9058f6ae6..c522e4129 100644 --- a/routes +++ b/routes @@ -66,6 +66,8 @@ /instantiate AWDInstantiateR GET POST /admin/workflows/instances AdminWorkflowInstanceListR GET /admin/workflows/instances/new AdminWorkflowInstanceNewR GET POST +/admin/workflows/instances/#CryptoUUIDWorkflowInstance AdminWorkflowInstanceR: + /edit AWIEditR GET POST /admin/workflows/workflows AdminWorkflowWorkflowListR GET /admin/workflows/workflows/new AdminWorkflowWorkflowNewR GET POST diff --git a/src/Foundation/Navigation.hs b/src/Foundation/Navigation.hs index 6ff58c1df..64f4a3466 100644 --- a/src/Foundation/Navigation.hs +++ b/src/Foundation/Navigation.hs @@ -368,6 +368,8 @@ instance BearerAuthSite UniWorX => YesodBreadcrumbs UniWorX where AWDInstantiateR -> i18nCrumb MsgBreadcrumbAdminWorkflowDefinitionInstantiate . Just $ AdminWorkflowDefinitionR wfdScope wfdName AWDEditR breadcrumb AdminWorkflowInstanceListR = i18nCrumb MsgBreadcrumbAdminWorkflowInstanceList $ Just AdminWorkflowDefinitionListR breadcrumb AdminWorkflowInstanceNewR = i18nCrumb MsgBreadcrumbAdminWorkflowInstanceNew $ Just AdminWorkflowInstanceListR + breadcrumb (AdminWorkflowInstanceR _cID sRoute) = case sRoute of + AWIEditR -> i18nCrumb MsgBreadcrumbAdminWorkflowInstanceEdit $ Just AdminWorkflowInstanceListR breadcrumb AdminWorkflowWorkflowListR = i18nCrumb MsgBreadcrumbAdminWorkflowWorkflowList $ Just AdminWorkflowInstanceListR breadcrumb AdminWorkflowWorkflowNewR = i18nCrumb MsgBreadcrumbAdminWorkflowWorkflowNew $ Just AdminWorkflowWorkflowListR diff --git a/src/Foundation/Routes.hs b/src/Foundation/Routes.hs index 59b6ac117..bb5dc51eb 100644 --- a/src/Foundation/Routes.hs +++ b/src/Foundation/Routes.hs @@ -39,6 +39,7 @@ deriving instance Generic ExamOfficeR deriving instance Generic CourseNewsR deriving instance Generic CourseEventR deriving instance Generic AdminWorkflowDefinitionR +deriving instance Generic AdminWorkflowInstanceR deriving instance Generic GlobalWorkflowInstanceR deriving instance Generic GlobalWorkflowWorkflowR deriving instance Generic SchoolWorkflowInstanceR @@ -64,6 +65,7 @@ deriving instance Ord ExamOfficeR deriving instance Ord CourseNewsR deriving instance Ord CourseEventR deriving instance Ord AdminWorkflowDefinitionR +deriving instance Ord AdminWorkflowInstanceR deriving instance Ord GlobalWorkflowInstanceR deriving instance Ord GlobalWorkflowWorkflowR deriving instance Ord SchoolWorkflowInstanceR diff --git a/src/Handler/Workflow/Definition/List.hs b/src/Handler/Workflow/Definition/List.hs index ae0eeae10..2944116d8 100644 --- a/src/Handler/Workflow/Definition/List.hs +++ b/src/Handler/Workflow/Definition/List.hs @@ -95,7 +95,7 @@ getAdminWorkflowDefinitionListR = do ] where anchorEdit :: (WorkflowDefinitionData -> Widget) -> _ - anchorEdit = anchorCell' (\(view $ resultDefinition . _entityVal -> WorkflowDefinition{..}) -> AdminWorkflowDefinitionR workflowDefinitionScope workflowDefinitionName AWDEditR) + anchorEdit = anchorCell' $ \(view $ resultDefinition . _entityVal -> WorkflowDefinition{..}) -> AdminWorkflowDefinitionR workflowDefinitionScope workflowDefinitionName AWDEditR displayGraph graph = [shamlet| $newline never diff --git a/src/Handler/Workflow/Instance/Edit.hs b/src/Handler/Workflow/Instance/Edit.hs index a9855c501..57e6b0752 100644 --- a/src/Handler/Workflow/Instance/Edit.hs +++ b/src/Handler/Workflow/Instance/Edit.hs @@ -2,6 +2,7 @@ module Handler.Workflow.Instance.Edit ( getGWIEditR, postGWIEditR , getSWIEditR, postSWIEditR , workflowInstanceEditR + , getAWIEditR, postAWIEditR ) where import Import @@ -19,3 +20,8 @@ postSWIEditR ssh = workflowInstanceEditR $ WSSchool ssh workflowInstanceEditR :: RouteWorkflowScope -> WorkflowInstanceName -> Handler Html workflowInstanceEditR = error "not implemented" + + +getAWIEditR, postAWIEditR :: CryptoUUIDWorkflowInstance -> Handler Html +getAWIEditR = postAWIEditR +postAWIEditR = error "not implemented" diff --git a/src/Handler/Workflow/Instance/List.hs b/src/Handler/Workflow/Instance/List.hs index 6c4ca426e..462db8547 100644 --- a/src/Handler/Workflow/Instance/List.hs +++ b/src/Handler/Workflow/Instance/List.hs @@ -86,13 +86,19 @@ getAdminWorkflowInstanceListR = do <$> view (_2 . _Value) dbtColonnade :: Colonnade Sortable WorkflowInstanceData _ dbtColonnade = mconcat - [ sortable (Just "name") (i18nCell MsgWorkflowInstanceName) $ views (resultWorkflowInstance . _entityVal . _workflowInstanceName) i18nCell + [ sortable (Just "name") (i18nCell MsgWorkflowInstanceName) . anchorEdit $ views (resultWorkflowInstance . _entityVal . _workflowInstanceName) i18n , sortable (Just "scope") (i18nCell MsgWorkflowScope) . views (resultWorkflowInstance . _entityVal . _workflowInstanceScope . re _DBWorkflowScope) $ sqlCell . maybeT (return mempty) . fmap i18n . toRouteWorkflowScope , sortable (Just "title") (i18nCell MsgWorkflowInstanceDescriptionTitle) $ maybe mempty i18nCell . preview (resultDescription . _entityVal . _workflowInstanceDescriptionTitle) , sortable (Just "workflows") (i18nCell MsgWorkflowInstanceWorkflowCount) $ maybe mempty i18nCell . views resultWorkflowCount (assertM' (> 0)) , sortable (Just "description") (i18nCell MsgWorkflowInstanceDescription) $ maybe mempty modalCell . preview (resultDescription . _entityVal . _workflowInstanceDescriptionDescription . _Just) ] + where + anchorEdit :: (WorkflowInstanceData -> Widget) -> _ + anchorEdit f x@(view $ resultWorkflowInstance . _entityKey -> wiId) = anchorCellM mkLink $ f x + where mkLink = do + cID <- encrypt wiId + return $ AdminWorkflowInstanceR cID AWIEditR dbtSorting = mconcat [ singletonMap "name" . SortColumn $ views queryWorkflowInstance (E.^. WorkflowInstanceName) , singletonMap "scope" . SortColumn $ views queryWorkflowInstance (E.^. WorkflowInstanceScope) diff --git a/test/FoundationSpec.hs b/test/FoundationSpec.hs index d838c14dd..63815f508 100644 --- a/test/FoundationSpec.hs +++ b/test/FoundationSpec.hs @@ -86,6 +86,10 @@ instance Arbitrary AdminWorkflowDefinitionR where arbitrary = genericArbitrary shrink = genericShrink +instance Arbitrary AdminWorkflowInstanceR where + arbitrary = genericArbitrary + shrink = genericShrink + instance Arbitrary GlobalWorkflowInstanceR where arbitrary = genericArbitrary shrink = genericShrink