chore(lms): add longter,m validity filter, towards #2605
This commit is contained in:
parent
434549c945
commit
2a3a776b13
@ -83,6 +83,7 @@ LmsStatusExpired: Durchgefallen nach Fristablauf
|
||||
LmsStatusSuccess: E#{nonBreakableDash}Learning bestanden
|
||||
LmsStatusPlanned: E#{nonBreakableDash}Learning wird gerade noch eröffnet (nur für Admin sichtbar)
|
||||
LmsStatusDelay: Hinweis: Statusänderung können in seltenen Fällen mehrere Stunden bis zur Anzeige benötigen.
|
||||
FilterLmsLongValid: Längerfristig gültig
|
||||
FilterLmsValid: Aktuell gültig
|
||||
FilterLmsRenewal: Erneuerung anstehend
|
||||
FilterLmsNotified: Benachrichtigt
|
||||
|
||||
@ -83,6 +83,7 @@ LmsStatusExpired: Failed due to expiry
|
||||
LmsStatusSuccess: Passed
|
||||
LmsStatusPlanned: E#{nonBreakableDash}learning is about to be opened soon (visible to Admins only)
|
||||
LmsStatusDelay: Note that status changes may occassionaly require more than a hour to be displayed here.
|
||||
FilterLmsLongValid: Long-term valid
|
||||
FilterLmsValid: Currently valid
|
||||
FilterLmsRenewal: Renewal due
|
||||
FilterLmsNotified: Notified
|
||||
|
||||
@ -437,12 +437,13 @@ mkLmsTable :: ( Functor h, ToSortable h
|
||||
-> PSValidator (MForm Handler) (FormResult (First LmsTableActionData, DBFormResult UserId Bool LmsTableData))
|
||||
-> DB (FormResult (LmsTableActionData, Set UserId), Widget)
|
||||
mkLmsTable isAdmin (Entity qid quali) acts cols psValidator = do
|
||||
now <- liftIO getCurrentTime
|
||||
-- lookup all companies
|
||||
cmpMap <- memcachedBy (Just . Right $ 30 * diffMinute) ("CompanyDictionary"::Text) $ do
|
||||
cmps <- selectList [] [] -- [Asc CompanyShorthand]
|
||||
return $ Map.fromList $ fmap (\Entity{..} -> (entityKey, entityVal)) cmps
|
||||
now <- liftIO getCurrentTime
|
||||
let
|
||||
nowaday = utctDay now
|
||||
getCompanyName :: CompanyId -> CompanyName
|
||||
getCompanyName cid = maybe (unCompanyKey cid) companyName $ Map.lookup cid cmpMap -- use shorthand in case of impossible failure
|
||||
|
||||
@ -494,6 +495,16 @@ mkLmsTable isAdmin (Entity qid quali) acts cols psValidator = do
|
||||
-- E.&&. quser E.^. QualificationUserValidUntil E.>=. E.val nowaday
|
||||
-- | otherwise -> E.true
|
||||
-- )
|
||||
, ("long-valid",
|
||||
let cutoff = if
|
||||
| Just refWithin <- qualificationRefreshWithin quali -> computeNewValidDate' (refWithin <> calendarDay) nowaday -- longer valid than renewal
|
||||
| Just valDuration <- qualificationValidDuration quali -> computeNewValidDate (valDuration `div` 2) nowaday -- or longer valid than half the duration
|
||||
| otherwise -> computeNewValidDate' (calendarYear <> calendarDay) nowaday -- or a year and a day
|
||||
-- in FilterColumn . E.mkExactFilterLast $ views (to queryQualUser) ((E.>. E.val cutoff) . (E.^. QualificationUserValidUntil)) -- for use with boolField
|
||||
in FilterColumn $ \(queryQualUser -> quser) (getLast -> criterion) -> if -- for use with checkboxField
|
||||
| Just True <- criterion -> quser E.^. QualificationUserValidUntil E.>=. E.val cutoff
|
||||
| otherwise -> E.true
|
||||
)
|
||||
, ("notified", FilterColumn . E.mkExactFilterLast $ views (to queryLmsUser) (E.isJust . (E.^. LmsUserNotified)))
|
||||
, ("avs-number" , FilterColumn . E.mkExistsFilter $ \row criterion ->
|
||||
E.from $ \usrAvs -> -- do
|
||||
@ -521,10 +532,11 @@ mkLmsTable isAdmin (Entity qid quali) acts cols psValidator = do
|
||||
, prismAForm (singletonFilter "personal-number" ) mPrev $ aopt textField (fslI MsgCompanyPersonalNumberFraport)
|
||||
, fltrAVSCardNosUI mPrev
|
||||
, prismAForm (singletonFilter "avs-number" ) mPrev $ aopt textField (fslI MsgAvsPersonNo)
|
||||
, prismAForm (singletonFilter "ident" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgTableLmsIdent)
|
||||
, prismAForm (singletonFilter "validity" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterLmsValid)
|
||||
, prismAForm (singletonFilter "notified" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterLmsNotified)
|
||||
, prismAForm (singletonFilter "status" . maybePrism _PathPiece) mPrev $ aopt (hoistField liftHandler (selectField optionsFinite) :: (Field _ (Maybe LmsStatus))) (fslI MsgTableLmsStatus)
|
||||
, prismAForm (singletonFilter "ident" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgTableLmsIdent)
|
||||
, prismAForm (singletonFilter "validity" . maybePrism _PathPiece) mPrev $ aopt boolField' (fslI MsgFilterLmsValid)
|
||||
, prismAForm (singletonFilter "long-valid" . maybePrism _PathPiece) mPrev $ aopt checkBoxField (fslI MsgFilterLmsLongValid)
|
||||
, prismAForm (singletonFilter "notified" . maybePrism _PathPiece) mPrev $ aopt boolField' (fslI MsgFilterLmsNotified)
|
||||
, prismAForm (singletonFilter "status" . maybePrism _PathPiece) mPrev $ aopt (hoistField liftHandler (selectField optionsFinite) :: (Field _ (Maybe LmsStatus))) (fslI MsgTableLmsStatus)
|
||||
-- , if isNothing mbRenewal then mempty
|
||||
-- else prismAForm (singletonFilter "renewal-due" . maybePrism _PathPiece) mPrev $ aopt checkBoxField (fslI MsgFilterLmsRenewal)
|
||||
]
|
||||
|
||||
@ -425,25 +425,36 @@ mkQualificationTable isAdmin (Entity qid quali) acts cols psValidator = do
|
||||
E.where_ $ usrComp E.^. UserCompanyUser E.==. queryUser row E.^. UserId E.&&. testcrit
|
||||
)
|
||||
, ("validity" , FilterColumn . E.mkExactFilterLast $ views (to queryQualUser) (validQualification now))
|
||||
, ("renewal-due" , FilterColumn $ \(queryQualUser -> quser) criterion ->
|
||||
if | Just renewal <- mbRenewal
|
||||
, Just True <- getLast criterion -> quser E.^. QualificationUserValidUntil E.<=. E.val renewal
|
||||
E.&&. quser E.^. QualificationUserValidUntil E.>=. E.val nowaday
|
||||
| otherwise -> E.true
|
||||
, ("long-valid",
|
||||
let cutoff = if
|
||||
| Just refWithin <- qualificationRefreshWithin quali -> computeNewValidDate' (refWithin <> calendarDay) nowaday -- longer valid than renewal
|
||||
| Just valDuration <- qualificationValidDuration quali -> computeNewValidDate (valDuration `div` 2) nowaday -- or longer valid than half the duration
|
||||
| otherwise -> computeNewValidDate' (calendarYear <> calendarDay) nowaday -- or a year and a day
|
||||
in FilterColumn . E.mkExactFilterLast $ views (to queryQualUser) ((E.>. E.val cutoff) . (E.^. QualificationUserValidUntil)) -- for use with boolField
|
||||
-- in FilterColumn $ \(queryQualUser -> quser) (getLast -> criterion) -> if -- for use with checkboxField
|
||||
-- | Just True <- criterion -> quser E.^. QualificationUserValidUntil E.>=. E.val cutoff
|
||||
-- | otherwise -> E.true
|
||||
)
|
||||
, ("tobe-notified", FilterColumn $ \row criterion ->
|
||||
if | Just True <- getLast criterion -> quserToNotify now (queryQualUser row) (queryQualBlock row)
|
||||
| otherwise -> E.true
|
||||
, ("renewal-due" , FilterColumn $ \(queryQualUser -> quser) criterion -> if
|
||||
| Just renewal <- mbRenewal
|
||||
, Just True <- getLast criterion -> quser E.^. QualificationUserValidUntil E.<=. E.val renewal
|
||||
E.&&. quser E.^. QualificationUserValidUntil E.>=. E.val nowaday
|
||||
| otherwise -> E.true
|
||||
)
|
||||
, ("tobe-notified", FilterColumn $ \row criterion -> if
|
||||
| Just True <- getLast criterion -> quserToNotify now (queryQualUser row) (queryQualBlock row)
|
||||
| otherwise -> E.true
|
||||
)
|
||||
, ("status" , FilterColumn . E.mkExactFilterMaybeLast' (views (to queryLmsUser) (E.?. LmsUserId)) $ views (to queryLmsUser) (E.?. LmsUserStatus))
|
||||
]
|
||||
dbtFilterUI mPrev = mconcat
|
||||
[ fltrUserNameEmailHdrUI MsgLmsUser mPrev
|
||||
, prismAForm (singletonFilter "user-company") mPrev $ aopt textField (fslI MsgTableCompany)
|
||||
, prismAForm (singletonFilter "personal-number" ) mPrev $ aopt textField (fslI MsgCompanyPersonalNumberFraport)
|
||||
, prismAForm (singletonFilter "user-company") mPrev $ aopt textField (fslI MsgTableCompany)
|
||||
, prismAForm (singletonFilter "personal-number" ) mPrev $ aopt textField (fslI MsgCompanyPersonalNumberFraport)
|
||||
, fltrAVSCardNosUI mPrev
|
||||
, prismAForm (singletonFilter "avs-number" ) mPrev $ aopt textField (fslI MsgAvsPersonNo)
|
||||
, prismAForm (singletonFilter "validity" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterLmsValid)
|
||||
, prismAForm (singletonFilter "avs-number" ) mPrev $ aopt textField (fslI MsgAvsPersonNo)
|
||||
, prismAForm (singletonFilter "validity" . maybePrism _PathPiece) mPrev $ aopt boolField' (fslI MsgFilterLmsValid)
|
||||
, prismAForm (singletonFilter "long-valid" . maybePrism _PathPiece) mPrev $ aopt boolField' (fslI MsgFilterLmsLongValid)
|
||||
, 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)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user