feat(workflows): list involved users
This commit is contained in:
Gregor Kleen
parent
1a4469aefd
commit
d8878a905e
@ -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
|
||||
@ -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
|
||||
@ -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")
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user