{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}

module Handler.Workflow.Workflow.List
  ( getGlobalWorkflowWorkflowListR 
  , getSchoolWorkflowWorkflowListR
  , workflowWorkflowListR
  , getGWIWorkflowsR 
  , getSWIWorkflowsR
  , workflowInstanceWorkflowsR 
  , getAdminWorkflowWorkflowListR
  , getTopWorkflowWorkflowListR
  ) where

import Import hiding (Last(..), WriterT)

import Utils.Workflow
import Handler.Utils.Workflow

import Handler.Workflow.Workflow.Workflow (WorkflowHistoryItemActor'(..), WorkflowHistoryItemActor)

import qualified Database.Esqueleto.Legacy as E
import qualified Database.Esqueleto.Utils as E

import Utils.Form
import Handler.Utils hiding (columns)
import qualified Data.CaseInsensitive as CI

import qualified Data.Set as Set
import qualified Data.Map as Map

import qualified Data.Conduit.Combinators as C

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


data WorkflowWorkflowListFilterProj = WorkflowWorkflowListFilterProj 
  { wwProjFilterMayAccess :: Maybe Bool
  , wwProjFilterWorkflowWorkflow :: Maybe [[CI Char]]
  , wwProjFilterCurrentState :: Maybe [[CI Char]]
  , wwProjFilterFinal :: Maybe Bool
  }

instance Default WorkflowWorkflowListFilterProj where
  def = WorkflowWorkflowListFilterProj 
    { wwProjFilterMayAccess = Nothing
    , wwProjFilterWorkflowWorkflow = Nothing
    , wwProjFilterCurrentState = Nothing
    , wwProjFilterFinal = Nothing
    }

makeLenses_ ''WorkflowWorkflowListFilterProj 


getGlobalWorkflowWorkflowListR :: Handler Html
getGlobalWorkflowWorkflowListR = workflowWorkflowListR WSGlobal

getSchoolWorkflowWorkflowListR :: SchoolId -> Handler Html
getSchoolWorkflowWorkflowListR = workflowWorkflowListR . WSSchool

workflowWorkflowListR :: RouteWorkflowScope -> Handler Html
workflowWorkflowListR rScope = workflowsDisabledWarning (headings ^. _1) (headings ^. _2) $ do
  scope <- runDB . maybeT notFound $ fromRouteWorkflowScope rScope
  workflowWorkflowList headings columns . runReader $ do
    workflowWorkflow <- view queryWorkflowWorkflow
    return $ workflowWorkflow E.^. WorkflowWorkflowScope E.==. E.val (scope ^. _DBWorkflowScope)
  where
     columns = def
        { wwListColumnScope = False
        }
     headings = (MsgWorkflowWorkflowListScopeTitle rScope, MsgWorkflowWorkflowListScopeHeading rScope)


getGWIWorkflowsR :: WorkflowInstanceName -> Handler Html
getGWIWorkflowsR = workflowInstanceWorkflowsR WSGlobal

getSWIWorkflowsR :: SchoolId -> WorkflowInstanceName -> Handler Html
getSWIWorkflowsR ssh = workflowInstanceWorkflowsR $ WSSchool ssh

workflowInstanceWorkflowsR :: RouteWorkflowScope -> WorkflowInstanceName -> Handler Html
workflowInstanceWorkflowsR rScope win = workflowsDisabledWarning (MsgWorkflowWorkflowListNamedInstanceTitleDisabled rScope) (MsgWorkflowWorkflowListNamedInstanceHeadingDisabled rScope) $ do
  (scope, desc) <- runDB $ do
    scope <- maybeT notFound $ fromRouteWorkflowScope rScope
    wiId <- getKeyBy404 . UniqueWorkflowInstance win $ scope ^. _DBWorkflowScope
    desc <- selectWorkflowInstanceDescription wiId
    return (scope, desc)
  let headings = case desc of
        Nothing -> (MsgWorkflowWorkflowListInstanceTitle, MsgWorkflowWorkflowListInstanceHeading)
        Just (Entity _ WorkflowInstanceDescription{..})
          -> ( MsgWorkflowWorkflowListNamedInstanceTitle rScope workflowInstanceDescriptionTitle
             , MsgWorkflowWorkflowListNamedInstanceHeading rScope workflowInstanceDescriptionTitle
             )
  workflowWorkflowList headings columns . runReader $ do
    workflowWorkflow <- view queryWorkflowWorkflow
    return . E.exists . E.from $ \workflowInstance ->
      E.where_ $ workflowInstance E.^. WorkflowInstanceName E.==. E.val win
           E.&&. workflowInstance E.^. WorkflowInstanceScope E.==. E.val (scope ^. _DBWorkflowScope)
           E.&&. workflowWorkflow E.^. WorkflowWorkflowInstance E.==. E.just (workflowInstance E.^. WorkflowInstanceId)
  where
    columns = def
        { wwListColumnInstance = False
        , wwListColumnScope    = False
        }


getAdminWorkflowWorkflowListR :: Handler Html
getAdminWorkflowWorkflowListR = workflowWorkflowList headings def $ const E.true
  where headings = (MsgAdminWorkflowWorkflowListTitle, MsgAdminWorkflowWorkflowListHeading)

getTopWorkflowWorkflowListR :: Handler Html
getTopWorkflowWorkflowListR = workflowsDisabledWarning (headings ^. _1) (headings ^. _2) . workflowWorkflowList headings def . views queryWorkflowWorkflow $ isTopWorkflowScopeSql . (E.^. WorkflowWorkflowScope)
  where headings = (MsgWorkflowWorkflowListTopTitle, MsgWorkflowWorkflowListTopHeading)


type WorkflowWorkflowTableExpr = E.SqlExpr (Entity WorkflowWorkflow)
               `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity WorkflowInstance))

queryWorkflowWorkflow :: Getter WorkflowWorkflowTableExpr (E.SqlExpr (Entity WorkflowWorkflow))
queryWorkflowWorkflow = to $(E.sqlLOJproj 2 1)
  
queryWorkflowInstance :: Getter WorkflowWorkflowTableExpr (E.SqlExpr (Maybe (Entity WorkflowInstance)))
queryWorkflowInstance = to $(E.sqlLOJproj 2 2)

type WorkflowWorkflowData = DBRow
  ( CryptoFileNameWorkflowWorkflow
  , Maybe RouteWorkflowScope
  , Entity WorkflowWorkflow
  , Maybe (Entity WorkflowInstance)
  , Maybe (Entity WorkflowInstanceDescription)
  , Maybe WorkflowWorkflowActionData
  , [Entity User]
  )
-- ^ @Maybe `WorkflowWorkflowActionData`@ corresponds to last action

type WorkflowWorkflowActionData = ( Maybe Text
                                  , UTCTime
                                  , Maybe WorkflowHistoryItemActor
                                  , Maybe Icon
                                  )

data JsonWorkflowWorkflow = JsonWorkflowWorkflow
  { jwwScope          :: Maybe RouteWorkflowScope
  , jwwInstance       :: Maybe JsonWorkflowInstance
  , jwwLastAction     :: Maybe JsonWorkflowAction
  , jwwPayload        :: Map WorkflowPayloadLabel JsonWorkflowPayload
  } deriving (Generic)

data JsonWorkflowAction = JsonWorkflowAction
  { jwaIx   :: CryptoUUIDWorkflowStateIndex
  , jwaTo   :: Maybe WorkflowGraphNodeLabel
  , jwaUser :: Maybe JsonWorkflowUser
  , jwaTime :: UTCTime
  } deriving (Generic)

data JsonWorkflowInstance = JsonWorkflowInstance
  { jwiScope :: RouteWorkflowScope
  , jwiName  :: WorkflowInstanceName
  } deriving (Generic)

data JsonWorkflowPayload = JsonWorkflowPayload
  { jwpPayload :: [WorkflowFieldPayloadW Void JsonWorkflowUser]
  , jwpHasFiles :: Bool
  } deriving (Generic)

data JsonWorkflowUser
  = JsonWorkflowUserUser
    { jwuDisplayName   :: UserDisplayName
    , jwuMatriculation :: Maybe UserMatriculation
    , jwuDisplayEmail  :: UserEmail
    }
  | JsonWorkflowUserAnonymous
  | JsonWorkflowUserHidden
  | JsonWorkflowUserGone
  deriving (Generic)

resultWorkflowWorkflowId :: Lens' WorkflowWorkflowData CryptoFileNameWorkflowWorkflow
resultWorkflowWorkflowId = _dbrOutput . _1

resultRouteScope :: Lens' WorkflowWorkflowData (Maybe RouteWorkflowScope)
resultRouteScope = _dbrOutput . _2

resultWorkflowWorkflow :: Lens' WorkflowWorkflowData (Entity WorkflowWorkflow)
resultWorkflowWorkflow = _dbrOutput . _3

resultWorkflowInstance :: Lens' WorkflowWorkflowData (Maybe (Entity WorkflowInstance))
resultWorkflowInstance = _dbrOutput . _4

resultWorkflowInstanceDescription :: Lens' WorkflowWorkflowData (Maybe (Entity WorkflowInstanceDescription))
resultWorkflowInstanceDescription = _dbrOutput . _5

resultWorkflowInstanceTitle :: Getter WorkflowWorkflowData Text
resultWorkflowInstanceTitle = to $ \x -> case x ^? resultWorkflowInstanceDescription . _Just . _entityVal . _workflowInstanceDescriptionTitle of
  Just dTitle -> dTitle
  Nothing -> x ^. resultWorkflowInstance . _Just . _entityVal . _workflowInstanceName . to CI.original

resultLastAction :: Lens' WorkflowWorkflowData (Maybe WorkflowWorkflowActionData)
resultLastAction = _dbrOutput . _6

resultPersons :: Traversal' WorkflowWorkflowData (Entity User)
resultPersons = _dbrOutput . _7 . traverse

actionTo :: Lens' WorkflowWorkflowActionData (Maybe Text)
actionTo = _1

actionTime :: Lens' WorkflowWorkflowActionData UTCTime
actionTime = _2
  
actionActor :: Lens' WorkflowWorkflowActionData (Maybe WorkflowHistoryItemActor)
actionActor = _3
  
actionFinal :: Lens' WorkflowWorkflowActionData (Maybe Icon)
actionFinal = _4

data WorkflowWorkflowListColumns = WWListColumns
  { wwListColumnInstance :: Bool
  , wwListColumnScope    :: Bool
  }

instance Default WorkflowWorkflowListColumns where
  def = WWListColumns
    { wwListColumnInstance = True
    , wwListColumnScope    = True
    }
  
workflowWorkflowList :: ( RenderMessage UniWorX title, RenderMessage UniWorX heading)
                     => (title, heading)
                     -> WorkflowWorkflowListColumns
                     -> (WorkflowWorkflowTableExpr -> E.SqlExpr (E.Value Bool))
                     -> Handler Html
workflowWorkflowList (title, heading) WWListColumns{..} sqlPred = do 
  mAuthId <- maybeAuthId
  
  workflowTable <- runDB $
    let
      workflowWorkflowDBTable = DBTable{..}
        where
          dbtSQLQuery = runReaderT $ do
            workflowWorkflow <- view queryWorkflowWorkflow
            workflowInstance <- view queryWorkflowInstance
            lift . E.on $ workflowWorkflow E.^. WorkflowWorkflowInstance E.==. workflowInstance E.?. WorkflowInstanceId
            lift <=< asks $ E.where_ . sqlPred
            return (workflowWorkflow, workflowInstance)
          dbtRowKey = views queryWorkflowWorkflow (E.^. WorkflowWorkflowId)
          dbtProj = (views _dbtProjRow . set _dbrOutput) =<< do
            ww@(Entity wwId WorkflowWorkflow{..}) <- view $ _dbtProjRow . _dbrOutput . _1
            mwi <- view $ _dbtProjRow . _dbrOutput . _2

            cID <- encrypt wwId
            forMM_ (view $ _dbtProjFilter . _wwProjFilterWorkflowWorkflow) $ \criteria ->
              let haystack = map CI.mk . unpack $ toPathPiece cID
               in guard $ any (`isInfixOf` haystack) criteria
  
            rScope <- lift . lift . runMaybeT . toRouteWorkflowScope $ _DBWorkflowScope # workflowWorkflowScope
            forMM_ (view $ _dbtProjFilter . _wwProjFilterMayAccess) $ \needle -> do
              rScope' <- hoistMaybe rScope
              guardM . lift . lift $ (== needle) . is _Authorized <$> evalAccess (_WorkflowScopeRoute # (rScope', WorkflowWorkflowR cID WWWorkflowR)) False
  
            wiDesc <- lift . lift . $cachedHereBinary (entityKey <$> mwi) . runMaybeT $ do
              Entity wiId _ <- hoistMaybe mwi
              MaybeT $ selectWorkflowInstanceDescription wiId
            WorkflowGraph{..} <- lift . lift . getSharedIdWorkflowGraph $ ww ^. _entityVal . _workflowWorkflowGraph
            let hasWorkflowRole' :: WorkflowRole UserId -> DB Bool
                hasWorkflowRole' role = maybeT (return False) $ do
                  rScope' <- hoistMaybe rScope
                  let canonRoute = _WorkflowScopeRoute # (rScope', WorkflowWorkflowR cID WWWorkflowR)
                  lift . $cachedHereBinary (wwId, role) $ is _Authorized <$> hasWorkflowRole (Just wwId) role canonRoute False

            let
              goAction p w = lift . lift . go $ ww ^? _entityVal . _workflowWorkflowState . from _DBWorkflowState . p
                where
                  go Nothing = return Nothing
                  go (Just (act, newSt)) = maybeT (go $ newSt ^? _nullable . p) $ do
                    guardM . lift $ mayViewWorkflowAction mAuthId wwId act
                    Just <$> lift (w act)
              descAction p = goAction p $ \WorkflowAction{..} ->
                let actName = runMaybeT $ do
                      WorkflowNodeView{..} <- hoistMaybe $ Map.lookup wpTo wgNodes >>= wgnViewers
                      guardM . lift $ anyM (otoList wnvViewers) hasWorkflowRole'
                      selectLanguageI18n wnvDisplayLabel
                    actUser = for wpUser $ \wpUser' -> if
                      | is _Just mAuthId
                      , wpUser' == mAuthId -> return WHIASelf
                      | otherwise -> maybeT (return WHIAHidden) $ do
                          viewActors <- hoistMaybe $ preview _wgeViewActor =<< mVia
                          guardM . lift $ anyM (otoList viewActors) hasWorkflowRole'
                          resUser <- lift . for wpUser' $ \uid -> $cachedHereBinary uid $ getEntity uid
                          return $ case resUser of
                            Nothing          -> WHIAOther Nothing
                            Just Nothing     -> WHIAGone
                            Just (Just uEnt) -> WHIAOther $ Just uEnt
                      where mVia = Map.lookup wpVia . wgnEdges =<< Map.lookup wpTo wgNodes
                    actFinal = do
                      WGN{..} <- Map.lookup wpTo wgNodes
                      wgnFinal
                 in (,,,)
                      <$> actName
                      <*> pure wpTime
                      <*> actUser
                      <*> pure actFinal
            lastAct <- descAction $ re _nullable . _Snoc . swapped

            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 . 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 :: 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
            ]
            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
                (Just n, Just fin) -> cell [whamlet|#{icon fin}&nbsp;#{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
                where mkLink = runReaderT $ 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)
          dbtSorting = mconcat
            [ singletonMap "workflow-workflow" . SortProjected . comparing $ view resultWorkflowWorkflowId
            , singletonMap "scope" . SortProjected . comparing $ view resultRouteScope
            , singletonMap "instance" . SortProjected . comparing $ preview resultWorkflowInstanceTitle
            , singletonMap "current-state" . SortProjected . comparing . preview $ resultLastAction . _Just . actionTo . _Just
            , singletonMap "last-action-time" . SortProjected . comparing . preview $ resultLastAction . _Just . actionTime
            , singletonMap "last-action-user" . SortProjected . comparing . preview $ resultLastAction . _Just . actionActor . to (over (mapped . mapped) $ \(Entity _ User{..}) -> (userSurname, userDisplayName))
            , singletonMap "final" . SortProjected . comparing $ \x -> guardOnM (has (resultLastAction . _Just . actionTo . _Just) x) (x ^? resultLastAction . _Just . actionFinal . _Just)
            ]
          dbtFilter = mconcat
            [ singletonMap "workflow-workflow" . FilterProjected $ \(criteria :: Set Text) ->
                let criteria' = map CI.mk . unpack <$> Set.toList criteria
                 in _wwProjFilterWorkflowWorkflow ?~ criteria'
            , singletonMap "current-state" . FilterProjected $ \(criteria :: Set Text) -> -- TODO
                let criteria' = map CI.mk . unpack <$> Set.toList criteria
                 in _wwProjFilterCurrentState ?~ criteria'
            , singletonMap "final" . FilterProjected $ \(criterion :: Monoid.Last Bool) -> case Monoid.getLast criterion of -- TODO
                Nothing -> id
                Just needle -> _wwProjFilterFinal ?~ needle
            , singletonMap "may-access" . FilterProjected $ \(Any criterion) -> _wwProjFilterMayAccess ?~ criterion
            ]
            -- [ singletonMap "workflow-workflow" . FilterProjected $ \x (criteria :: Set Text) ->
            --     let cid = map CI.mk . unpack . toPathPiece $ x ^. resultWorkflowWorkflowId
            --         criteria' = map CI.mk . unpack <$> Set.toList criteria
            --      in any (`isInfixOf` cid) criteria'
            -- , 
            
            -- , singletonMap "may-access" . FilterPreProjected $ \(x :: DBRow (Entity WorkflowWorkflow, Maybe (Entity WorkflowInstance))) (Any b) -> fmap (== b) . maybeT (return False) $ do
            --     let Entity wwId WorkflowWorkflow{..} = x ^. _dbrOutput . _1
            --     cID <- encrypt wwId
            --     rScope <- toRouteWorkflowScope $ _DBWorkflowScope # workflowWorkflowScope
            --     lift $ is _Authorized <$> evalAccess (_WorkflowScopeRoute # (rScope, WorkflowWorkflowR cID WWWorkflowR)) False :: MaybeT (YesodDB UniWorX) Bool
            -- , singletonMap "current-state" . FilterProjected $ \x (criteria :: Set Text) ->
            --     let criteria' = map CI.mk . unpack <$> Set.toList criteria
            --      in maybe False (\cSt -> any (`isInfixOf` cSt) criteria') $ x ^? resultLastAction . _Just . actionTo . _Just . to (map CI.mk . unpack)
            -- , singletonMap "final" . FilterProjected $ \x (criterion :: Monoid.Last Bool) -> case Monoid.getLast criterion of
            --     Nothing -> True
            --     Just needle -> let val = has (resultLastAction . _Just . actionTo . _Just) x
            --                           && has (resultLastAction . _Just . actionFinal . _Just) x
            --                     in needle == val
            -- ]
          dbtFilterUI = mconcat
            [ flip (prismAForm $ singletonFilter "workflow-workflow") $ aopt textField (fslI MsgWorkflowWorkflowListNumber)
            , flip (prismAForm $ singletonFilter "current-state") $ aopt textField (fslI MsgWorkflowWorkflowListCurrentState)

            , flip (prismAForm (singletonFilter "final" . maybePrism _PathPiece)) $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgWorkflowWorkflowListIsFinal)
            ]
          dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout }
          dbtParams = def
          dbtIdent :: Text
          dbtIdent = "workflow-workflows"
          dbtCsvEncode = noCsvEncode
          dbtCsvDecode = Nothing
          dbtExtraReps = [ DBTExtraRep $ toPrettyJSON <$> repWorkflowWorkflowJson, DBTExtraRep $ toYAML <$> repWorkflowWorkflowJson ]

          repWorkflowWorkflowJson :: ConduitT (E.Value WorkflowWorkflowId, WorkflowWorkflowData) Void DB (Map CryptoFileNameWorkflowWorkflow JsonWorkflowWorkflow)
          repWorkflowWorkflowJson = C.foldMapM $ \(E.Value wwId, res) -> do
            cID <- encrypt wwId
            Map.singleton cID <$> do
              let jwwScope = guardOnM wwListColumnScope $ res ^. resultRouteScope
              jwwInstance <- fmap join . for (guardOnM wwListColumnInstance $ res ^. resultWorkflowInstance) $ \(Entity _ WorkflowInstance{..}) -> runMaybeT $ do
                jwiScope <- toRouteWorkflowScope $ _DBWorkflowScope # workflowInstanceScope
                let jwiName = workflowInstanceName
                return JsonWorkflowInstance{..}
              let Entity _ WorkflowWorkflow{..} = res ^. resultWorkflowWorkflow
              WorkflowGraph{..} <- getSharedIdWorkflowGraph workflowWorkflowGraph
              (fmap getLast -> wState) <-
                let go :: forall m.
                          ( MonadHandler m
                          , HandlerSite m ~ UniWorX
                          , MonadCatch m
                          , MonadUnliftIO m
                          )
                       => WorkflowActionInfo FileReference UserId
                       -> WriterT (Maybe (Last (CryptoUUIDWorkflowStateIndex, Maybe WorkflowGraphNodeLabel, Maybe JsonWorkflowUser, UTCTime, Map WorkflowPayloadLabel JsonWorkflowPayload))) (SqlPersistT m) ()
                    go WorkflowActionInfo{ waiIx = stIx, waiHistory = (workflowStateCurrentPayloads -> currentPayload), waiAction = WorkflowAction{..}} = maybeT_ $ do
                      stCID <- encryptWorkflowStateIndex wwId stIx

                      rScope <- hoistMaybe $ res ^. resultRouteScope

                      let toJsonUser (Just (Entity _ User{..})) = JsonWorkflowUserUser
                            { jwuDisplayName   = userDisplayName
                            , jwuMatriculation = userMatrikelnummer
                            , jwuDisplayEmail  = userDisplayEmail
                            }
                          toJsonUser Nothing = JsonWorkflowUserGone

                          mVia = Map.lookup wpVia . wgnEdges =<< Map.lookup wpTo wgNodes
                          hasWorkflowRole' role = $cachedHereBinary (rScope, wwId, role) . lift . lift $ is _Authorized <$> hasWorkflowRole (Just wwId) role canonRoute False
                          canonRoute = _WorkflowScopeRoute # (rScope, WorkflowWorkflowR cID WWWorkflowR)

                      aUser <- for wpUser $ \wpUser' -> lift . maybeT (return JsonWorkflowUserHidden) $ do
                        viewActors <- hoistMaybe $ preview _wgeViewActor =<< mVia
                        guardM $ anyM (otoList viewActors) hasWorkflowRole'
                        resUser <- lift . lift $ traverse getEntity wpUser'
                        return $ maybe JsonWorkflowUserAnonymous toJsonUser resUser
                      
                      payload <- do
                        payload' <- fmap Map.fromList . forMaybeM (Map.toList currentPayload) $ \x@(payloadLbl, _) -> x <$ do
                          WorkflowPayloadView{..} <- hoistMaybe . Map.lookup payloadLbl $ Map.findWithDefault Map.empty wpTo (wgnPayloadView <$> wgNodes)
                          guardM . $cachedHereBinary payloadLbl . anyM (otoList wpvViewers) $ lift . hasWorkflowRole'
                        forM payload' $ \(otoList -> payloads) -> fmap (uncurry JsonWorkflowPayload . over _2 getAny) . execWriterT @_ @(_, Any) . forM_ payloads $ \case
                          WorkflowFieldPayloadW (WFPText   t  ) -> tell . (, mempty) . pure $ WorkflowFieldPayloadW (WFPText t)
                          WorkflowFieldPayloadW (WFPNumber n  ) -> tell . (, mempty) . pure $ WorkflowFieldPayloadW (WFPNumber n)
                          WorkflowFieldPayloadW (WFPBool   b  ) -> tell . (, mempty) . pure $ WorkflowFieldPayloadW (WFPBool b)
                          WorkflowFieldPayloadW (WFPDay    d  ) -> tell . (, mempty) . pure $ WorkflowFieldPayloadW (WFPDay d)
                          WorkflowFieldPayloadW (WFPTime   t  ) -> tell . (, mempty) . pure $ WorkflowFieldPayloadW (WFPTime t)
                          WorkflowFieldPayloadW (WFPDateTime t) -> tell . (, mempty) . pure $ WorkflowFieldPayloadW (WFPDateTime t)
                          WorkflowFieldPayloadW (WFPFile   _  ) -> tell (mempty, Any True)
                          WorkflowFieldPayloadW (WFPUser   uid) -> tell . (, mempty) . pure . review (_WorkflowFieldPayloadW . _WorkflowFieldPayload) . toJsonUser =<< lift (lift . lift $ getEntity uid)

                      nTo <- runMaybeT $ do
                        WGN{..} <- hoistMaybe $ Map.lookup wpTo wgNodes
                        WorkflowNodeView{..} <- hoistMaybe wgnViewers
                        guardM . lift $ anyM (otoList wnvViewers) hasWorkflowRole'
                        return wpTo

                      tell . Just $ Last (stCID, nTo, aUser, wpTime, payload)

                    wState = review _DBWorkflowState workflowWorkflowState
                 in runConduit $ sourceWorkflowActionInfos wwId wState .| execWriterC (C.mapM_ go)

              let jwwLastAction = wState <&> \(jwaIx, jwaTo, jwaUser, jwaTime, _) -> JsonWorkflowAction{..}
                  jwwPayload = wState ^. _Just . _5
  
              return JsonWorkflowWorkflow{..}
      workflowWorkflowDBTableValidator = def
        & defaultSorting defSort
        & forceFilter "may-access" (Any True)
      defSort | wwListColumnInstance = SortAscBy "instance" : defSort'
              | otherwise = defSort'
        where defSort' = [SortAscBy "final", SortAscBy "current-state", SortDescBy "last-action-time"]
     in dbTableDB' workflowWorkflowDBTableValidator workflowWorkflowDBTable

  siteLayoutMsg heading $ do
    setTitleI title
    $(widgetFile "workflows/workflow-list")

deriveJSON defaultOptions
  { fieldLabelModifier = camelToPathPiece' 1
  } ''JsonWorkflowWorkflow
  
deriveJSON defaultOptions
  { fieldLabelModifier = camelToPathPiece' 1
  } ''JsonWorkflowAction

deriveJSON defaultOptions
  { fieldLabelModifier = camelToPathPiece' 1
  } ''JsonWorkflowInstance

deriveJSON defaultOptions
  { fieldLabelModifier = camelToPathPiece' 1
  } ''JsonWorkflowPayload
  
deriveJSON defaultOptions
  { constructorTagModifier = camelToPathPiece' 3
  , fieldLabelModifier = camelToPathPiece' 1
  } ''JsonWorkflowUser
