feat(workflows): list involved users

messages/uniworx/misc/de-de-formal.msg

@@ -3231,3 +3231,6 @@ CorrectionInvisibleExamUnfinished: Die Frist „_{MsgExamFinished}“ für die r
 CorrectionInvisibleRatingNotDone: Die Bewertung ist nicht als „Abgeschlossen“ markiert
 CorrectionInvisibleWarning: Die Bewertung dieser Abgabe ist aktuell für mindestens eine an der Abgabe beteiligte Person nicht sichtbar!
 CorrectionInvisibleReasons: Mögliche Gründe hierfür:
+
+
+WorkflowWorkflowListPersons: Beteiligte Benutzer

messages/uniworx/misc/en-eu.msg

@@ -3231,3 +3231,6 @@ CorrectionInvisibleExamUnfinished: The time configured in “_{MsgExamFinished}
 CorrectionInvisibleRatingNotDone: The correction is not marked as “finished”
 CorrectionInvisibleWarning: This correction is currently invisible for at least one of the submittors!
 CorrectionInvisibleReasons: Possible reasons include:
+
+
+WorkflowWorkflowListPersons: Involved users

src/Handler/Utils/Table/Pagination.hs

@@ -1699,13 +1699,13 @@ maybeLinkEitherCellCM' mCache xM x2route (x2widgetAuth,x2widgetUnauth) = cell $
       toWidget $ x2widgetUnauth Nothing
 
 
-listCell :: (IsDBTable m a, Traversable f) => f r' -> (r' -> DBCell m a) -> DBCell m a
+listCell :: (IsDBTable m a, MonoFoldable mono) => mono -> (Element mono -> DBCell m a) -> DBCell m a
 listCell = listCell' . return
   
-listCell' :: (IsDBTable m a, Traversable f) => WriterT a m (f r') -> (r' -> DBCell m a) -> DBCell m a
+listCell' :: (IsDBTable m a, MonoFoldable mono) => WriterT a m mono -> (Element mono -> DBCell m a) -> DBCell m a
 listCell' mkXS mkCell = review dbCell . ([], ) $ do
   xs <- mkXS
-  cells <- forM xs $
+  cells <- forM (toList xs) $
     \(view dbCell . mkCell -> (attrs, mkWidget)) -> (attrs, ) <$> mkWidget
   return $(widgetFile "table/cell/list")
 

src/Handler/Workflow/Workflow/List.hs

@@ -35,6 +35,10 @@ import Data.Semigroup (Last(..))
 import qualified Data.Monoid as Monoid (Last(..))
 
 import Control.Monad.Trans.Writer.Strict (WriterT)
+import Control.Monad.Trans.State.Strict (execStateT)
+import qualified Control.Monad.State.Class as State
+
+import qualified Data.RFC5051 as RFC5051
 
 
 getGlobalWorkflowWorkflowListR :: Handler Html
@@ -115,6 +119,7 @@ type WorkflowWorkflowData = DBRow
   , Maybe (Entity WorkflowInstance)
   , Maybe (Entity WorkflowInstanceDescription)
   , Maybe WorkflowWorkflowActionData -- ^ Last Action
+  , [Entity User]
   )
 
 type WorkflowWorkflowActionData = ( Maybe Text
@@ -181,6 +186,9 @@ resultWorkflowInstanceTitle = to $ \x -> case x ^? resultWorkflowInstanceDescrip
 resultLastAction :: Lens' WorkflowWorkflowData (Maybe WorkflowWorkflowActionData)
 resultLastAction = _dbrOutput . _6
 
+resultPersons :: Traversal' WorkflowWorkflowData (Entity User)
+resultPersons = _dbrOutput . _7 . traverse
+
 actionTo :: Lens' WorkflowWorkflowActionData (Maybe Text)
 actionTo = _1
 
@@ -243,7 +251,7 @@ workflowWorkflowList (title, heading) WWListColumns{..} sqlPred = do
                 where
                   go Nothing = return Nothing
                   go (Just (act, newSt)) = maybeT (go $ newSt ^? _nullable . p) $ do
-                    guardM . lift . $cachedHereBinary (wwId, wpTo act, wpUser act, Map.keys $ wpPayload act) $ mayViewWorkflowAction mAuthId wwId act
+                    guardM . lift $ mayViewWorkflowAction mAuthId wwId act
                     Just <$> lift (w act)
               descAction p = goAction p $ \WorkflowAction{..} ->
                 let actName = runMaybeT $ do
@@ -272,17 +280,41 @@ workflowWorkflowList (title, heading) WWListColumns{..} sqlPred = do
                       <*> pure actFinal
             lastAct <- descAction $ re _nullable . _Snoc . swapped
 
-            return (cID, rScope, ww, mwi, wiDesc, lastAct)
+            persons' <- lift . flip (execStateT @_ @(Set UserId, Map WorkflowPayloadLabel (Set UserId))) mempty . forM_ (ww ^.. _entityVal . _workflowWorkflowState . from _DBWorkflowState . re _nullable . folded) $ \act -> maybeT_ . forM_ (join $ wpUser act) $ \wpUser' -> do
+              let mVia = Map.lookup (wpVia act) . wgnEdges =<< Map.lookup (wpTo act) wgNodes
+              guardM . lift . lift $ mayViewWorkflowAction mAuthId wwId act
+              lift . maybeT_ . hoist (zoom _1) $ do
+                viewActors <- hoistMaybe $ preview _wgeViewActor =<< mVia
+                guardM . lift . lift $ anyM (otoList viewActors) hasWorkflowRole'
+                State.modify' $ Set.insert wpUser'
+              iforM_ (wpPayload act) $ \pLbl ps -> lift . maybeT_ . hoist (zoom _2) $ do
+                let users = setOf (typesCustom @WorkflowChildren) ps
+                guard . not $ null users
+                WorkflowPayloadView{..} <- hoistMaybe $ do
+                  WGN{wgnPayloadView} <- Map.lookup (wpTo act) wgNodes
+                  Map.lookup pLbl wgnPayloadView
+                guardM . lift . lift $ anyM (otoList wpvViewers) hasWorkflowRole'
+                at pLbl ?= users
+
+            persons <- lift . mapMaybeM (MaybeT . getEntity) . toList $ view _1 persons' <> view (_2 . folded) persons'
+
+            return (cID, rScope, ww, mwi, wiDesc, lastAct, persons)
           dbtColonnade :: Colonnade Sortable _ _
           dbtColonnade = mconcat -- TODO: columns
             [ sortable (Just "workflow-workflow") (i18nCell MsgWorkflowWorkflowListNumber) . (addCellClass ("cryptoid" :: Text) .) . anchorWorkflowWorkflow . views resultWorkflowWorkflowId $ toWidget . toPathPiece
             , guardMonoid wwListColumnScope . sortable (Just "scope") (i18nCell MsgWorkflowWorkflowListScope) $ \x -> foldMap (\t -> anchorWorkflowScope (const $ i18n t :: _ -> Widget) x) $ view resultRouteScope x
             , guardMonoid wwListColumnInstance . sortable (Just "instance") (i18nCell MsgWorkflowWorkflowListInstance) $ \x -> foldMap (\t -> anchorWorkflowInstance (const t) x) $ preview resultWorkflowInstanceTitle x
+            , sortable Nothing (i18nCell MsgWorkflowWorkflowListPersons) $ \x ->
+                let lCell = flip listCell (uncurry userCell) . sortBy personCmp $ x ^.. resultPersons . _entityVal . to ((,) <$> userDisplayName <*> userSurname)
+                 in lCell & cellAttrs <>~ [("class", "list--inline list--comma-separated")]
             , sortable (Just "current-state") (i18nCell MsgWorkflowWorkflowListCurrentState) $ fromMaybe mempty . previews (resultLastAction . _Just . $(multifocusL 2) actionTo actionFinal) stateCell
             , sortable (Just "last-action-time") (i18nCell MsgWorkflowWorkflowListLastActionTime) $ fromMaybe mempty . previews (resultLastAction . _Just . actionTime) dateTimeCell
             , sortable (Just "last-action-user") (i18nCell MsgWorkflowWorkflowListLastActionUser) $ fromMaybe mempty . previews (resultLastAction . _Just . actionActor) actorCell
             ]
             where
+              personCmp = (RFC5051.compareUnicode `on` (pack . toListOf (_2 . to (unpack . CI.foldCase) . folded)))
+                       <> (RFC5051.compareUnicode `on` (pack . toListOf (_1 . to (unpack . CI.foldCase) . folded)))
+              
               stateCell = \case
                 (Nothing, _) -> i18nCell MsgWorkflowWorkflowWorkflowHistoryStateHidden & addCellClass ("explanation" :: Text)
                 (Just n, Nothing) -> textCell n