chore(lms): properly show all print job acknowledgements on lms page
This commit is contained in:
Steffen Jost
parent
8a60cd8c02
commit
457f4dd6b1
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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|
|
||||
<h1>
|
||||
_{MsgPrintJobAcknowledgements} ^{userWidget recipient}
|
||||
<ul>
|
||||
$forall mbackdate <- ackDates
|
||||
<li>
|
||||
#{iconLetter} #
|
||||
$maybe ackdate <- mbackdate
|
||||
^{formatTimeW SelFormatDateTime ackdate}
|
||||
$nothing
|
||||
_{MsgPrintJobUnacknowledged}
|
||||
|]
|
||||
_ -> mempty
|
||||
in if notNotified
|
||||
then mempty
|
||||
else cIcon <> spacerCell <> cDate
|
||||
else cIcon <> spacerCell <> cDate <> cAckDates
|
||||
, sortable (Just "lms-notified-alternative") (i18nLms MsgTableLmsNotified) $ \(preview resultPrintAck -> d) -> textCell (show d)
|
||||
, sortable (Just "lms-ended") (i18nLms MsgTableLmsEnded) $ \(preview $ resultLmsUser . _entityVal . _lmsUserEnded -> d) -> foldMap dateTimeCell $ join d
|
||||
]
|
||||
|
||||
@ -56,6 +56,9 @@ nameWidget :: Text -- ^ userDisplayName
|
||||
-> Widget
|
||||
nameWidget displayName surname = toWidget $ nameHtml displayName surname
|
||||
|
||||
userWidget :: HasUser c => c -> Widget
|
||||
userWidget x = nameWidget (x ^. _userDisplayName) (x ^._userSurname)
|
||||
|
||||
-- | toWidget-Version of @nameEmailHtml@, for convenience
|
||||
nameEmailWidget :: UserEmail -- ^ userEmail
|
||||
-> Text -- ^ userDisplayName
|
||||
|
||||
@ -110,6 +110,7 @@ data Icon
|
||||
| IconReset
|
||||
| IconBlocked
|
||||
| IconPrintCenter
|
||||
| IconLetter
|
||||
| IconAt
|
||||
deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic, Typeable)
|
||||
deriving anyclass (Universe, Finite, NFData)
|
||||
@ -200,6 +201,7 @@ iconText = \case
|
||||
IconReset -> "undo" -- From fontawesome v6 onwards: "arrow-rotate-left"
|
||||
IconBlocked -> "ban"
|
||||
IconPrintCenter -> "mail-bulk" -- From fontawesome v6 onwards: "envelope-bulk"
|
||||
IconLetter -> "mail-bulk" -- Problem "envelope" already used for email as well
|
||||
IconAt -> "at"
|
||||
|
||||
nullaryPathPiece ''Icon $ camelToPathPiece' 1
|
||||
@ -300,7 +302,7 @@ iconExamRegister True = icon IconExamRegisterTrue
|
||||
iconExamRegister False = icon IconExamRegisterFalse
|
||||
|
||||
iconLetterOrEmail :: Bool -> Markup
|
||||
iconLetterOrEmail True = icon IconPrintCenter
|
||||
iconLetterOrEmail True = icon IconLetter
|
||||
iconLetterOrEmail False = icon IconAt
|
||||
|
||||
----------------
|
||||
|
||||
@ -15,7 +15,7 @@ de-closing: |
|
||||
Mit freundlichen Grüßen,
|
||||
Ihre Fahrerausbildung
|
||||
en-closing: |
|
||||
With kind reagards,
|
||||
With kind regards,
|
||||
Your Fraport Driver Training
|
||||
encludes:
|
||||
hyperrefoptions: hidelinks
|
||||
@ -80,7 +80,7 @@ $else$
|
||||
|
||||
<!-- englische Version des Briefes -->
|
||||
|
||||
your apron diving licence is about to expire soon, on $expiry$.
|
||||
your apron diving license is about to expire soon, on $expiry$.
|
||||
You can extend the validity
|
||||
$if(validduration)$
|
||||
by $validduration$ months
|
||||
@ -97,7 +97,7 @@ URL
|
||||
:[$url-text$]($url$)
|
||||
|
||||
|
||||
Should your apron driving licence expire before completing this
|
||||
Should your apron driving license expire before completing this
|
||||
e-learning course, then a renewal requires your full participation
|
||||
of the basic training course again.
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user