feat(dbtable): extra representations

2021-01-21 13:22:22 +01:00 · 2021-01-21 13:22:22 +01:00 · 2c0fc63be1
commit 2c0fc63be1
parent 9a3f401b38
36 changed files with 362 additions and 54 deletions
--- a/src/Handler/Admin/StudyFeatures.hs
+++ b/src/Handler/Admin/StudyFeatures.hs
@ -346,6 +346,7 @@ postAdminFeaturesR = do
                        & defaultSorting [SortAscBy "key"]
          dbtCsvEncode  = noCsvEncode
          dbtCsvDecode  = Nothing
+          dbtExtraReps = []
      in dbTable psValidator DBTable{..}

    mkStudytermsTable :: Set StudyTermsId -> Set StudyTermsId -> Set (Entity School) -> DB (FormResult (DBFormResult StudyTermsId (Maybe Text, Maybe Text, Set SchoolId, Set StudyTermsId, Maybe StudyDegreeId, Maybe StudyFieldType) (DBRow (Entity StudyTerms, Set (Entity StudyTerms), Set SchoolId))), Widget)
@ -401,6 +402,8 @@ postAdminFeaturesR = do
                        & defaultSorting [SortAscBy "isnew", SortAscBy "isbad", SortAscBy "key"]
          dbtCsvEncode  = noCsvEncode
          dbtCsvDecode  = Nothing
+  
+          dbtExtraReps = []

          queryField = id
          _dbrKey' :: Getter (DBRow (Entity StudyTerms, _, _)) StudyTermsId
@ -438,6 +441,7 @@ postAdminFeaturesR = do
          psValidator   = def & defaultSorting [SortAscBy "incidence", SortAscBy "key", SortAscBy "name"]
          dbtCsvEncode  = noCsvEncode
          dbtCsvDecode  = Nothing
+          dbtExtraReps = []
      in dbTable psValidator DBTable{..}

    mkParentCandidateTable =
@ -477,6 +481,8 @@ postAdminFeaturesR = do
                        & defaultSorting [SortAscBy "child", SortAscBy "incidence", SortAscBy "parent"]
          dbtCsvEncode  = noCsvEncode
          dbtCsvDecode  = Nothing
+  
+          dbtExtraReps = []

          queryCandidate (c `E.LeftOuterJoin` _ `E.LeftOuterJoin` _) = c
          queryParent (_ `E.LeftOuterJoin` p `E.LeftOuterJoin` _) = p
@ -517,6 +523,8 @@ postAdminFeaturesR = do
                        & defaultSorting [SortAscBy "key", SortAscBy "incidence"]
          dbtCsvEncode  = noCsvEncode
          dbtCsvDecode  = Nothing
+  
+          dbtExtraReps = []

          queryCandidate (c `E.LeftOuterJoin` _) = c
          queryTerm (_ `E.LeftOuterJoin` t) = t
--- a/src/Handler/Allocation/List.hs
+++ b/src/Handler/Allocation/List.hs
@ -128,6 +128,8 @@ getAllocationListR = do
    dbtCsvEncode = noCsvEncode
    dbtCsvDecode = Nothing

+    dbtExtraReps = []
+
    dbtIdent = allocationListIdent

    psValidator :: PSValidator _ _
--- a/src/Handler/Allocation/Users.hs
+++ b/src/Handler/Allocation/Users.hs
@ -317,6 +317,7 @@ postAUsersR tid ssh ash = do
            , dbtCsvExampleData = Nothing
            }
          dbtCsvDecode = Nothing
+          dbtExtraReps = []
      allocationUsersDBTableValidator = def
        & defaultSorting [SortAscBy "priority", SortAscBy "user-matriculation"]
        & defaultPagesize (PagesizeLimit 500)
--- a/src/Handler/Course/Application/List.hs
+++ b/src/Handler/Course/Application/List.hs
@ -491,6 +491,8 @@ postCApplicationsR tid ssh csh = do
            where
              Entity _ User{..} = existing ^. singular (ix appId . resultUser)

+      dbtExtraReps = []
+
      dbtIdent = courseApplicationsIdent

      psValidator :: PSValidator _ _
--- a/src/Handler/Course/List.hs
+++ b/src/Handler/Course/List.hs
@ -197,6 +197,7 @@ makeCourseTable whereClause colChoices psValidator = do
    , dbtIdent = "courses" :: Text
    , dbtCsvEncode = noCsvEncode
    , dbtCsvDecode = Nothing
+    , dbtExtraReps = []
    }

 getCourseListR :: Handler Html
--- a/src/Handler/Course/Show.hs
+++ b/src/Handler/Course/Show.hs
@ -239,6 +239,7 @@ getCShowR tid ssh csh = do
        dbtIdent = "tutorials"
        dbtCsvEncode = noCsvEncode
        dbtCsvDecode = Nothing
+        dbtExtraReps = []

    tutorialDBTableValidator = def
      & defaultSorting [SortAscBy "type", SortAscBy "name"]
--- a/src/Handler/Course/User.hs
+++ b/src/Handler/Course/User.hs
@ -377,6 +377,7 @@ courseUserExamsSection (Entity cid Course{..}) (Entity uid _) = do
        dbtIdent = "course-user-exams"
        dbtCsvEncode = noCsvEncode
        dbtCsvDecode = Nothing
+        dbtExtraReps = []
    examDBTableValidator = def & defaultSorting [SortAscBy "registration-time"]
    postprocess :: FormResult (First ExamActionData, DBFormResult ExamId (Bool, _) _) -> FormResult (ExamActionData, Map ExamId _)
    postprocess inp = do
@ -499,6 +500,7 @@ courseUserTutorialsSection (Entity cid Course{..}) (Entity uid _) = do
        dbtIdent = "tutorials"
        dbtCsvEncode = noCsvEncode
        dbtCsvDecode = Nothing
+        dbtExtraReps = []
    tutorialDBTableValidator = def & defaultSorting [SortAscBy "type", SortAscBy "name"]
    postprocess :: FormResult (First TutorialActionData, DBFormResult TutorialParticipantId (Bool, _) _) -> FormResult (TutorialActionData, Map TutorialParticipantId _)
    postprocess inp = do
--- a/src/Handler/Course/Users.hs
+++ b/src/Handler/Course/Users.hs
@ -167,10 +167,10 @@ colUserSheets shns = cap (Sortable Nothing caption) $ foldMap userSheetCol shns


 data UserTableCsv = UserTableCsv
-  { csvUserName :: Text
+  { csvUserName :: UserDisplayName
  , csvUserSex :: Maybe Sex
-  , csvUserMatriculation :: Maybe Text
-  , csvUserEmail :: CI Email
+  , csvUserMatriculation :: Maybe UserMatriculation
+  , csvUserEmail :: UserEmail
  , csvUserStudyFeatures :: UserTableStudyFeatures
  , csvUserSubmissionGroup :: Maybe SubmissionGroupName
  , csvUserRegistration :: UTCTime
@ -482,6 +482,7 @@ makeCourseUserTable cid acts restrict colChoices psValidator csvColumns = do
              CourseUserNote{..} <- lift . lift $ getJust noteId
              return courseUserNoteNote
        dbtCsvDecode = Nothing
+        dbtExtraReps = withCsvExtraRep (UserCsvExportData True) dbtCsvEncode []
    over _1 postprocess <$> dbTable psValidator DBTable{..}
  where
    postprocess :: FormResult (First act', DBFormResult UserId Bool UserTableData) -> FormResult (act', Set UserId)
--- a/src/Handler/Exam/List.hs
+++ b/src/Handler/Exam/List.hs
@ -71,6 +71,7 @@ mkExamTable (Entity cid Course{..}) = do
        dbtIdent = "exams"
        dbtCsvEncode = noCsvEncode
        dbtCsvDecode = Nothing
+        dbtExtraReps = []

    examDBTableValidator = def
      & defaultSorting [SortAscBy "time"]
--- a/src/Handler/Exam/Users.hs
+++ b/src/Handler/Exam/Users.hs
@ -944,6 +944,8 @@ postEUsersR tid ssh csh examn = do
                  [occId] -> return occId
                  _other  -> throwM ExamUserCsvExceptionNoMatchingOccurrence

+      dbtExtraReps = []
+
      examUsersDBTableValidator = def & defaultSorting [SortAscBy "user-name"]
                                      & defaultPagesize PagesizeAll

--- a/src/Handler/ExamOffice/Exam.hs
+++ b/src/Handler/ExamOffice/Exam.hs
@ -406,6 +406,8 @@ postEGradesR tid ssh csh examn = do
            }
          dbtCsvDecode = Nothing

+          dbtExtraReps = []
+
      examUsersDBTableValidator = def & defaultSorting [SortAscBy "is-synced", SortAscBy "user-name"]
                                      & defaultPagesize PagesizeAll

--- a/src/Handler/ExamOffice/Exams.hs
+++ b/src/Handler/ExamOffice/Exams.hs
@ -249,6 +249,8 @@ getEOExamsR = do

          dbtCsvEncode = noCsvEncode
          dbtCsvDecode = Nothing
+                     
+          dbtExtraReps = []

      examsDBTableValidator = def
        & defaultSorting [SortAscBy "is-synced", SortAscBy "exam-time"]
--- a/src/Handler/ExternalExam/List.hs
+++ b/src/Handler/ExternalExam/List.hs
@ -70,6 +70,7 @@ getEExamListR = do
        dbtIdent = "external-exams"
        dbtCsvEncode = noCsvEncode
        dbtCsvDecode = Nothing
+        dbtExtraReps = []
    examDBTableValidator = def
      & defaultSorting [SortDescBy "term", SortAscBy "school", SortAscBy "course", SortAscBy "name"]
      & forceFilter "may-access" (Any True)
--- a/src/Handler/Material.hs
+++ b/src/Handler/Material.hs
@ -144,6 +144,7 @@ getMaterialListR tid ssh csh = do
      , dbtFilterUI  = mempty
      , dbtCsvEncode  = noCsvEncode
      , dbtCsvDecode  = Nothing
+      , dbtExtraReps = []
      }

  let headingLong  = prependCourseTitle tid ssh csh MsgMaterialListHeading
@ -248,6 +249,7 @@ getMShowR tid ssh csh mnm = do
        ]
      , dbtCsvEncode  = noCsvEncode
      , dbtCsvDecode  = Nothing
+      , dbtExtraReps = []
      }
    return (matEnt,fileTable',zipLink)
  -- File table has no filtering by access, because we assume that
--- a/src/Handler/News.hs
+++ b/src/Handler/News.hs
@ -199,6 +199,7 @@ newsUpcomingSheets uid = do
    , dbtIdent     = "upcoming-sheets" :: Text
    , dbtCsvEncode = noCsvEncode
    , dbtCsvDecode = Nothing
+    , dbtExtraReps = []
    }
  $(widgetFile "news/upcomingSheets")

@ -334,6 +335,7 @@ newsUpcomingExams uid = do
          dbtIdent = "exams"
          dbtCsvEncode = noCsvEncode
          dbtCsvDecode = Nothing
+          dbtExtraReps = []

      examDBTableValidator = def
        & defaultSorting [SortAscBy "time"]
--- a/src/Handler/Profile.hs
+++ b/src/Handler/Profile.hs
@ -533,6 +533,7 @@ mkOwnedCoursesTable =
      dbtParams = def
      dbtCsvEncode = noCsvEncode
      dbtCsvDecode = Nothing
+      dbtExtraReps = []
  in \uid -> let dbtSQLQuery = dbtSQLQuery' uid in (_1 %~ getAny) <$> dbTableWidget validator DBTable{..}


@ -585,6 +586,7 @@ mkEnrolledCoursesTable =
      , dbtParams = def
      , dbtCsvEncode = noCsvEncode
      , dbtCsvDecode = Nothing
+      , dbtExtraReps = []
      }


@ -665,6 +667,7 @@ mkSubmissionTable =
      dbtParams = def
      dbtCsvEncode = noCsvEncode
      dbtCsvDecode = Nothing
+      dbtExtraReps = []
  in \uid ->  let dbtSQLQuery = dbtSQLQuery' uid
                  dbtSorting  = dbtSorting'  uid
              in  dbTableWidget' validator DBTable{..}
@ -725,6 +728,7 @@ mkSubmissionGroupTable =
      dbtParams = def
      dbtCsvEncode = noCsvEncode
      dbtCsvDecode = Nothing
+      dbtExtraReps = []
  in \uid ->  let dbtSQLQuery = dbtSQLQuery' uid
              in  dbTableWidget' validator DBTable{..}

@ -800,6 +804,7 @@ mkCorrectionsTable =
      dbtParams = def
      dbtCsvEncode = noCsvEncode
      dbtCsvDecode = Nothing
+      dbtExtraReps = []
  in \uid ->  let dbtSQLQuery = dbtSQLQuery' uid
              in  dbTableWidget' validator DBTable{..}

--- a/src/Handler/School.hs
+++ b/src/Handler/School.hs
@ -43,6 +43,8 @@ getSchoolListR = do

    dbtCsvEncode = noCsvEncode
    dbtCsvDecode = Nothing
+  
+    dbtExtraReps = []

    dbtIdent :: Text
    dbtIdent = "schools"
--- a/src/Handler/Sheet/List.hs
+++ b/src/Handler/Sheet/List.hs
@ -174,6 +174,7 @@ getSheetListR tid ssh csh = do
      , dbtIdent     = "sheets" :: Text
      , dbtCsvEncode = noCsvEncode
      , dbtCsvDecode = Nothing
+      , dbtExtraReps = []
      }
    -- ) ( -- !!!DEPRECTAED!!! Summary only over shown rows !!!
    --   -- Collect summary over all Sheets, not just the ones shown due to pagination:
--- a/src/Handler/Sheet/Show.hs
+++ b/src/Handler/Sheet/Show.hs
@ -97,6 +97,7 @@ getSShowR tid ssh csh shn = do
    , dbtParams = def
    , dbtCsvEncode = noCsvEncode
    , dbtCsvDecode = Nothing
+    , dbtExtraReps = []
    }
  (hasHints, hasSolution) <- runDB $ do
    hasHints <- E.selectExists . E.from $ \sheet' ->
--- a/src/Handler/Submission/Helper.hs
+++ b/src/Handler/Submission/Helper.hs
@ -536,6 +536,7 @@ submissionHelper tid ssh csh shn mcid = do
        , dbtParams = def
        , dbtCsvEncode = noCsvEncode
        , dbtCsvDecode = Nothing
+        , dbtExtraReps = []
        }
  mFileTable <- traverse (runDB . dbTableWidget' def) . fmap smid2ArchiveTable $ (,) <$> msmid <*> mcid

--- a/src/Handler/Submission/List.hs
+++ b/src/Handler/Submission/List.hs
@ -409,6 +409,7 @@ makeCorrectionsTable whereClause dbtColonnade dbtFilterUI psValidator dbtParams
    , dbtIdent     = "corrections" :: Text
    , dbtCsvEncode = noCsvEncode
    , dbtCsvDecode = Nothing
+    , dbtExtraReps = []
    }

 data ActionCorrections = CorrDownload
--- a/src/Handler/SystemMessage.hs
+++ b/src/Handler/SystemMessage.hs
@ -249,6 +249,7 @@ postMessageListR = do
    , dbtIdent = "messages" :: Text
    , dbtCsvEncode = noCsvEncode
    , dbtCsvDecode = Nothing
+    , dbtExtraReps = []
    }

  let tableRes = tableRes' <&> _2 %~ Map.keysSet . Map.filter id . getDBFormResult (const False)
--- a/src/Handler/Term.hs
+++ b/src/Handler/Term.hs
@ -154,6 +154,7 @@ getTermShowR = do
                dbtIdent = "terms" :: Text
                dbtCsvEncode = noCsvEncode
                dbtCsvDecode = Nothing
+                dbtExtraReps = []
        termDBTableValidator = def & defaultSorting [SortDescBy "term-id"]
    in dbTableWidget' termDBTableValidator termDBTable
  defaultLayout $ do
--- a/src/Handler/Tutorial/List.hs
+++ b/src/Handler/Tutorial/List.hs
@ -91,6 +91,7 @@ getCTutorialListR tid ssh csh = do
        dbtIdent = "tutorials"
        dbtCsvEncode = noCsvEncode
        dbtCsvDecode = Nothing
+        dbtExtraReps = []

    tutorialDBTableValidator = def
      & defaultSorting [SortAscBy "type", SortAscBy "name"]
--- a/src/Handler/Users.hs
+++ b/src/Handler/Users.hs
@ -215,6 +215,7 @@ postUsersR = do
      , dbtIdent     = "users" :: Text
      , dbtCsvEncode = noCsvEncode
      , dbtCsvDecode = Nothing
+      , dbtExtraReps = []
      }

  formResult usersRes $ \case
--- a/src/Handler/Utils/ExternalExam/Users.hs
+++ b/src/Handler/Utils/ExternalExam/Users.hs
@ -529,6 +529,7 @@ makeExternalExamUsersTable mode (Entity eeId ExternalExam{..}) = do
                , GuessUserFirstName <$> csvEUserFirstName
                ]
          maybe (throwM ExamUserCsvExceptionNoMatchingUser) return =<< guessUser criteria (Just 1)  -- we're only interested in at most one match
+    dbtExtraReps = []
    externalExamUsersDBTableValidator = def
      & defaultSorting (bool id (SortAscBy "is-synced" :) (mode == EEUMGrades) [SortAscBy "user-name"])
      & defaultPagesize PagesizeAll
--- a/src/Handler/Utils/Table/Pagination.hs
+++ b/src/Handler/Utils/Table/Pagination.hs
@ -13,9 +13,10 @@ module Handler.Utils.Table.Pagination
  , module Handler.Utils.Table.Pagination.CsvColumnExplanations
  , DBCsvActionMode(..)
  , DBCsvDiff(..), _DBCsvDiffNew, _DBCsvDiffExisting, _DBCsvDiffMissing, _dbCsvOldKey, _dbCsvOld, _dbCsvNewKey, _dbCsvNew
-  , DBTCsvEncode(..), DBTCsvDecode(..)
+  , DBTCsvEncode(..), DBTCsvDecode(..), DBTExtraRep(..)
  , DBTable(..), DBFilterUI, IsDBTable(..), DBCell(..)
  , noCsvEncode, simpleCsvEncode, simpleCsvEncodeM
+  , withCsvExtraRep
  , singletonFilter
  , DBParams(..)
  , cellAttrs, cellContents
@ -120,6 +121,8 @@ import qualified Data.Csv as Csv

 import Jobs.Queue

+import Data.Typeable (eqT)
+

 #if MIN_VERSION_base(4,11,0)
 type Monoid' = Monoid
@ -585,11 +588,17 @@ data DBTCsvEncode r' k' csv = forall exportData.
  ) => DBTCsvEncode
  { dbtCsvExportForm   :: AForm DB exportData
  , dbtCsvHeader       :: Maybe exportData -> DB Csv.Header -- ^ @exportData@ is @Nothing@, if we're reporting an error or exporting example data
-  , dbtCsvExampleData :: Maybe [csv]
+  , dbtCsvExampleData  :: Maybe [csv]
  , dbtCsvDoEncode     :: exportData -> ConduitT (k', r') csv DB ()
  , dbtCsvName         :: FilePath
  , dbtCsvNoExportData :: Maybe (AnIso' exportData ())
  }
+data DBTExtraRep r' k' = forall rep.
+  ( HasContentType rep
+  , DBTableKey k'
+  ) => DBTExtraRep
+  { dbtERepDoEncode :: ConduitT (k', r') Void DB rep
+  }
 data DBTCsvDecode r' k' csv = forall route csvAction csvActionClass csvException.
  ( FromNamedRecord csv, ToNamedRecord csv
  , DBTableKey k'
@ -628,6 +637,7 @@ data DBTable m x = forall a r r' h i t k k' csv colonnade (p :: Pillar).
  , dbtParams :: DBParams m x
  , dbtCsvEncode :: Maybe (DBTCsvEncode r' k' csv)
  , dbtCsvDecode :: Maybe (DBTCsvDecode r' k' csv)
+  , dbtExtraReps :: [DBTExtraRep r' k']
  , dbtIdent :: i
  }

@ -666,6 +676,19 @@ simpleCsvEncodeM fName f = Just DBTCsvEncode
  , dbtCsvExampleData  = Nothing
  }

+withCsvExtraRep :: forall exportData csv r' k'.
+                   Typeable exportData
+                => exportData
+                -> Maybe (DBTCsvEncode r' k' csv)
+                -> [DBTExtraRep r' k'] -> [DBTExtraRep r' k']
+withCsvExtraRep exportData mEncode = maybe id (flip snoc) csvExtraRep
+  where csvExtraRep = do
+          DBTCsvEncode{ dbtCsvNoExportData = (_ :: Maybe (AnIso' exportData' ())), .. } <- mEncode
+          Refl <- eqT @exportData @exportData'
+          return DBTExtraRep
+            { dbtERepDoEncode = toCsvRendered <$> lift (dbtCsvHeader $ Just exportData) <*> (dbtCsvDoEncode exportData .| C.foldMap (pure @[]))
+            }
+

 class (MonadHandler m, HandlerSite m ~ UniWorX, Monoid' x, Monoid' (DBCell m x), Default (DBParams m x)) => IsDBTable (m :: Type -> Type) (x :: Type) where
  data DBParams m x :: Type
@ -1262,6 +1285,28 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
          ]
    _other      -> return ()

+  let extraReps = maybe id (flip snoc) csvRep dbtExtraReps
+        where csvRep = do
+                DBTCsvEncode{..} <- dbtCsvEncode
+                noExportData' <- cloneIso <$> dbtCsvNoExportData
+                let exportData = noExportData' # ()
+                return DBTExtraRep
+                  { dbtERepDoEncode = toCsvRendered <$> lift (dbtCsvHeader $ Just exportData) <*> (dbtCsvDoEncode exportData .| C.foldMap (pure @[]))
+                  }
+      extraReps' = (typeHtml, Nothing) : map ((,) <$> (\DBTExtraRep{..} -> getContentType dbtERepDoEncode) <*> Just) extraReps
+      doAltRep = maybe True (== dbtIdent) <$> lookupGlobalGetParam GetSelectTable
+
+  maybeT (return ()) $ do
+    guardM doAltRep
+
+    cts <- reqAccept <$> getRequest
+    
+    altRep <- hoistMaybe <=< asum $ do
+      mRep <- hoistMaybe . selectRep' extraReps' =<< cts
+      return . return $ mRep <&> \DBTExtraRep{..} -> fmap toTypedContent . runConduit $ C.sourceList (zip currentKeys rows) .| dbtERepDoEncode
+
+    lift $ sendResponse =<< altRep
+
  let
    rowCount
      | selectPagesize = fromMaybe 0 $ rows' ^? _head . _1 . _Value
@ -1706,4 +1751,4 @@ cap' (view _Cornice -> cornice) = case cornice of
      | otherwise = (_Rowspan # (), "2") : filter (hasn't $ _1 . _Rowspan) attrs

 _Rowspan :: Prism' Text ()
-_Rowspan = prism' (\() -> "rowspan") $ flip guardOn () . ((==) `on` CI.mk) "rowspan"
+_Rowspan = nearly <$> id <*> ((==) `on` CI.mk) $ "rowspan"
--- a/src/Handler/Utils/Workflow/Workflow.hs
+++ b/src/Handler/Utils/Workflow/Workflow.hs
@ -2,6 +2,7 @@ module Handler.Utils.Workflow.Workflow
  ( ensureScope
  , followEdge
  , followAutomaticEdges, WorkflowAutomaticEdgeException(..)
+  , sourceWorkflowActionInfos
  , module Handler.Utils.Workflow.Restriction
  ) where

@ -14,6 +15,8 @@ import Handler.Utils.Workflow.Restriction
 import qualified Data.Set as Set
 import qualified Data.Map as Map

+import qualified Data.Conduit.Combinators as C
+

 ensureScope :: IdWorkflowScope -> CryptoFileNameWorkflowWorkflow -> MaybeT DB WorkflowWorkflowId
 ensureScope wiScope cID = do
@ -75,3 +78,22 @@ followAutomaticEdges WorkflowGraph{..} = go []
          return (edgeLbl, nodeLbl)
        filledPayloads = Map.keysSet . Map.filter (not . Set.null) $ workflowStateCurrentPayloads history
        edgeDecisionInput = (cState, filledPayloads)
+
+
+sourceWorkflowActionInfos
+  :: forall backend m.
+     ( MonadHandler m, HandlerSite m ~ UniWorX
+     , BackendCompatible SqlReadBackend backend
+     , MonadCrypto m, MonadCryptoKey m ~ CryptoIDKey
+     , MonadCatch m
+     )
+  => WorkflowWorkflowId
+  -> WorkflowState FileReference UserId
+  -> ConduitT () (WorkflowActionInfo FileReference UserId) (ReaderT backend m) ()
+-- ^ Does `mayViewWorkflowAction`
+sourceWorkflowActionInfos wwId wState = do
+  mAuthId <- maybeAuthId
+  let authCheck WorkflowActionInfo{..}
+        = mayViewWorkflowAction mAuthId wwId waiAction
+  yieldMany (workflowActionInfos wState) .| C.filterM authCheck
+    
--- a/src/Handler/Workflow/Definition/List.hs
+++ b/src/Handler/Workflow/Definition/List.hs
@ -131,6 +131,7 @@ getAdminWorkflowDefinitionListR = do
          dbtIdent = "workflow-definitions"
          dbtCsvEncode = noCsvEncode
          dbtCsvDecode = Nothing
+          dbtExtraReps = []
      workflowDefinitionsDBTableValidator = def
        & defaultPagesize PagesizeAll
        & defaultSorting [SortAscBy "scope", SortAscBy "name"]
--- a/src/Handler/Workflow/Instance/List.hs
+++ b/src/Handler/Workflow/Instance/List.hs
@ -118,6 +118,7 @@ getAdminWorkflowInstanceListR = do
            dbtIdent = "workflow-instances"
            dbtCsvEncode = noCsvEncode
            dbtCsvDecode = Nothing
+            dbtExtraReps = []
        workflowInstancesDBTableValidator = def
          & defaultSorting [SortAscBy "scope", SortAscBy "name"]
     in dbTableDB' workflowInstancesDBTableValidator workflowInstancesDBTable
--- a/src/Handler/Workflow/Workflow/List.hs
+++ b/src/Handler/Workflow/Workflow/List.hs
@ -11,9 +11,10 @@ module Handler.Workflow.Workflow.List
  , getTopWorkflowWorkflowListR
  ) where

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

 import Utils.Workflow
+import Handler.Utils.Workflow.Workflow
 import Handler.Utils.Workflow.CanonicalRoute

 import Handler.Workflow.Workflow.Workflow (WorkflowHistoryItemActor'(..), WorkflowHistoryItemActor)
@ -28,6 +29,13 @@ 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)
+

 getGlobalWorkflowWorkflowListR :: Handler Html
 getGlobalWorkflowWorkflowListR = workflowWorkflowListR WSGlobal
@ -115,14 +123,49 @@ type WorkflowWorkflowActionData = ( Maybe Text
                                  , 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
+resultWorkflowWorkflow :: Lens' WorkflowWorkflowData (Entity WorkflowWorkflow)
+resultWorkflowWorkflow = _dbrOutput . _3

 resultWorkflowInstance :: Lens' WorkflowWorkflowData (Maybe (Entity WorkflowInstance))
 resultWorkflowInstance = _dbrOutput . _4
@ -288,7 +331,7 @@ workflowWorkflowList (title, heading) WWListColumns{..} sqlPred = do
            , 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 :: Last Bool) -> case getLast criterion of
+            , 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
@ -306,6 +349,78 @@ workflowWorkflowList (title, heading) WWListColumns{..} sqlPred = do
          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{..}
+              (fmap getLast -> wState) <-
+                let go :: forall m.
+                          ( MonadHandler m
+                          , HandlerSite m ~ UniWorX
+                          , MonadCatch 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 (return ()) $ 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 $ case resUser of
+                          Just mEnt -> toJsonUser mEnt
+                          Nothing   -> JsonWorkflowUserAnonymous
+                      
+                      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 (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)
+
+                    Entity _ WorkflowWorkflow{..} = res ^. resultWorkflowWorkflow
+                    wState = review _DBWorkflowState workflowWorkflowState
+                    WorkflowGraph{..} = _DBWorkflowGraph # workflowWorkflowGraph
+                 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)
@ -317,3 +432,24 @@ workflowWorkflowList (title, heading) WWListColumns{..} sqlPred = do
  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
--- a/src/Handler/Workflow/Workflow/Workflow.hs
+++ b/src/Handler/Workflow/Workflow/Workflow.hs
@ -22,7 +22,7 @@ import qualified Data.Set as Set
 import qualified Data.Sequence as Seq

 import qualified Control.Monad.State.Class as State
-import Control.Monad.Trans.RWS.Strict (RWST, execRWST)
+import Control.Monad.Trans.RWS.Strict (RWST)

 import qualified Crypto.Saltine.Class as Saltine
 import qualified Data.Binary as Binary
@ -36,7 +36,7 @@ import qualified Data.Scientific as Scientific
 import Text.Blaze (toMarkup)
 import Data.Void (absurd)

-import Data.List (inits)
+import qualified Data.Conduit.Combinators as C


 data WorkflowHistoryItemActor' user = WHIASelf | WHIAOther (Maybe user) | WHIAHidden | WHIAGone
@ -108,14 +108,10 @@ workflowR rScope cID = do
                , HandlerSite m ~ UniWorX
                , MonadCatch m
                )
-             => WorkflowStateIndex
-             -> Maybe WorkflowGraphNodeLabel
-             -> [WorkflowAction FileReference UserId]
-             -> WorkflowAction FileReference UserId
+             => WorkflowActionInfo FileReference UserId
             -> RWST () (Maybe (Last WorkflowCurrentState), [WorkflowHistoryItem]) (Map WorkflowPayloadLabel (Set (WorkflowFieldPayloadW FileReference UserId))) (SqlPersistT m) ()
-          go stIx wpFrom history@(workflowStateCurrentPayloads -> currentPayload) act@WorkflowAction{..} = maybeT (return ()) $ do
+          go WorkflowActionInfo{ waiIx = stIx, waiFrom = wpFrom, waiHistory = history@(workflowStateCurrentPayloads -> currentPayload), waiAction = WorkflowAction{..} } = maybeT (return ()) $ do
            mAuthId <- maybeAuthId
-            guardM . lift . lift . hoist liftHandler $ mayViewWorkflowAction mAuthId wwId act
            
            stCID <- encryptWorkflowStateIndex wwId stIx
            let nodeView nodeLbl = do
@ -160,32 +156,18 @@ workflowR rScope cID = do
                    payloadSort :: WorkflowFieldPayloadW Void (Maybe (Entity User))
                                -> WorkflowFieldPayloadW Void (Maybe (Entity User))
                                -> Ordering
-                    payloadSort (WorkflowFieldPayloadW a) (WorkflowFieldPayloadW b) = case (a, b) of
-                      (WFPFile a',   _           ) -> absurd a'
-                      (_,            WFPFile a'  ) -> absurd a'
-                      (WFPText a',   WFPText b'  ) -> compareUnicode a' b'
-                      (WFPText{},    _           ) -> LT
-                      (WFPNumber a', WFPNumber b') -> compare a' b'
-                      (WFPNumber{},  WFPText{}   ) -> GT
-                      (WFPNumber{},  _           ) -> LT
-                      (WFPBool a',   WFPBool b'  ) -> compare a' b'
-                      (WFPBool{},    WFPText{}   ) -> GT
-                      (WFPBool{},    WFPNumber{} ) -> GT
-                      (WFPBool{},    _           ) -> LT
-                      (WFPDay a',    WFPDay b'   ) -> compare a' b'
-                      (WFPDay{},     WFPText{}   ) -> GT
-                      (WFPDay{},     WFPNumber{} ) -> GT
-                      (WFPDay{},     WFPBool{}   ) -> GT
-                      (WFPDay{},     _           ) -> LT
-                      (WFPUser a',   WFPUser b'  ) -> case (a', b') of
-                        (Nothing, _) -> GT
-                        (_, Nothing) -> LT
-                        (Just (Entity _ uA), Just (Entity _ uB))
-                          -> (compareUnicode `on` userSurname) uA uB
-                          <> (compareUnicode `on` userDisplayName) uA uB
-                          <> comparing userIdent uA uB
-                      (WFPUser{},    _           ) -> GT
-                  forM payload' $ \(lblText, (otoList -> payloads, fRoute)) -> fmap ((lblText, ) . over _1 (sortBy payloadSort)) . mapMOf _2 (traverse toTextUrl . bool Nothing (Just fRoute) . getAny) <=< execWriterT @_ @(_, Any). forM_ payloads $ \case
+                    payloadSort = workflowPayloadSort ordFiles ordUsers
+                      where
+                        ordFiles = absurd
+                        ordUsers a' b' = case (a', b') of
+                          (Nothing, _) -> GT
+                          (_, Nothing) -> LT
+                          (Just (Entity _ uA), Just (Entity _ uB))
+                            -> (compareUnicode `on` userSurname) uA uB
+                            <> (compareUnicode `on` userDisplayName) uA uB
+                            <> comparing userIdent uA uB
+                  
+                  forM payload' $ \(lblText, (otoList -> payloads, fRoute)) -> fmap ((lblText, ) . over _1 (sortBy payloadSort)) . mapMOf _2 (traverse toTextUrl . bool Nothing (Just fRoute) . 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)
@ -215,14 +197,8 @@ workflowR rScope cID = do
                 , pure WorkflowHistoryItem{..}
                 )
          WorkflowGraph{..} = wGraph
-          wState = otoList $ review _DBWorkflowState workflowWorkflowState
-       in fmap (over _2 (sortOn (Down . whiTime) . reverse) . view _2) . (\act -> execRWST act () Map.empty) $ sequence_
-            [ go stIx fromSt payload act
-            | fromSt <- Nothing : map (Just . wpTo) wState 
-            | act <- wState
-            | stIx <- [minBound..]
-            | payload <- tailEx $ inits wState
-            ]
+          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))

  sequenceOf_ (_Just . _1 . _1 . _Just) mEdge
--- a/src/Model/Types/Workflow.hs
+++ b/src/Model/Types/Workflow.hs
@ -22,8 +22,10 @@ module Model.Types.Workflow
  , WorkflowPayloadLabel(..)
  , WorkflowStateIndex(..), workflowStateIndex, workflowStateSection
  , WorkflowState
+  , WorkflowActionInfo(..), workflowActionInfos
  , WorkflowAction(..), _wpTo, _wpVia, _wpPayload, _wpUser, _wpTime
  , WorkflowFieldPayloadW(..), _WorkflowFieldPayloadW, IsWorkflowFieldPayload', IsWorkflowFieldPayload
+  , workflowPayloadSort
  , WorkflowFieldPayload(..), _WorkflowFieldPayload
  , workflowStatePayload, workflowStateCurrentPayloads
  , WorkflowChildren
@ -59,6 +61,10 @@ import Unsafe.Coerce

 import Utils.Lens.TH

+import Data.List (inits)
+
+import Data.RFC5051 (compareUnicode)
+

 -----  WORKFLOW GRAPH  -----

@ -364,6 +370,23 @@ data WorkflowAction fileid userid = WorkflowAction
  }
  deriving (Eq, Ord, Show, Generic, Typeable)

+data WorkflowActionInfo fileid userid = WorkflowActionInfo
+  { waiIx      :: WorkflowStateIndex
+  , waiFrom    :: Maybe WorkflowGraphNodeLabel
+  , waiHistory :: [WorkflowAction fileid userid]
+  , waiAction  :: WorkflowAction fileid userid
+  } deriving (Eq, Ord, Show, Generic, Typeable)
+
+workflowActionInfos :: WorkflowState fileid userid -> [WorkflowActionInfo fileid userid]
+workflowActionInfos wState
+  = [ WorkflowActionInfo{..}
+    | waiFrom <- Nothing : map (Just . wpTo) wState'
+    | waiAction <- wState'
+    | waiIx <- [minBound..]
+    | waiHistory <- tailEx $ inits wState'
+    ]
+  where wState' = otoList wState
+
 data WorkflowFieldPayloadW fileid userid = forall payload. IsWorkflowFieldPayload' fileid userid payload => WorkflowFieldPayloadW (WorkflowFieldPayload fileid userid payload)
  deriving (Typeable)

@ -395,6 +418,35 @@ instance (Ord fileid, Ord userid, Typeable fileid, Typeable userid) => Ord (Work
          (WFPFile{}, _) -> LT
          (WFPUser{}, _) -> GT

+workflowPayloadSort
+  :: forall fileid userid.
+     (fileid -> fileid -> Ordering)
+  -> (userid -> userid -> Ordering)
+  -> (WorkflowFieldPayloadW fileid userid -> WorkflowFieldPayloadW fileid userid -> Ordering)
+workflowPayloadSort ordFiles ordUsers (WorkflowFieldPayloadW a) (WorkflowFieldPayloadW b) = case (a, b) of
+  (WFPText a',   WFPText b'  ) -> compareUnicode a' b'
+  (WFPText{},    _           ) -> LT
+  (WFPNumber a', WFPNumber b') -> compare a' b'
+  (WFPNumber{},  WFPText{}   ) -> GT
+  (WFPNumber{},  _           ) -> LT
+  (WFPBool a',   WFPBool b'  ) -> compare a' b'
+  (WFPBool{},    WFPText{}   ) -> GT
+  (WFPBool{},    WFPNumber{} ) -> GT
+  (WFPBool{},    _           ) -> LT
+  (WFPDay a',    WFPDay b'   ) -> compare a' b'
+  (WFPDay{},     WFPText{}   ) -> GT
+  (WFPDay{},     WFPNumber{} ) -> GT
+  (WFPDay{},     WFPBool{}   ) -> GT
+  (WFPDay{},     _           ) -> LT
+  (WFPFile a',   WFPFile b'  ) -> ordFiles a' b'
+  (WFPFile{},    WFPText{}   ) -> GT
+  (WFPFile{},    WFPNumber{} ) -> GT
+  (WFPFile{},    WFPBool{}   ) -> GT
+  (WFPFile{},    WFPDay{}    ) -> GT
+  (WFPFile{},    _           ) -> LT
+  (WFPUser a',   WFPUser b'  ) -> ordUsers a' b'
+  (WFPUser{},    _           ) -> GT
+
 instance (Show fileid, Show userid) => Show (WorkflowFieldPayloadW fileid userid) where
  show (WorkflowFieldPayloadW payload) = show payload

--- a/src/Utils.hs
+++ b/src/Utils.hs
@ -17,6 +17,7 @@ import Data.CaseInsensitive (CI)
 import qualified Data.CaseInsensitive as CI

 import qualified Data.ByteString as BS
+import qualified Data.ByteString.Char8 as CBS
 import qualified Data.Text as Text
 import qualified Data.Text.Encoding as Text

@ -222,7 +223,22 @@ delimitInternalState act = bracket createInternalState closeInternalState $ \new
      = HandlerData { handlerResource = newInternalState
                    , ..
                    }
-  
+
+selectRep' :: [(ContentType, a)] -> ContentType -> Maybe a
+selectRep' cMap _ | null cMap = Nothing
+selectRep' cMap' needle = asum
+  [ guardOnM (needleMain == "*" && needleSub == "*") $ preview (folded . _2) cMap'
+  , guardOnM (needleSub == "*") $ preview (folded . filtered (views _1 $ views _1 (== needleMain) . contentTypeTypes) . _2) cMap'
+  , Map.lookup needle cMap
+  , Map.lookup (noSpaces needle) cMap
+  , Map.lookup (simpleContentType needle) cMap
+  ]
+  where
+    cMap = Map.fromListWith const $ over _1 <$> [id, noSpaces, simpleContentType] <*> cMap'
+
+    (needleMain, needleSub) = contentTypeTypes needle
+
+    noSpaces = CBS.filter (/= ' ')
  
 ---------------------
 -- Text and String --
--- a/src/Utils/Csv.hs
+++ b/src/Utils/Csv.hs
@ -14,11 +14,12 @@ import Settings.Mime

 import Data.Csv hiding (Name)
 import Data.Csv.Conduit (CsvParseError)
+import qualified Data.Csv.Incremental as Incremental

 import Language.Haskell.TH (Name)
 import Language.Haskell.TH.Lib

-import Yesod.Core.Content (ContentType, simpleContentType)
+import Yesod.Core.Content

 import qualified Data.Map as Map

@ -54,6 +55,17 @@ data CsvRendered = CsvRendered
  , csvRenderedData :: [NamedRecord]
  } deriving (Eq, Read, Show, Generic, Typeable)

+instance ToContent CsvRendered where
+  toContent CsvRendered{..} = toContent . Incremental.encodeByName csvRenderedHeader $ foldr ((<>) . Incremental.encodeNamedRecord) mempty csvRenderedData
+
+instance ToTypedContent CsvRendered where
+  toTypedContent = TypedContent
+    <$> getContentType . Identity
+    <*> toContent
+
+instance HasContentType CsvRendered where
+  getContentType _ = typeCsv'
+
 toCsvRendered :: forall mono.
                 ( ToNamedRecord (Element mono)
                 , MonoFoldable mono
--- a/src/Utils/Parameters.hs
+++ b/src/Utils/Parameters.hs
@ -31,6 +31,7 @@ data GlobalGetParam = GetLang
                    | GetDryRun
                    | GetDownload
                    | GetError
+                    | GetSelectTable
  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
  deriving anyclass (Universe, Finite)