fix: restore workflowWorkflowList columns
This commit is contained in:
Gregor Kleen
parent
6fb46c6e2b
commit
e55c6d795f
@ -35,10 +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 Control.Monad.Trans.State.Strict (execStateT)
|
||||
import qualified Control.Monad.State.Class as State
|
||||
|
||||
-- import qualified Data.RFC5051 as RFC5051
|
||||
import qualified Data.RFC5051 as RFC5051
|
||||
|
||||
|
||||
data WorkflowWorkflowListFilterProj = WorkflowWorkflowListFilterProj
|
||||
@ -204,8 +204,8 @@ resultWorkflowInstanceTitle = to $ \x -> case x ^? resultWorkflowInstanceDescrip
|
||||
resultLastAction :: Lens' WorkflowWorkflowData (Maybe WorkflowWorkflowActionData)
|
||||
resultLastAction = _dbrOutput . _6
|
||||
|
||||
-- resultPersons :: Traversal' WorkflowWorkflowData (Entity User)
|
||||
-- resultPersons = _dbrOutput . _7 . traverse
|
||||
resultPersons :: Traversal' WorkflowWorkflowData (Entity User)
|
||||
resultPersons = _dbrOutput . _7 . traverse
|
||||
|
||||
actionTo :: Lens' WorkflowWorkflowActionData (Maybe Text)
|
||||
actionTo = _1
|
||||
@ -307,53 +307,52 @@ workflowWorkflowList (title, heading) WWListColumns{..} sqlPred = do
|
||||
<*> pure actFinal
|
||||
lastAct <- descAction $ re _nullable . _Snoc . swapped
|
||||
|
||||
-- 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 . 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'
|
||||
persons <- lift . lift . mapMaybeM (MaybeT . getEntity) . toList $ view _1 persons' <> view (_2 . folded) persons'
|
||||
|
||||
-- return (cID, rScope, ww, mwi, wiDesc, lastAct, persons)
|
||||
return (cID, rScope, ww, mwi, wiDesc, lastAct, error "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 :: CryptoFileNameWorkflowWorkflow -> Text)
|
||||
-- , 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
|
||||
, 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)))
|
||||
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
|
||||
-- (Just n, Just fin) -> cell [whamlet|#{icon fin} #{n}|]
|
||||
-- actorCell = \case
|
||||
-- Nothing -> i18nCell MsgWorkflowWorkflowWorkflowHistoryUserAutomatic & addCellClass ("explanation" :: Text)
|
||||
-- Just WHIASelf -> i18nCell MsgWorkflowWorkflowWorkflowHistoryUserSelf & addCellClass ("explanation" :: Text)
|
||||
-- Just WHIAGone -> i18nCell MsgWorkflowWorkflowWorkflowHistoryUserGone & addCellClass ("explanation" :: Text)
|
||||
-- Just WHIAHidden -> i18nCell MsgWorkflowWorkflowWorkflowHistoryUserHidden & addCellClass ("explanation" :: Text)
|
||||
-- Just (WHIAOther Nothing) -> i18nCell MsgWorkflowWorkflowWorkflowHistoryUserNotLoggedIn & addCellClass ("explanation" :: Text)
|
||||
-- Just (WHIAOther (Just (Entity _ User{..}))) -> userCell userDisplayName userSurname
|
||||
stateCell = \case
|
||||
(Nothing, _) -> i18nCell MsgWorkflowWorkflowWorkflowHistoryStateHidden & addCellClass ("explanation" :: Text)
|
||||
(Just n, Nothing) -> textCell n
|
||||
(Just n, Just fin) -> cell [whamlet|#{icon fin} #{n}|]
|
||||
actorCell = \case
|
||||
Nothing -> i18nCell MsgWorkflowWorkflowWorkflowHistoryUserAutomatic & addCellClass ("explanation" :: Text)
|
||||
Just WHIASelf -> i18nCell MsgWorkflowWorkflowWorkflowHistoryUserSelf & addCellClass ("explanation" :: Text)
|
||||
Just WHIAGone -> i18nCell MsgWorkflowWorkflowWorkflowHistoryUserGone & addCellClass ("explanation" :: Text)
|
||||
Just WHIAHidden -> i18nCell MsgWorkflowWorkflowWorkflowHistoryUserHidden & addCellClass ("explanation" :: Text)
|
||||
Just (WHIAOther Nothing) -> i18nCell MsgWorkflowWorkflowWorkflowHistoryUserNotLoggedIn & addCellClass ("explanation" :: Text)
|
||||
Just (WHIAOther (Just (Entity _ User{..}))) -> userCell userDisplayName userSurname
|
||||
|
||||
anchorWorkflowWorkflow :: (WorkflowWorkflowData -> Widget) -> _
|
||||
anchorWorkflowWorkflow f = maybeAnchorCellM <$> mkLink <*> f
|
||||
@ -361,15 +360,15 @@ workflowWorkflowList (title, heading) WWListColumns{..} sqlPred = do
|
||||
cID <- view resultWorkflowWorkflowId
|
||||
rScope <- hoistMaybe =<< view resultRouteScope
|
||||
return $ _WorkflowScopeRoute # (rScope, WorkflowWorkflowR cID WWWorkflowR)
|
||||
-- anchorWorkflowScope f = maybeAnchorCellM <$> mkLink <*> f
|
||||
-- where mkLink = runReaderT $ do
|
||||
-- rScope <- hoistMaybe =<< view resultRouteScope
|
||||
-- return $ _WorkflowScopeRoute # (rScope, WorkflowWorkflowListR)
|
||||
-- anchorWorkflowInstance f = maybeAnchorCellM <$> mkLink <*> f
|
||||
-- where mkLink = runReaderT $ do
|
||||
-- rScope <- hoistMaybe =<< view resultRouteScope
|
||||
-- win <- hoistMaybe =<< preview (resultWorkflowInstance . _Just . _entityVal . _workflowInstanceName)
|
||||
-- return $ _WorkflowScopeRoute # (rScope, WorkflowInstanceR win WIWorkflowsR)
|
||||
anchorWorkflowScope f = maybeAnchorCellM <$> mkLink <*> f
|
||||
where mkLink = runReaderT $ do
|
||||
rScope <- hoistMaybe =<< view resultRouteScope
|
||||
return $ _WorkflowScopeRoute # (rScope, WorkflowWorkflowListR)
|
||||
anchorWorkflowInstance f = maybeAnchorCellM <$> mkLink <*> f
|
||||
where mkLink = runReaderT $ do
|
||||
rScope <- hoistMaybe =<< view resultRouteScope
|
||||
win <- hoistMaybe =<< preview (resultWorkflowInstance . _Just . _entityVal . _workflowInstanceName)
|
||||
return $ _WorkflowScopeRoute # (rScope, WorkflowInstanceR win WIWorkflowsR)
|
||||
dbtSorting = mconcat
|
||||
[ singletonMap "workflow-workflow" . SortProjected . comparing $ view resultWorkflowWorkflowId
|
||||
, singletonMap "scope" . SortProjected . comparing $ view resultRouteScope
|
||||
|
||||
Loading…
Reference in New Issue
Block a user