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

fix(lms): sorting and filtering lms status

Browse Source
This commit is contained in:
Steffen Jost 2023-09-26 16:15:58 +00:00
parent 095fde54b7
commit f48862efbc
4 changed files with 24 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
src/Database/Esqueleto/Utils.hs
View File

@ -20,7 +20,7 @@ module Database.Esqueleto.Utils
, subSelectAnd, subSelectOr
, mkExactFilter, mkExactFilterWith
, mkExactFilterLast, mkExactFilterLastWith
, mkExactFilterMaybeLast
, mkExactFilterMaybeLast, mkExactFilterMaybeLast'
, mkContainsFilter, mkContainsFilterWith
, mkContainsFilterWithSet, mkContainsFilterWithComma, mkContainsFilterWithCommaPlus
, mkDayFilter, mkDayFilterFrom, mkDayFilterTo
@ -313,6 +313,17 @@ mkExactFilterMaybeLast lenslike row criterias
| Last (Just crit) <- criterias = lenslike row E.==. E.val crit
| otherwise = true
-- | like `mkExactFilterMaybeLast` but for doubly wrapped Maybes
mkExactFilterMaybeLast' :: PersistField a
=> (t -> E.SqlExpr (E.Value (Maybe (Maybe a)))) -- ^ getter from query to searched element
-> t -- ^ query row
-> Last (Maybe a) -- ^ needle
-> E.SqlExpr (E.Value Bool)
mkExactFilterMaybeLast' lenslike row criterias
| Last (Just Nothing) <- criterias = lenslike row E.==. E.val (Just Nothing)
| Last (Just crit) <- criterias = lenslike row E.==. E.val (Just crit)
| otherwise = true
-- | generic filter creation for dbTable
-- Given a lens-like function, make filter searching for needles in String-like elements
-- (Keep Set here to ensure that there are no duplicates)

6
src/Handler/LMS.hs
View File

@ -465,7 +465,11 @@ mkLmsTable isAdmin (Entity qid quali) acts cols psValidator = do
, single ("schedule-renew", SortColumnNullsInv $ queryQualUser >>> (E.^. QualificationUserScheduleRenewal))
, single ("ident" , SortColumnNullsInv $ queryLmsUser >>> (E.^. LmsUserIdent))
, single ("pin" , SortColumnNullsInv $ queryLmsUser >>> (E.^. LmsUserPin))
, single ("status" , SortColumnNullsInv $ views (to queryLmsUser) (E.^. LmsUserStatus))
-- , single ("status" , SortColumnNullsInv $ views (to queryLmsUser) (E.^. LmsUserStatusDay))
, single ("status" , SortColumnNeverNull $ \row -> E.coalesceDefault [ queryLmsUser row E.^. LmsUserStatusDay
, queryLmsUser row E.^. LmsUserNotified
](queryLmsUser row E.?. LmsUserStarted))
, single ("started" , SortColumnNullsInv $ queryLmsUser >>> (E.^. LmsUserStarted))
, single ("datepin" , SortColumnNullsInv $ queryLmsUser >>> (E.^. LmsUserDatePin))
, single ("received" , SortColumnNullsInv $ queryLmsUser >>> (E.^. LmsUserReceived))

9
src/Handler/Qualification.hs
View File

@ -391,9 +391,10 @@ mkQualificationTable isAdmin (Entity qid quali) acts cols psValidator = do
, single ("last-notified" , SortColumn $ queryQualUser >>> (E.^. QualificationUserLastNotified))
, single ("valid-until" , SortColumn $ queryQualUser >>> (E.^. QualificationUserValidUntil))
, single ("blocked" , SortColumnNeverNull $ queryQualBlock >>> (E.?. QualificationUserBlockFrom))
, single ("lms-status-plus",SortColumnNeverNull $ \row -> E.coalesce [E.explicitUnsafeCoerceSqlExprValue "timestamp" $ (queryLmsUser row E.?. LmsUserStatus) E.#>>. "{day}"
, queryLmsUser row E.?. LmsUserStarted])
, single ("schedule-renew", SortColumnNullsInv $ queryQualUser >>> (E.^. QualificationUserScheduleRenewal))
, single ("lms-status-plus",SortColumnNeverNull $ \row -> E.coalesce [ E.joinV (queryLmsUser row E.?. LmsUserStatusDay)
, E.joinV (queryLmsUser row E.?. LmsUserNotified)
, queryLmsUser row E.?. LmsUserStarted])
, single ("schedule-renew", SortColumnNullsInv $ queryQualUser >>> (E.^. QualificationUserScheduleRenewal))
, single ("user-company" , SortColumn $ \row -> E.subSelect $ E.from $ \(usrComp `E.InnerJoin` comp) -> do
E.on $ usrComp E.^. UserCompanyCompany E.==. comp E.^. CompanyId
E.where_ $ usrComp E.^. UserCompanyUser E.==. queryUser row E.^. UserId
@ -440,6 +441,7 @@ mkQualificationTable isAdmin (Entity qid quali) acts cols psValidator = do
if | Just True <- getLast criterion -> quser `quserToNotify` now
| otherwise -> E.true
)
, single ("status" , FilterColumn . E.mkExactFilterMaybeLast' $ views (to queryLmsUser) (E.?. LmsUserStatus))
]
dbtFilterUI mPrev = mconcat
[ fltrUserNameEmailHdrUI MsgLmsUser mPrev
@ -451,6 +453,7 @@ mkQualificationTable isAdmin (Entity qid quali) acts cols psValidator = do
, if isNothing mbRenewal then mempty
else prismAForm (singletonFilter "renewal-due" . maybePrism _PathPiece) mPrev $ aopt checkBoxField (fslI MsgFilterLmsRenewal)
, prismAForm (singletonFilter "tobe-notified" . maybePrism _PathPiece) mPrev $ aopt checkBoxField (fslI MsgFilterLmsNotificationDue)
, prismAForm (singletonFilter "status" . maybePrism _PathPiece) mPrev $ aopt (hoistField liftHandler (selectField optionsFinite) :: (Field _ (Maybe LmsStatus))) (fslI MsgTableLmsStatus)
]
dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout }
dbtCsvEncode = Just DBTCsvEncode

2
src/Jobs/Handler/LMS.hs
View File

@ -208,7 +208,7 @@ dispatchJobLmsDequeue qid = JobHandlerAtomic act
when (quali ^. _qualificationExpiryNotification) $ do
notifyInvalidDrivers <- E.select $ do
quser <- E.from $ E.table @QualificationUser
E.where_ $ E.not_ (quser `qualificationValid` now) -- currently invalid
E.where_ $ E.not_ (validQualification now quser) -- currently invalid
E.&&. quser E.^. QualificationUserQualification E.==. E.val qid -- correct qualification
E.&&. quser `quserToNotify` now -- recently became invalid or blocked
pure (quser E.^. QualificationUserUser)