diff --git a/messages/uniworx/categories/print/de-de-formal.msg b/messages/uniworx/categories/print/de-de-formal.msg index ac5192a91..7a865802b 100644 --- a/messages/uniworx/categories/print/de-de-formal.msg +++ b/messages/uniworx/categories/print/de-de-formal.msg @@ -8,9 +8,11 @@ PrintJobFilename: Dateiname PrintJobId !ident-ok: Id PrintJobCreated: Gesendet PrintJobAcknowledged: Bestätigt +PrintJobUnacknowledged: Noch nicht gedruckt PrintJobAcknowledge n@Int64: #{n} #{pluralDE n "Druckauftrag" "Druckaufräge"} als gedruckt und versendet bestätigt PrintJobAcknowledgeFailed: Keine Druckaufträge bestätigt aufgrund zwischenzeitlicher Änderungen. Bitte die Seite im Browser aktualisieren! PrintJobAcknowledgeQuestion n@Int d@Text: #{n} #{pluralDE n "Druckauftrag" "Druckaufräge"} vom #{d} als gedruckt und versendet bestätigen? +PrintJobAcknowledgements: Versanddatum von Briefen an PrintRecipient: Empfänger PrintSender !ident-ok: Sender PrintCourse: Kurse diff --git a/messages/uniworx/categories/print/en-eu.msg b/messages/uniworx/categories/print/en-eu.msg index b611ff61b..a63eb1256 100644 --- a/messages/uniworx/categories/print/en-eu.msg +++ b/messages/uniworx/categories/print/en-eu.msg @@ -8,9 +8,11 @@ PrintJobFilename: Filename PrintJobId: Id PrintJobCreated: Created PrintJobAcknowledged: Acknowledged +PrintJobUnacknowledged: Not yet printed by print center PrintJobAcknowledge n: #{n} #{pluralENs n "print-job"} marked as printed and mailed PrintJobAcknowledgeFailed: No print-jobs acknowledged, due to intermediate changes. Please reload this page! PrintJobAcknowledgeQuestion n d: Mark #{n} #{pluralENs n "print-job"} issued on #{d} as printed and mailed already? +PrintJobAcknowledgements: Sent-dates for Letter to PrintRecipient: Recipient PrintSender: Sender PrintCourse: Course diff --git a/src/Handler/LMS.hs b/src/Handler/LMS.hs index 825223418..5eaf53078 100644 --- a/src/Handler/LMS.hs +++ b/src/Handler/LMS.hs @@ -252,23 +252,19 @@ instance CsvColumnsExplained LmsTableCsv where type LmsTableExpr = ( E.SqlExpr (Entity QualificationUser) `E.InnerJoin` E.SqlExpr (Entity User) - ) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity LmsUser)) - `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity PrintJob)) - + ) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity LmsUser)) queryQualUser :: LmsTableExpr -> E.SqlExpr (Entity QualificationUser) -queryQualUser = $(sqlIJproj 2 1) . $(sqlLOJproj 3 1) +queryQualUser = $(sqlIJproj 2 1) . $(sqlLOJproj 2 1) queryUser :: LmsTableExpr -> E.SqlExpr (Entity User) -queryUser = $(sqlIJproj 2 2) . $(sqlLOJproj 3 1) +queryUser = $(sqlIJproj 2 2) . $(sqlLOJproj 2 1) queryLmsUser :: LmsTableExpr -> E.SqlExpr (Maybe (Entity LmsUser)) -queryLmsUser = $(sqlLOJproj 3 2) +queryLmsUser = $(sqlLOJproj 2 2) -queryPrintJob :: LmsTableExpr -> E.SqlExpr (Maybe (Entity PrintJob)) -queryPrintJob = $(sqlLOJproj 3 3) -type LmsTableData = DBRow (Entity QualificationUser, Entity User, Maybe (Entity LmsUser), Maybe (Entity PrintJob), E.Value (Maybe [Maybe UTCTime])) +type LmsTableData = DBRow (Entity QualificationUser, Entity User, Maybe (Entity LmsUser), E.Value (Maybe [Maybe UTCTime])) resultQualUser :: Lens' LmsTableData (Entity QualificationUser) resultQualUser = _dbrOutput . _1 @@ -279,11 +275,8 @@ resultUser = _dbrOutput . _2 resultLmsUser :: Traversal' LmsTableData (Entity LmsUser) resultLmsUser = _dbrOutput . _3 . _Just -resultPrintJob :: Traversal' LmsTableData (Entity PrintJob) -resultPrintJob = _dbrOutput . _4 . _Just - resultPrintAck :: Traversal' LmsTableData [Maybe UTCTime] -resultPrintAck = _dbrOutput . _5 . _unValue . _Just +resultPrintAck = _dbrOutput . _4 . _unValue . _Just instance HasEntity LmsTableData User where hasEntity = resultUser @@ -319,20 +312,14 @@ isRenewPinAct LmsActRenewPinData = True lmsTableQuery :: QualificationId -> LmsTableExpr -> E.SqlQuery ( E.SqlExpr (Entity QualificationUser) , E.SqlExpr (Entity User) - , E.SqlExpr (Maybe (Entity LmsUser)) - , E.SqlExpr (Maybe (Entity PrintJob)) + , E.SqlExpr (Maybe (Entity LmsUser)) , E.SqlExpr (E.Value (Maybe [Maybe UTCTime])) ) -lmsTableQuery qid (qualUser `E.InnerJoin` user `E.LeftOuterJoin` lmsUser `E.LeftOuterJoin` printJob) = do - -- E.distinctOn [E.don $ printJob E.?. PrintJobLmsUser] $ do -- types, but destroys the ability to sort interactively, since distinctOn requires sorting; - -- instead we use notExits in printJob join condition; experiments with separate sub-query showed that we would need two subsqueries to learn wether the request was indeed the latest - E.on $ lmsUser E.?. LmsUserIdent E.=?. printJob E.?. PrintJobLmsUser - E.&&. -- is the latest created printJob for this LmsUser; note that notExists has in general a pretty good performance in postgresql - E.notExists (E.from $ \otherpj -> - E.where_ $ E.isJust (otherpj E.^. PrintJobLmsUser) - E.&&. ((lmsUser E.?. LmsUserIdent) E.==. (otherpj E.^. PrintJobLmsUser)) - E.&&. ((printJob E.?. PrintJobCreated) E.<. E.just (otherpj E.^. PrintJobCreated)) - ) +lmsTableQuery qid (qualUser `E.InnerJoin` user `E.LeftOuterJoin` lmsUser) = do + -- RECALL: another outer join on PrintJob did not work out well, since + -- - E.distinctOn [E.don $ printJob E.?. PrintJobLmsUser] $ do -- types, but destroys the ability to sort interactively, since distinctOn requires sorting; + -- - using noExsists on printJob join condition works, but only deliver single value; + -- experiments with separate sub-query showed that we would need two subsqueries to learn whether the request was indeed the latest E.on $ user E.^. UserId E.=?. lmsUser E.?. LmsUserUser E.&&. E.val qid E.=?. lmsUser E.?. LmsUserQualification -- NOTE: condition was once erroneously placed in where-clause E.on $ user E.^. UserId E.==. qualUser E.^. QualificationUserUser @@ -340,8 +327,8 @@ lmsTableQuery qid (qualUser `E.InnerJoin` user `E.LeftOuterJoin` lmsUser `E.Left let printAcknowledged = E.subSelectMaybe . E.from $ \pj -> do E.where_ $ E.isJust (pj E.^. PrintJobLmsUser) E.&&. ((lmsUser E.?. LmsUserIdent) E.==. (pj E.^. PrintJobLmsUser)) - pure $ E.arrayAggWith E.AggModeAll (pj E.^. PrintJobAcknowledged) [E.asc $ pj E.^. PrintJobCreated] - return (qualUser, user, lmsUser, printJob, printAcknowledged) + pure $ E.arrayAggWith E.AggModeAll (pj E.^. PrintJobAcknowledged) [E.desc $ pj E.^. PrintJobCreated] -- latest comes first! This is assumed to be the case later on! + return (qualUser, user, lmsUser, printAcknowledged) mkLmsTable :: forall h p cols act act'. @@ -381,9 +368,7 @@ mkLmsTable (Entity qid quali) acts restrict cols psValidator = do , single ("lms-started" , SortColumn $ queryLmsUser >>> (E.?. LmsUserStarted)) , single ("lms-datepin" , SortColumn $ queryLmsUser >>> (E.?. LmsUserDatePin)) , single ("lms-received", SortColumn $ queryLmsUser >>> (E.?. LmsUserReceived)) - --, single ("lms-notified", SortColumn $ queryLmsUser >>> (E.?. LmsUserNotified)) - , single ("lms-notified", SortColumn $ \row -> E.coalesce [queryPrintJob row E.?. PrintJobAcknowledged, queryLmsUser row E.?. LmsUserNotified]) -- prefer printJob acknowledgement date, if it exists - -- , single ("lms-notified", SortColumn $ \row -> E.greatest (queryPrintJob row E.?. PrintJobAcknowledged, queryLmsUser row E.?. LmsUserNotified)) -- bad idea, since resending increase notifyDate but just schedules yet another print job + , single ("lms-notified", SortColumn $ queryLmsUser >>> (E.?. LmsUserNotified)) -- cannot include printJob acknowledge date , single ("lms-ended" , SortColumn $ queryLmsUser >>> (E.?. LmsUserEnded)) ] dbtFilter = mconcat @@ -397,18 +382,7 @@ mkLmsTable (Entity qid quali) acts restrict cols psValidator = do E.&&. quser E.^. QualificationUserValidUntil E.>=. E.val nowaday | otherwise -> E.true ) - -- , single ("lms-notified", FilterColumn . E.mkExactFilterLast $ views (to queryLmsUser) (E.isJust . (E.?. LmsUserNotified))) - , single ("lms-notified", FilterColumn $ \row criterion -> - let luser = queryLmsUser row - pjob = queryPrintJob row - in - case getLast criterion of - Just True -> E.isJust (luser E.?. LmsUserNotified) - E.&&. (E.isNothing (pjob E.?. PrintJobId) E.||. E.isJust (pjob E.?. PrintJobAcknowledged)) - Just False -> E.isNothing (luser E.?. LmsUserNotified) - E.||. (E.isJust (pjob E.?. PrintJobId) E.&&. E.isNothing (pjob E.?. PrintJobAcknowledged)) - Nothing -> E.true - ) + , single ("lms-notified", FilterColumn . E.mkExactFilterLast $ views (to queryLmsUser) (E.isJust . (E.?. LmsUserNotified))) ] dbtFilterUI mPrev = mconcat [ fltrUserNameEmailHdrUI MsgLmsUser mPrev @@ -511,18 +485,33 @@ postLmsR sid qsh = do -- - Email sent : LmsUserNotified == Just _ && PrintJobId == Nothing -- - Letter printed : LmsUserNotified == Just _ && PrintJobId == Just _ -- - Letter sent : LmsUserNotified == Just _ && PrintJobId == Just _ && PrintJobAcknowledged == Just _ - let notifyDate = join $ row ^? resultLmsUser . _entityVal . _lmsUserNotified - letterDate = join $ row ^? resultPrintJob . _entityVal . _printJobAcknowledged - -- letterSent = isJust (row ^? resultPrintJob . _entityKey) && (isNothing letterDate || letterDate > notifyDate) -- bad idea, since a resending increase notifyDay but just reschedules a print job - letterSent = isJust (row ^? resultPrintJob . _entityKey) -- note the difference to letterDate! - notNotified = isNothing notifyDate - cIcon = iconFixedCell $ iconLetterOrEmail letterSent - cDate = if letterSent - then foldMap dateTimeCell letterDate - else foldMap dateTimeCell notifyDate + let notifyDate = join $ row ^? resultLmsUser . _entityVal . _lmsUserNotified + recipient = row ^. hasUser + letterDates = row ^? resultPrintAck + lastLetterDate = headDef Nothing =<< letterDates + letterSent = isJust letterDates && (isNothing lastLetterDate || lastLetterDate >= notifyDate) -- was a letter attempted to send last (not 100% safe, if an email is sent after an unacknowledged letter) + notNotified = isNothing notifyDate + cIcon = iconFixedCell $ iconLetterOrEmail letterSent + cDate = if | not letterSent -> foldMap dateTimeCell notifyDate + | Just d <- lastLetterDate -> dateTimeCell d + | otherwise -> i18nCell MsgPrintJobUnacknowledged + cAckDates = case letterDates of + Just ackDates@(_:_:_) -> spacerCell <> modalCell [whamlet| +

+ _{MsgPrintJobAcknowledgements} ^{userWidget recipient} +