From bb2c0858d1ee8d28d73757f20508a8f0b045533d Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Fri, 28 Apr 2023 12:58:20 +0000 Subject: [PATCH] docs(dbtable): clarify usage of dbtProj --- src/Handler/Admin.hs | 2 +- src/Handler/Admin/Avs.hs | 3 +-- src/Handler/LMS.hs | 2 +- src/Handler/LMS/Result.hs | 2 +- src/Handler/LMS/Userlist.hs | 2 +- src/Handler/LMS/Users.hs | 2 +- src/Handler/PrintCenter.hs | 2 +- src/Handler/Qualification.hs | 5 ++--- src/Handler/Utils/Table/Pagination.hs | 5 +++++ src/Model/Types/Csv.hs | 3 ++- 10 files changed, 16 insertions(+), 12 deletions(-) diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs index 59614fd5a..25c26d110 100644 --- a/src/Handler/Admin.hs +++ b/src/Handler/Admin.hs @@ -137,7 +137,7 @@ mkUnreachableUsersTable = do E.&&. E.not_ ((user E.^. UserEmail) `E.like` E.val "%@%.%") pure user dbtRowKey = (E.^. UserId) - dbtProj = dbtProjFilteredPostId -- TODO: still don't understand the choices here + dbtProj = dbtProjId dbtColonnade = -} diff --git a/src/Handler/Admin/Avs.hs b/src/Handler/Admin/Avs.hs index 88b490be6..4c0a76b7d 100644 --- a/src/Handler/Admin/Avs.hs +++ b/src/Handler/Admin/Avs.hs @@ -530,8 +530,7 @@ mkLicenceTable apidStatus dbtIdent aLic apids = do return (usrAvs, user, qualUser, qual) dbtRowKey = queryUserAvs >>> (E.^. UserAvsPersonId) -- ) &&& (queryQualification >>> (E.?. QualificationId)) -- WHY IS THIS AN ERROR? -- Not sure what changes here: - dbtProj = dbtProjId -- Simple $ \(userAvs, user, qualUsr, quali) -> return (userAvs, user, qualUsr, quali) - -- dbtProj = dbtProjFilteredPostId + dbtProj = dbtProjId -- Simple $ \(userAvs, user, qualUsr, quali) -> return (userAvs, user, qualUsr, quali) dbtColonnade = mconcat [ dbSelect (applying _2) id $ return . view (resultUserAvs . _userAvsPersonId) -- $ \DBRow{dbrOutput=(_,_,apid,_)} -> return apid -- return . view resultAvsPID -- does not type due to traversal diff --git a/src/Handler/LMS.hs b/src/Handler/LMS.hs index 58c87494f..ef8f77347 100644 --- a/src/Handler/LMS.hs +++ b/src/Handler/LMS.hs @@ -124,7 +124,7 @@ mkLmsAllTable isAdmin = do -- Failed attempt using Join/GroupBy instead of subselect: see branch csv-osis-demo-groupby-problem return (quali, cactive, cusers) dbtRowKey = (Ex.^. QualificationId) - dbtProj = dbtProjId -- TODO: or dbtProjSimple what is the difference? + dbtProj = dbtProjId adminable = if isAdmin then sortable else \_ _ _ -> mempty dbtColonnade = dbColonnade $ mconcat [ colSchool $ resultAllQualification . _qualificationSchool diff --git a/src/Handler/LMS/Result.hs b/src/Handler/LMS/Result.hs index c9bec0c04..6662d7574 100644 --- a/src/Handler/LMS/Result.hs +++ b/src/Handler/LMS/Result.hs @@ -96,7 +96,7 @@ mkResultTable sid qsh qid = do E.where_ $ lmsresult E.^. LmsResultQualification E.==. E.val qid return lmsresult dbtRowKey = (E.^. LmsResultId) - dbtProj = dbtProjFilteredPostId -- TODO: or dbtProjSimple what is the difference? + dbtProj = dbtProjId dbtColonnade = dbColonnade $ mconcat [ sortable (Just csvLmsIdent) (i18nCell MsgTableLmsIdent) $ \(view $ _dbrOutput . _entityVal . _lmsResultIdent . _getLmsIdent -> ident) -> textCell ident , sortable (Just csvLmsSuccess) (i18nCell MsgTableLmsSuccess) $ \(view $ _dbrOutput . _entityVal . _lmsResultSuccess -> success) -> dayCell success diff --git a/src/Handler/LMS/Userlist.hs b/src/Handler/LMS/Userlist.hs index a9ccbf942..407c7436e 100644 --- a/src/Handler/LMS/Userlist.hs +++ b/src/Handler/LMS/Userlist.hs @@ -94,7 +94,7 @@ mkUserlistTable sid qsh qid = do E.where_ $ lmslist E.^. LmsUserlistQualification E.==. E.val qid return lmslist dbtRowKey = (E.^. LmsUserlistId) - dbtProj = dbtProjFilteredPostId -- TODO: or dbtProjSimple what is the difference? + dbtProj = dbtProjId dbtColonnade = dbColonnade $ mconcat [ sortable (Just csvLmsIdent) (i18nCell MsgTableLmsIdent) $ \DBRow{ dbrOutput = Entity _ LmsUserlist{..} } -> textCell $ lmsUserlistIdent & getLmsIdent , sortable (Just csvLmsBlocked) (i18nCell MsgTableLmsFailed) $ \DBRow{ dbrOutput = Entity _ LmsUserlist{..} } -> ifIconCell lmsUserlistFailed IconBlocked diff --git a/src/Handler/LMS/Users.hs b/src/Handler/LMS/Users.hs index 9a0eb8e96..97ab76850 100644 --- a/src/Handler/LMS/Users.hs +++ b/src/Handler/LMS/Users.hs @@ -95,7 +95,7 @@ mkUserTable _sid qsh qid = do E.&&. E.isNothing (lmsuser E.^. LmsUserEnded) return lmsuser dbtRowKey = (E.^. LmsUserId) - dbtProj = dbtProjFilteredPostId -- TODO: or dbtProjSimple what is the difference? + dbtProj = dbtProjId dbtColonnade = dbColonnade $ mconcat [ sortable (Just csvLmsIdent) (i18nCell MsgTableLmsIdent) $ \(view $ _dbrOutput . _entityVal . _lmsUserIdent . _getLmsIdent -> ident) -> textCell ident , sortable (Just csvLmsPin) (i18nCell MsgTableLmsPin & cellAttrs <>~ [("uw-hide-column-default-hidden",mempty)] diff --git a/src/Handler/PrintCenter.hs b/src/Handler/PrintCenter.hs index cd3beeec1..4a1911e5a 100644 --- a/src/Handler/PrintCenter.hs +++ b/src/Handler/PrintCenter.hs @@ -161,7 +161,7 @@ mkPJTable = do let dbtSQLQuery = pjTableQuery dbtRowKey = queryPrintJob >>> (E.^. PrintJobId) - dbtProj = dbtProjFilteredPostId + dbtProj = dbtProjId dbtColonnade = mconcat [ dbSelectIf (applying _2) id (return . view (resultPrintJob . _entityKey)) (\r -> isNothing $ r ^. resultPrintJob . _entityVal . _printJobAcknowledged) , sortable (Just "created") (i18nCell MsgPrintJobCreated) $ \( view $ resultPrintJob . _entityVal . _printJobCreated -> t) -> dateTimeCell t diff --git a/src/Handler/Qualification.hs b/src/Handler/Qualification.hs index 9dc345872..141cc9357 100644 --- a/src/Handler/Qualification.hs +++ b/src/Handler/Qualification.hs @@ -3,7 +3,6 @@ -- SPDX-License-Identifier: AGPL-3.0-or-later {-# OPTIONS_GHC -fno-warn-orphans #-} -- needed for HasEntity instances -{-# OPTIONS -Wno-unused-top-binds #-} -- TODO: remove me, for debugging only {-# LANGUAGE TypeApplications #-} module Handler.Qualification @@ -46,7 +45,7 @@ getQualificationSchoolR :: SchoolId -> Handler Html getQualificationSchoolR ssh = redirect (QualificationAllR, [("qualification-overview-school", toPathPiece ssh)]) getQualificationAllR :: Handler Html -getQualificationAllR = do -- TODO just a stub +getQualificationAllR = do qualiTable <- runDB $ do view _2 <$> mkQualificationAllTable siteLayoutMsg MsgMenuQualifications $ do @@ -88,7 +87,7 @@ mkQualificationAllTable = do Ex.where_ $ filterSvs quser Ex.&&. validQualification (utctDay now) quser return (quali, cactive, cusers) dbtRowKey = (Ex.^. QualificationId) - dbtProj = dbtProjId -- TODO: or dbtProjSimple what is the difference? + dbtProj = dbtProjId dbtColonnade = dbColonnade $ mconcat [ colSchool $ resultAllQualification . _qualificationSchool , sortable (Just "qshort") (i18nCell MsgQualificationShort) $ \(view resultAllQualification -> quali) -> diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs index 076b1ac29..d3852d2eb 100644 --- a/src/Handler/Utils/Table/Pagination.hs +++ b/src/Handler/Utils/Table/Pagination.hs @@ -716,6 +716,7 @@ dbtProjId' :: forall fs r r'. => ReaderT (DBTProjCtx fs r) (MaybeT (ReaderT SqlBackend (HandlerFor UniWorX))) r' dbtProjId' = view _dbtProjRow +-- | Reicht das Ergebnis der SQL-Abfrage direkt durch an colonnade und csv dbtProjId :: forall fs r r'. ( fs ~ (), DBRow r ~ r' ) => ReaderT (DBTProjCtx fs r) (MaybeT (ReaderT SqlBackend (HandlerFor UniWorX))) r' @@ -727,6 +728,7 @@ dbtProjSimple' :: forall fs r r' r''. -> ReaderT (DBTProjCtx fs r) (MaybeT (ReaderT SqlBackend (HandlerFor UniWorX))) r' dbtProjSimple' cont = (views _dbtProjRow . set _dbrOutput) <=< (hoist lift . magnify (_dbtProjRow . _dbrOutput)) $ lift . cont =<< ask +-- | Transformation des SQL Ergbnistyp vor dem Weiterreichen an colonnade oder csv durch eine einfache monadische Funktion dbtProjSimple :: forall fs r r' r''. ( fs ~ (), DBRow r'' ~ r' ) => (r -> DB r'') @@ -743,11 +745,14 @@ withFilteredPost proj = do guardM . lift . lift $ p r' return r' +-- | Wie `dbtProjId` plus zusätzliches Filtern der SQL-Abfrage in Haskell +-- Nur zu Verwenden, wenn Filter mit mkFilterProjectedPost verwendet werden; ein Typfehler weist daraufhin, wenn dies nötig ist! dbtProjFilteredPostId :: forall fs r r'. ( fs ~ DBTProjFilterPost r', DBRow r ~ r' ) => ReaderT (DBTProjCtx fs r) (MaybeT (ReaderT SqlBackend (HandlerFor UniWorX))) r' dbtProjFilteredPostId = withFilteredPost dbtProjId' +-- | Kombination aus `dbtProjFilteredPostId` und `dbtProjSimple`, d.h. Ergeniszeilen in Haskell transformieren und filtern dbtProjFilteredPostSimple :: forall fs r r' r''. ( fs ~ DBTProjFilterPost r', DBRow r'' ~ r' ) => (r -> DB r'') diff --git a/src/Model/Types/Csv.hs b/src/Model/Types/Csv.hs index 62ac641e1..159339062 100644 --- a/src/Model/Types/Csv.hs +++ b/src/Model/Types/Csv.hs @@ -85,7 +85,8 @@ instance Default CsvOptions where } instance Default CsvFormatOptions where - def = csvPreset # CsvPresetRFC -- changing the default here to CsvPresetXlsx will cause internal server errors to to partial record selectors failing + def = csvPreset # CsvPresetRFC -- DO NOT CHANGE! + -- Changing the default to CsvPresetXlsx will cause internal server errors due to partial record selectors failing, like `csvIncludeHeader` data CsvPreset = CsvPresetRFC | CsvPresetXlsx