fraport/fradrive-old
Archived
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

chore(lms): fix lms filtering by composite notification date

Browse Source
This commit is contained in:
Steffen Jost 2022-09-28 16:02:42 +02:00
parent c71309aa47
commit 9b14a727c0
1 changed files with 29 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
src/Handler/LMS.hs
View File

@ -369,19 +369,24 @@ mkLmsTable (Entity qid quali) acts restrict cols psValidator = do
, single ("lms-ident" , FilterColumn . E.mkContainsFilterWith (Just . LmsIdent) $ views (to queryLmsUser) (E.?. LmsUserIdent)) , single ("lms-ident" , FilterColumn . E.mkContainsFilterWith (Just . LmsIdent) $ views (to queryLmsUser) (E.?. LmsUserIdent))
-- , single ("lms-status" , FilterColumn . E.mkExactFilterLast $ views (to queryLmsUser) ((E.>=. E.val nowaday) . (E.^. LmsUserStatus))) -- LmsStatus cannot be filtered easily within the DB -- , single ("lms-status" , FilterColumn . E.mkExactFilterLast $ views (to queryLmsUser) ((E.>=. E.val nowaday) . (E.^. LmsUserStatus))) -- LmsStatus cannot be filtered easily within the DB
, single ("validity" , FilterColumn . E.mkExactFilterLast $ views (to queryQualUser) ((E.>=. E.val nowaday) . (E.^. QualificationUserValidUntil))) , single ("validity" , FilterColumn . E.mkExactFilterLast $ views (to queryQualUser) ((E.>=. E.val nowaday) . (E.^. QualificationUserValidUntil)))
, single ("renewal-due" , FilterColumn $ \(view (to queryQualUser) -> quser) criterion -> , single ("renewal-due" , FilterColumn $ \(queryQualUser -> quser) criterion ->
if | Just renewal <- mbRenewal if | Just renewal <- mbRenewal
, Just True <- getLast criterion -> quser E.^. QualificationUserValidUntil E.<=. E.val renewal , Just True <- getLast criterion -> quser E.^. QualificationUserValidUntil E.<=. E.val renewal
E.&&. quser E.^. QualificationUserValidUntil E.>=. E.val nowaday E.&&. quser E.^. QualificationUserValidUntil E.>=. E.val nowaday
| otherwise -> E.true | otherwise -> E.true
) )
, single ("lms-notified", FilterColumn . E.mkExactFilterLast $ views (to queryLmsUser) (E.isJust . (E.?. LmsUserNotified))) -- , single ("lms-notified", FilterColumn . E.mkExactFilterLast $ views (to queryLmsUser) (E.isJust . (E.?. LmsUserNotified)))
--, single ("lms-notified", FilterColumn $ \(view (to queryLmsUser) -> luser) criterion -> , single ("lms-notified", FilterColumn $ \row criterion ->
-- case getLast criterion of let luser = queryLmsUser row
-- Just True -> E.isJust $ luser E.?. LmsUserNotified pjob = queryPrintJob row
-- Just False -> E.isNothing $ luser E.?. LmsUserNotified in
-- Nothing -> E.true 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
)
] ]
dbtFilterUI mPrev = mconcat dbtFilterUI mPrev = mconcat
[ fltrUserNameEmailHdrUI MsgLmsUser mPrev [ fltrUserNameEmailHdrUI MsgLmsUser mPrev
@ -478,14 +483,22 @@ postLmsR sid qsh = do
, sortable (Just "lms-received") (i18nLms MsgTableLmsReceived) $ \(preview $ resultLmsUser . _entityVal . _lmsUserReceived -> d) -> foldMap dateTimeCell $ join d , sortable (Just "lms-received") (i18nLms MsgTableLmsReceived) $ \(preview $ resultLmsUser . _entityVal . _lmsUserReceived -> d) -> foldMap dateTimeCell $ join d
--, sortable (Just "lms-notified") (i18nLms MsgTableLmsNotified) $ \(preview $ resultLmsUser . _entityVal . _lmsUserNotified -> d) -> foldMap dateTimeCell $ join d --, sortable (Just "lms-notified") (i18nLms MsgTableLmsNotified) $ \(preview $ resultLmsUser . _entityVal . _lmsUserNotified -> d) -> foldMap dateTimeCell $ join d
, sortable (Just "lms-notified") (i18nLms MsgTableLmsNotified) $ \row -> , sortable (Just "lms-notified") (i18nLms MsgTableLmsNotified) $ \row ->
let notifyDate = row ^? resultLmsUser . _entityVal . _lmsUserNotified -- 4 Cases:
letterSent = isJust (row ^? resultPrintJob . _entityKey) -- - No notification: LmsUserNotified == Nothing
letterDate = row ^? resultPrintJob . _entityVal . _printJobAcknowledged -- - Email sent : LmsUserNotified == Just _ && PrintJobId == Nothing
cIcon = iconFixedCell $ iconLetterOrEmail letterSent -- - Letter printed : LmsUserNotified == Just _ && PrintJobId == Just _
cDate = if letterSent -- - Letter sent : LmsUserNotified == Just _ && PrintJobId == Just _ && PrintJobAcknowledged == Just _
then foldMap dateTimeCell (join letterDate) let notifyDate = join $ row ^? resultLmsUser . _entityVal . _lmsUserNotified
else foldMap dateTimeCell (join notifyDate) letterDate = join $ row ^? resultPrintJob . _entityVal . _printJobAcknowledged
in cIcon <> spacerCell <> cDate 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
in if notNotified
then mempty
else cIcon <> spacerCell <> cDate
, sortable (Just "lms-ended") (i18nLms MsgTableLmsEnded) $ \(preview $ resultLmsUser . _entityVal . _lmsUserEnded -> d) -> foldMap dateTimeCell $ join d , sortable (Just "lms-ended") (i18nLms MsgTableLmsEnded) $ \(preview $ resultLmsUser . _entityVal . _lmsUserEnded -> d) -> foldMap dateTimeCell $ join d
] ]
where where