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

refactor(lms): qualification validity changed from utctime to days

Browse Source
This commit is contained in:
Steffen Jost 2022-04-04 15:39:57 +02:00
parent a5121f0d3e
commit 2dac5a056c
3 changed files with 19 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
models/lms.model
View File

@ -47,9 +47,9 @@ QualificationEdit
QualificationUser
user UserId
qualification QualificationId OnDeleteCascade OnUpdateCascade
validUntil UTCTime --TODO convert to DAYS only!
lastRefresh UTCTime -- lastRefresh > validUntil possible, if Qualification^elearningOnly == False
firstHeld UTCTime -- first time the qualification was earned, should never change
validUntil Day
lastRefresh Day -- lastRefresh > validUntil possible, if Qualification^elearningOnly == False
firstHeld Day -- first time the qualification was earned, should never change
-- temporärer Entzug vorsehen
-- Begründungsfeld vorsehen
UniqueQualificationUser qualification user

4
src/Handler/LMS.hs
View File

@ -59,7 +59,7 @@ resultAllQualificationTotal = _dbrOutput . _3 . _unValue
mkLmsAllTable :: DB (Any, Widget)
mkLmsAllTable = do
now <- liftIO getCurrentTime
let
let
resultDBTable = DBTable{..}
where
dbtSQLQuery quali = do
@ -69,7 +69,7 @@ mkLmsAllTable = do
cactive <- pure . Ex.subSelectCount $ do
quser <- Ex.from $ Ex.table @QualificationUser
Ex.where_ $ quser Ex.^. QualificationUserQualification Ex.==. quali Ex.^. QualificationId
E.&&. quser Ex.^. QualificationUserValidUntil Ex.>=. E.val now
E.&&. quser Ex.^. QualificationUserValidUntil Ex.>=. E.val (utctDay now)
-- Failed attempt using Join/GroupBy instead of subselect: see branch csv-osis-demo-groupby-problem
return (quali, cactive, cusers)
dbtRowKey = (E.^. QualificationId)

28
test/Database/Fill.hs
View File

@ -62,6 +62,7 @@ fillDb = do
insert' = fmap (either entityKey id) . insertBy
addBDays = addBusinessDays Fraport -- holiday area to use
n_day n = addBDays n $ utctDay now
currentTerm = TermIdentifier . fst3 . toGregorian $ utctDay now
-- (currentYear, currentMonth, currentDay) = toGregorian $ getTermDay currentTerm
nextTerm n = toEnum . (+n) $ fromEnum currentTerm
@ -459,23 +460,22 @@ fillDb = do
let f_descr = Just $ htmlToStoredMarkup [shamlet|<p>Berechtigung zum Führen eines Fahrzeuges auf den Fahrstrassen des Vorfeldes.|]
let r_descr = Just $ htmlToStoredMarkup [shamlet|<p>Berechtigung zum Führen eines Fahrzeuges auf dem gesamten Rollfeld.|]
let l_descr = Just $ htmlToStoredMarkup [shamlet|<p>für unhabilitierte|]
let l_descr = Just $ htmlToStoredMarkup [shamlet|<p>für unhabilitierte|]
qid_f <- insert' $ Qualification avn "F" "Vorfeldführerschein" f_descr (Just 24) (Just $ 5 * 12) Nothing True
qid_r <- insert' $ Qualification avn "R" "Rollfeldführerschein" r_descr (Just 24) (Just $ 5 * 12) Nothing False
qid_l <- insert' $ Qualification ifi "L" "Lehrbefähigung" l_descr Nothing (Just $ 5 * 12) Nothing False
void . insert' $ QualificationUser jost qid_f (addUTCTime nominalDay now) (addUTCTime (negate nominalDay) now) (addUTCTime (negate nominalDay) now) -- TODO: better dates!
void . insert' $ QualificationUser gkleen qid_f now now now
void . insert' $ QualificationUser maxMuster qid_f now now now
void . insert' $ QualificationUser svaupel qid_f (addUTCTime nominalDay now) (addUTCTime (negate nominalDay) now) (addUTCTime (negate nominalDay) now)
void . insert' $ QualificationUser gkleen qid_r now now now
void . insert' $ QualificationUser maxMuster qid_r (addUTCTime nominalDay now) (addUTCTime (negate nominalDay) now) (addUTCTime (negate nominalDay) now)
void . insert' $ QualificationUser fhamann qid_r now now now
void . insert' $ QualificationUser svaupel qid_l now now now
void . insert' $ QualificationUser gkleen qid_l now now now
void . insert' $ LmsResult qid_f (LmsIdent "hijklmn") (addBDays (-1) $ utctDay now) now
void . insert' $ LmsResult qid_f (LmsIdent "opqgrs" ) (addBDays (-2) $ utctDay now) now
void . insert' $ LmsResult qid_f (LmsIdent "pqgrst" ) (addBDays (-3) $ utctDay now) now
void . insert' $ QualificationUser jost qid_f (n_day 9) (n_day $ -1) (n_day $ -22) -- TODO: better dates!
void . insert' $ QualificationUser gkleen qid_f (n_day $ -3) (n_day $ -4) (n_day $ -20)
void . insert' $ QualificationUser maxMuster qid_f (n_day 0) (n_day $ -2) (n_day $ -8)
void . insert' $ QualificationUser svaupel qid_f (n_day 1) (n_day $ -1) (n_day $ -2)
void . insert' $ QualificationUser gkleen qid_r (n_day $ -7) (n_day $ -2) (n_day $ -9)
void . insert' $ QualificationUser maxMuster qid_r (n_day 1) (n_day $ -1) (n_day $ -2)
void . insert' $ QualificationUser fhamann qid_r (n_day $ -3) (n_day $ -1) (n_day $ -2)
void . insert' $ QualificationUser svaupel qid_l (n_day 1) (n_day $ -1) (n_day $ -2)
void . insert' $ QualificationUser gkleen qid_l (n_day 9) (n_day $ -1) (n_day $ -7)
void . insert' $ LmsResult qid_f (LmsIdent "hijklmn") (n_day (-1)) now
void . insert' $ LmsResult qid_f (LmsIdent "opqgrs" ) (n_day (-2)) now
void . insert' $ LmsResult qid_f (LmsIdent "pqgrst" ) (n_day (-3)) now
void . insert' $ LmsUserlist qid_f (LmsIdent "hijklmn") False now
void . insert' $ LmsUserlist qid_f (LmsIdent "abcdefg") True now
void . insert' $ LmsUserlist qid_f (LmsIdent "ijk" ) False now