diff --git a/src/Handler/Workflow/Workflow/Workflow.hs b/src/Handler/Workflow/Workflow/Workflow.hs index 441fa1d54..61bac5894 100644 --- a/src/Handler/Workflow/Workflow/Workflow.hs +++ b/src/Handler/Workflow/Workflow/Workflow.hs @@ -81,7 +81,7 @@ workflowR rScope cID = workflowsDisabledWarning title heading $ do WorkflowWorkflow{..} <- get404 wwId maybeT notFound . void . assertM (== review _DBWorkflowScope workflowWorkflowScope) $ fromRouteWorkflowScope rScope mEdgeForm <- workflowEdgeForm (Right wwId) Nothing - wGraph <- getSharedIdWorkflowGraph workflowWorkflowGraph + wGraph@WorkflowGraph{..} <- getSharedIdWorkflowGraph workflowWorkflowGraph let canonRoute = _WorkflowScopeRoute # (rScope, WorkflowWorkflowR cID WWWorkflowR) mEdge <- for mEdgeForm $ \edgeForm -> do @@ -94,7 +94,15 @@ workflowR rScope cID = workflowsDisabledWarning title heading $ do wiScope <- maybeT notFound . toRouteWorkflowScope $ _DBWorkflowScope # workflowInstanceScope return (wiScope, Entity wiId wInstance) - update wwId [ WorkflowWorkflowState =. view _DBWorkflowState nState ] + wwArchived <- lift . maybeT (pure Nothing) $ do + archiveAfter <- MaybeT . getsYesod $ view _appWorkflowWorkflowArchiveAfter + let WorkflowAction{wpTo,wpTime} = last nState + WGN{wgnFinal} <- hoistMaybe $ Map.lookup wpTo wgNodes + return $ const (archiveAfter `addUTCTime` wpTime) <$> wgnFinal + + update wwId [ WorkflowWorkflowState =. view _DBWorkflowState nState + , WorkflowWorkflowArchived =. wwArchived + ] return . Just $ do whenIsJust wInstance $ \(wiScope, Entity _ WorkflowInstance{..}) -> do @@ -207,7 +215,6 @@ workflowR rScope cID = workflowsDisabledWarning title heading $ do tell ( Just $ Last WorkflowCurrentState{..} , pure WorkflowHistoryItem{..} ) - WorkflowGraph{..} = wGraph wState = review _DBWorkflowState workflowWorkflowState in fmap (over _2 (sortOn (Down . whiTime) . reverse) . view _2) . runConduit $ sourceWorkflowActionInfos wwId wState .| execRWSC () Map.empty (C.mapM_ go) return (mEdge, (workflowState, workflowHistory))