refactor(lms): fix #75 by splitting lmsStatus
This commit is contained in:
parent
3d595271d9
commit
2d62acea5e
@ -117,6 +117,7 @@ LmsUser
|
||||
datePin UTCTime default=now() -- time pin was created
|
||||
status LmsStatus Maybe -- open, success or failure; status should never change unless isNothing; isJust indicates lms is finished and user shall be deleted from LMS
|
||||
--toDelete encoded by Handler.Utils.LMS.lmsUserToDelete
|
||||
statusDay Day Maybe -- date of status change; should be isJust iff isJust status; modelling as a separate table too bothersome, unlike qualification block
|
||||
started UTCTime default=now()
|
||||
received UTCTime Maybe -- last acknowledgement by LMS
|
||||
notified UTCTime Maybe -- last notified by FRADrive
|
||||
@ -130,7 +131,7 @@ LmsUser
|
||||
-- lmsUser LmsUserId OnDeleteCascade OnUpdateCascade
|
||||
-- result LmsStatus -- data LmsStatus = LmsBlocked | LmsExpired | LmsSuccess
|
||||
-- day Day
|
||||
-- UniqueLmsUserStatus lmsUser
|
||||
-- UniqueLmsUserStatus lmsUser -- enforcing uniqueness prohibits history
|
||||
-- deriving Generic
|
||||
|
||||
-- LmsUserlist stores LMS upload for later processing only
|
||||
|
||||
@ -213,6 +213,7 @@ data LmsTableCsv = LmsTableCsv -- L..T..C.. -> ltc..
|
||||
, ltcBlockFrom :: Maybe UTCTime
|
||||
, ltcLmsIdent :: LmsIdent
|
||||
, ltcLmsStatus :: Maybe LmsStatus
|
||||
, ltcLmsStatusDay :: Maybe Day
|
||||
, ltcLmsStarted :: UTCTime
|
||||
, ltcLmsDatePin :: UTCTime
|
||||
, ltcLmsReceived :: Maybe UTCTime
|
||||
@ -228,13 +229,14 @@ ltcExample = LmsTableCsv
|
||||
, ltcEmail = "m.mustermann@example.com"
|
||||
, ltcCompany = Just "Example Brothers LLC, SecondaryJobs Inc"
|
||||
, ltcCompanyNumbers = CsvSemicolonList [27,69]
|
||||
, ltcValidUntil = compDay
|
||||
, ltcValidUntil = succ compDay
|
||||
, ltcLastRefresh = compDay
|
||||
, ltcFirstHeld = compDay
|
||||
, ltcFirstHeld = pred $ pred compDay
|
||||
, ltcBlockStatus = Nothing
|
||||
, ltcBlockFrom = Nothing
|
||||
, ltcLmsIdent = LmsIdent "abcdefgh"
|
||||
, ltcLmsStatus = Nothing
|
||||
, ltcLmsStatus = Just LmsSuccess
|
||||
, ltcLmsStatusDay = Just $ pred compDay
|
||||
, ltcLmsStarted = compTime
|
||||
, ltcLmsDatePin = compTime
|
||||
, ltcLmsReceived = Nothing
|
||||
@ -277,6 +279,7 @@ instance CsvColumnsExplained LmsTableCsv where
|
||||
, ('ltcBlockFrom , SomeMessage MsgInfoQualificationBlockFrom)
|
||||
, ('ltcLmsIdent , SomeMessage MsgTableLmsIdent)
|
||||
, ('ltcLmsStatus , SomeMessage MsgTableLmsStatus)
|
||||
, ('ltcLmsStatusDay , SomeMessage MsgTableLmsStatusDay)
|
||||
, ('ltcLmsStarted , SomeMessage MsgTableLmsStarted)
|
||||
, ('ltcLmsDatePin , SomeMessage MsgTableLmsDatePin)
|
||||
, ('ltcLmsReceived , SomeMessage MsgTableLmsReceived)
|
||||
@ -520,6 +523,7 @@ mkLmsTable isAdmin (Entity qid quali) acts cols psValidator = do
|
||||
<*> preview (resultQualBlock . _entityVal . _qualificationUserBlockFrom)
|
||||
<*> view (resultLmsUser . _entityVal . _lmsUserIdent)
|
||||
<*> view (resultLmsUser . _entityVal . _lmsUserStatus)
|
||||
<*> view (resultLmsUser . _entityVal . _lmsUserStatusDay)
|
||||
<*> view (resultLmsUser . _entityVal . _lmsUserStarted)
|
||||
<*> view (resultLmsUser . _entityVal . _lmsUserDatePin)
|
||||
<*> view (resultLmsUser . _entityVal . _lmsUserReceived)
|
||||
|
||||
@ -400,7 +400,7 @@ postPrintAckR ackDay numAck chksm = do
|
||||
now <- liftIO getCurrentTime
|
||||
E.updateCount $ \pj -> do
|
||||
let pjDay = E.day $ pj E.^. PrintJobCreated
|
||||
E.set pj [ PrintJobAcknowledged E.=. E.just (E.val now) ]
|
||||
E.set pj [ PrintJobAcknowledged E.=. E.justVal now ]
|
||||
E.where_ $ E.isNothing (pj E.^. PrintJobAcknowledged)
|
||||
E.&&. (pjDay E.==. E.val ackDay)
|
||||
-- Ex.updateCount $ do
|
||||
|
||||
@ -489,8 +489,8 @@ mkQualificationTable isAdmin (Entity qid quali) acts cols psValidator = do
|
||||
Nothing -> maybeM (return Nothing) (const $ return $ Just "Open") $
|
||||
preview (resultLmsUser . _entityVal . _lmsUserStarted)
|
||||
getStatusPlusDay =
|
||||
(join . preview (resultLmsUser . _entityVal . _lmsUserStatus)) >>= \case
|
||||
Just ls -> return $ Just $ lmsStatusDay ls
|
||||
(join . preview (resultLmsUser . _entityVal . _lmsUserStatusDay)) >>= \case
|
||||
lsd@(Just _) -> return lsd
|
||||
Nothing -> utctDay <<$>> preview (resultLmsUser . _entityVal . _lmsUserStarted)
|
||||
|
||||
dbtCsvDecode = Nothing
|
||||
|
||||
@ -114,12 +114,13 @@ lmsDeletionDate = do
|
||||
-- | Decide whether LMS platform should delete an identifier
|
||||
lmsUserToDeleteExpr :: Day -> E.SqlExpr (Entity LmsUser) -> E.SqlExpr (E.Value Bool)
|
||||
lmsUserToDeleteExpr cutoff lmslist = E.isNothing (lmslist E.^. LmsUserEnded)
|
||||
E.&&. E.not_ (E.isNothing $ lmslist E.^. LmsUserStatus)
|
||||
E.&&. E.explicitUnsafeCoerceSqlExprValue "timestamp" ((lmslist E.^. LmsUserStatus) E.#>>. "{day}") E.<=. E.val cutoff
|
||||
E.&&. E.isJust (lmslist E.^. LmsUserStatus)
|
||||
E.&&. E.isJust (lmslist E.^. LmsUserStatusDay)
|
||||
E.&&. lmslist E.^. LmsUserStatusDay E.<=. E.justVal cutoff
|
||||
|
||||
-- | Is everything since cutoff day or before?
|
||||
lmsUserToDelete :: Day -> LmsUser -> Bool
|
||||
lmsUserToDelete cutoff LmsUser{lmsUserEnded=Nothing, lmsUserStatus= Just lstat} = lmsStatusDay lstat < cutoff
|
||||
lmsUserToDelete cutoff LmsUser{lmsUserEnded=Nothing, lmsUserStatusDay= Just lstat} = lstat < cutoff
|
||||
lmsUserToDelete _ _ = False
|
||||
|
||||
_lmsUserToDelete :: Day -> Getter LmsUser Bool
|
||||
@ -194,9 +195,9 @@ lmsStatusIcon LmsExpired{} = IconExpired
|
||||
lmsStatusIcon _other = IconNotOK
|
||||
|
||||
lmsUserStatusWidget :: Bool -> LmsUser -> Widget
|
||||
lmsUserStatusWidget _ LmsUser{lmsUserStatus=Just lStat} =
|
||||
lmsUserStatusWidget _ LmsUser{lmsUserStatus=Just lStat, lmsUserStatusDay=Just aday} =
|
||||
[whamlet|$newline never
|
||||
^{formatTimeW SelFormatDate (lmsStatusDay lStat)}
|
||||
^{formatTimeW SelFormatDate aday}
|
||||
\ ^{icon (lmsStatusIcon lStat)}
|
||||
|]
|
||||
-- previously: IconWaitingForUser for lmsUserStatus==Nothing
|
||||
|
||||
@ -141,6 +141,7 @@ dispatchJobLmsEnqueueUser qid uid = JobHandlerAtomic act
|
||||
, lmsUserResetPin = False
|
||||
, lmsUserDatePin = now
|
||||
, lmsUserStatus = Nothing
|
||||
, lmsUserStatusDay = Nothing
|
||||
, lmsUserStarted = now
|
||||
, lmsUserReceived = Nothing
|
||||
, lmsUserNotified = Nothing
|
||||
@ -183,7 +184,7 @@ dispatchJobLmsDequeue qid = JobHandlerAtomic act
|
||||
E.&&. E.not_ (validQualification now quser)
|
||||
pure (luser E.^. LmsUserId)
|
||||
nrExpired <- E.updateCount $ \luser -> do
|
||||
E.set luser [LmsUserStatus E.=. E.justVal (LmsExpired nowaday)]
|
||||
E.set luser [LmsUserStatus E.=. E.justVal LmsExpired, LmsUserStatusDay E.=. E.justVal nowaday]
|
||||
E.where_ $ (luser E.^. LmsUserId) `E.in_` E.valList (E.unValue <$> expiredLearners)
|
||||
E.&&. luser E.^. LmsUserQualification E.==. E.val qid
|
||||
$logInfoS "LMS" $ "Expired lms users " <> tshow nrExpired <> " for qualification " <> qshort
|
||||
@ -211,7 +212,7 @@ dispatchJobLmsDequeue qid = JobHandlerAtomic act
|
||||
delusersVals <- E.select $ do
|
||||
luser <- E.from $ E.table @LmsUser
|
||||
E.where_ $ luser E.^. LmsUserQualification E.==. E.val qid
|
||||
E.&&. luser E.^. LmsUserEnded E.<. E.just (E.val auditCutoff)
|
||||
E.&&. luser E.^. LmsUserEnded E.<. E.justVal auditCutoff
|
||||
E.&&. E.isJust (luser E.^. LmsUserEnded)
|
||||
-- E.&&. E.notExists (do
|
||||
-- laudit <- E.from $ E.table @LmsAudit
|
||||
@ -257,10 +258,9 @@ dispatchJobLmsResults qid = JobHandlerAtomic act
|
||||
-- three separate DB operations per result is not so nice. All within one transaction though.
|
||||
let lmsUserStartedDay = localDay $ TZ.utcToLocalTimeTZ appTZ lmsUserStarted
|
||||
saneDate = lmsResultSuccess `inBetween` (lmsUserStartedDay, min qualificationUserValidUntil locDay)
|
||||
-- && qualificationUserLastRefresh <= utctDay lmsUserStarted NOTE: not always true due to manual intervention; also renewValidQualificationUsers prevents double renewals anyway
|
||||
newStatus = Just $ LmsSuccess lmsResultSuccess
|
||||
-- && qualificationUserLastRefresh <= utctDay lmsUserStarted NOTE: not always true due to manual intervention; also renewValidQualificationUsers prevents double renewals anyway
|
||||
-- newValidTo = addGregorianMonthsRollOver (toInteger renewalMonths) qualificationUserValidUntil -- renew from old validUntil onwards
|
||||
note <- if saneDate && replaceLmsStatus lmsUserStatus newStatus
|
||||
note <- if saneDate && (lmsUserStatus /= Just LmsSuccess)
|
||||
then do
|
||||
-- WORKAROUND LMS-Bug [supposedly fixed now, but isnt]: sometimes we receive success and failure simultaneously; success is correct, hence we must unblock if the reason was e-learning
|
||||
let reason_undo = Left $ "LMS Workaround undoing: " <> qualificationBlockedReasonText QualificationBlockFailedELearning
|
||||
@ -271,8 +271,9 @@ dispatchJobLmsResults qid = JobHandlerAtomic act
|
||||
-- when (ok==1) $ update luid -- we end lms regardless of whether or not a regular renewal was successful, since BPol users may simultaneoysly have on-premise renewal courses and E-Learnings
|
||||
|
||||
update luid
|
||||
[ LmsUserStatus =. newStatus
|
||||
, LmsUserReceived =. Just lmsResultTimestamp
|
||||
[ LmsUserStatus =. Just LmsSuccess
|
||||
, LmsUserStatusDay =. Just lmsResultSuccess
|
||||
, LmsUserReceived =. Just lmsResultTimestamp
|
||||
]
|
||||
return Nothing
|
||||
else do
|
||||
@ -328,10 +329,9 @@ dispatchJobLmsUserlist qid = JobHandlerAtomic act
|
||||
|
||||
let isBlocked = lmsUserlistFailed lulist
|
||||
oldStatus = lmsUserStatus luser
|
||||
newStatus = bool Nothing (Just $ LmsBlocked lmsMsgDay) isBlocked
|
||||
updateStatus = replaceLmsStatus oldStatus newStatus
|
||||
updateStatus = isBlocked && oldStatus /= Just LmsSuccess
|
||||
when updateStatus $ do
|
||||
update luid [LmsUserStatus =. newStatus]
|
||||
update luid [LmsUserStatus =. Just LmsBlocked, LmsUserStatusDay =. Just lmsMsgDay]
|
||||
ok <- qualificationUserBlocking qid [lmsUserUser luser] False (Right QualificationBlockFailedELearning) True
|
||||
when (ok /= 1) $ do
|
||||
uuid :: CryptoUUIDUser <- encrypt $ lmsUserUser luser
|
||||
|
||||
@ -93,6 +93,7 @@ data ManualMigration
|
||||
| Migration20210318CrontabSubmissionRatedNotification
|
||||
| Migration20210608SeparateTermActive
|
||||
| Migration20230524QualificationUserBlock
|
||||
| Migration20230703LmsUserStatus
|
||||
deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic)
|
||||
deriving anyclass (Universe, Finite)
|
||||
|
||||
@ -868,9 +869,9 @@ customMigrations = mapF $ \case
|
||||
, "from" timestamp with time zone NOT NULL
|
||||
, "reason" character varying NOT NULL
|
||||
, "blocker" bigint
|
||||
, CONSTRAINT qualification_user_block_qualification_user_fkey FOREIGN KEY ("qualification_user") REFERENCES "qualification_user"(id) ON DELETE CASCADE
|
||||
, CONSTRAINT qualification_user_block_qualification_user_fkey FOREIGN KEY ("qualification_user") REFERENCES "qualification_user"(id) ON DELETE CASCADE ON UPDATE CASCADE
|
||||
, CONSTRAINT qualification_user_block_blocker_fkey FOREIGN KEY ("blocker") REFERENCES "user"(id)
|
||||
)
|
||||
);
|
||||
|]
|
||||
|
||||
let getBlocks = [queryQQ|SELECT "id", "blocked_due" FROM "qualification_user" WHERE "blocked_due" IS NOT NULL|]
|
||||
@ -883,6 +884,16 @@ customMigrations = mapF $ \case
|
||||
ALTER TABLE "qualification_user" DROP COLUMN "blocked_due";
|
||||
|]
|
||||
|
||||
Migration20230703LmsUserStatus ->
|
||||
unlessM (columnExists "lms_user" "status_day") $ do
|
||||
[executeQQ|
|
||||
ALTER TABLE "lms_user" ADD COLUMN "status_day" date;
|
||||
UPDATE "lms_user"
|
||||
SET "status_day" = CAST("status"->>'day' AS date)
|
||||
, "status" = "status"->'lms-status'
|
||||
;
|
||||
|]
|
||||
|
||||
|
||||
tableExists :: MonadIO m => Text -> ReaderT SqlBackend m Bool
|
||||
tableExists table = do
|
||||
|
||||
@ -34,57 +34,25 @@ deriveJSON defaultOptions
|
||||
|
||||
-- TODO: Is this a good idea? An ordinary Enum and a separate Day column in the DB would be better, e.g. allowing use of insertSelect in Jobs.Handler.LMS?
|
||||
-- ...also see similar type QualificationBlocked
|
||||
data LmsStatus = LmsBlocked { lmsStatusDay :: Day }
|
||||
| LmsExpired { lmsStatusDay :: Day }
|
||||
| LmsSuccess { lmsStatusDay :: Day }
|
||||
deriving (Eq, Read, Show, Generic, NFData)
|
||||
|
||||
instance Ord LmsStatus where
|
||||
compare a b
|
||||
| daycmp <- compare (lmsStatusDay a) (lmsStatusDay b)
|
||||
, daycmp /= EQ = daycmp
|
||||
compare LmsSuccess{} LmsBlocked{} = GT
|
||||
compare LmsSuccess{} LmsExpired{} = GT
|
||||
compare LmsBlocked{} LmsSuccess{} = LT
|
||||
compare LmsExpired{} LmsSuccess{} = LT
|
||||
compare LmsBlocked{} LmsExpired{} = GT
|
||||
compare LmsExpired{} LmsBlocked{} = LT
|
||||
compare _ _ = EQ
|
||||
|
||||
isLmsSuccess :: LmsStatus -> Bool
|
||||
isLmsSuccess LmsSuccess{} = True
|
||||
isLmsSuccess _other = False
|
||||
|
||||
isLmsExpired :: LmsStatus -> Bool
|
||||
isLmsExpired LmsExpired{} = True
|
||||
isLmsExpired _other = False
|
||||
|
||||
-- | What to do if LMS sends multiple responses and whether an oldStatus should be overwritten
|
||||
replaceLmsStatus :: Maybe LmsStatus -> Maybe LmsStatus -> Bool
|
||||
replaceLmsStatus _ Nothing = False
|
||||
replaceLmsStatus Nothing _ = True
|
||||
replaceLmsStatus (Just LmsSuccess{}) _ = False
|
||||
replaceLmsStatus (Just LmsExpired{}) (Just newStat) = not $ isLmsExpired newStat
|
||||
replaceLmsStatus (Just LmsBlocked{}) (Just newStat) = isLmsSuccess newStat
|
||||
|
||||
makeLenses_ ''LmsStatus
|
||||
|
||||
-- Entscheidung 16.09.22: Es gewinnt was zuerst gemeldet wurde. Das verhindert, dass eine Qualifikation doppelt verlängert wird! Siehe Model.TypesSpec
|
||||
instance Semigroup LmsStatus where
|
||||
a <> b = min a b -- earliest date, otherwise LmsBlocked before LmsSuccess
|
||||
data LmsStatus = LmsExpired
|
||||
| LmsBlocked
|
||||
| LmsSuccess
|
||||
deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, NFData)
|
||||
deriving anyclass (Universe, Finite)
|
||||
|
||||
deriveJSON defaultOptions
|
||||
{ constructorTagModifier = camelToPathPiece' 1 -- remove lms from constructor, since the object is tagged with lms already
|
||||
, fieldLabelModifier = camelToPathPiece' 2 -- just day suffices for the day field
|
||||
, omitNothingFields = True
|
||||
, sumEncoding = TaggedObject "lms-status" "lms-result"
|
||||
{ constructorTagModifier = camelToPathPiece' 1 -- remove lms from constructor
|
||||
, fieldLabelModifier = camelToPathPiece' 1
|
||||
, sumEncoding = UntaggedValue
|
||||
} ''LmsStatus
|
||||
derivePersistFieldJSON ''LmsStatus
|
||||
|
||||
nullaryPathPiece ''LmsStatus $ camelToPathPiece' 1
|
||||
|
||||
instance Csv.ToField LmsStatus where
|
||||
toField (LmsBlocked d) = "Failure: " <> Csv.toField d
|
||||
toField (LmsExpired d) = "Expired: " <> Csv.toField d
|
||||
toField (LmsSuccess d) = "Success: " <> Csv.toField d
|
||||
toField = Csv.toField . toPathPiece
|
||||
|
||||
|
||||
|
||||
-- | Default Block/Unblock reasons
|
||||
data QualificationBlockStandardReason
|
||||
|
||||
@ -63,9 +63,9 @@ instance Hashable AuthenticationMode
|
||||
instance NFData AuthenticationMode
|
||||
|
||||
deriveJSON defaultOptions
|
||||
{ constructorTagModifier = intercalate "-" . map toLower . drop 1 . splitCamel
|
||||
, fieldLabelModifier = intercalate "-" . map toLower . drop 1 . splitCamel
|
||||
, sumEncoding = UntaggedValue
|
||||
{ constructorTagModifier = camelToPathPiece' 1
|
||||
, fieldLabelModifier = camelToPathPiece' 1
|
||||
, sumEncoding = UntaggedValue
|
||||
} ''AuthenticationMode
|
||||
|
||||
derivePersistFieldJSON ''AuthenticationMode
|
||||
|
||||
@ -731,12 +731,12 @@ fillDb = do
|
||||
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
|
||||
void . insert' $ LmsUser qid_f jost (LmsIdent "ijk" ) "123" False now Nothing now Nothing (Just $ n_day' (-7)) (Just $ n_day' (-5))
|
||||
void . insert' $ LmsUser qid_f svaupel (LmsIdent "abcdefg") "abc" False now (Just $ LmsSuccess $ n_day 1) (n_day' (-1)) (Just now) (Just $ n_day' 0) Nothing
|
||||
void . insert' $ LmsUser qid_f gkleen (LmsIdent "hijklmn") "@#!" True now (Just $ LmsBlocked $ utctDay now) (n_day' (-2)) (Just now) (Just $ n_day' (-4)) Nothing
|
||||
void . insert' $ LmsUser qid_f tinaTester (LmsIdent "qwvu") "45678" True now (Just $ LmsSuccess $ n_day (-22)) (n_day' (-3)) (Just $ n_day' (-1)) (Just $ n_day' (-1)) Nothing
|
||||
void . insert' $ LmsUser qid_f maxMuster (LmsIdent "xyz") "a1b2c3" False now (Just $ LmsBlocked $ n_day (-11)) (n_day' (-4)) (Just $ n_day' (-2)) (Just $ n_day' (-2)) Nothing
|
||||
void . insert' $ LmsUser qid_f fhamann (LmsIdent "123") "456" False now Nothing now Nothing Nothing Nothing
|
||||
void . insert' $ LmsUser qid_f jost (LmsIdent "ijk" ) "123" False now Nothing Nothing now Nothing (Just $ n_day' (-7)) (Just $ n_day' (-5))
|
||||
void . insert' $ LmsUser qid_f svaupel (LmsIdent "abcdefg") "abc" False now (Just LmsSuccess) (Just $ n_day 1) (n_day' (-1)) (Just now) (Just $ n_day' 0) Nothing
|
||||
void . insert' $ LmsUser qid_f gkleen (LmsIdent "hijklmn") "@#!" True now (Just LmsBlocked) (Just $ utctDay now) (n_day' (-2)) (Just now) (Just $ n_day' (-4)) Nothing
|
||||
void . insert' $ LmsUser qid_f tinaTester (LmsIdent "qwvu") "45678" True now (Just LmsSuccess) (Just $ n_day (-22)) (n_day' (-3)) (Just $ n_day' (-1)) (Just $ n_day' (-1)) Nothing
|
||||
void . insert' $ LmsUser qid_f maxMuster (LmsIdent "xyz") "a1b2c3" False now (Just LmsBlocked) (Just $ n_day (-11)) (n_day' (-4)) (Just $ n_day' (-2)) (Just $ n_day' (-2)) Nothing
|
||||
void . insert' $ LmsUser qid_f fhamann (LmsIdent "123") "456" False now Nothing Nothing now Nothing Nothing Nothing
|
||||
|
||||
void . insert $ PrintJob "TestJob1" "AckTestJob1" "job1" "No Text herein." (n_day' (-1)) Nothing Nothing (Just svaupel) Nothing (Just qid_f) Nothing
|
||||
void . insert $ PrintJob "TestJob2" "AckTestJob2" "job2" "No Text herein." (n_day' (-3)) (Just $ n_day' (-1)) (Just jost) (Just svaupel) Nothing (Just qid_f) (Just $ LmsIdent "ijk")
|
||||
@ -1100,7 +1100,7 @@ fillDb = do
|
||||
, exceptEnd = TimeOfDay 16 20 0
|
||||
}
|
||||
, ExceptOccur
|
||||
{ exceptDay = succ $ succ $ secondDay
|
||||
{ exceptDay = succ $ succ secondDay
|
||||
, exceptStart = TimeOfDay 10 12 0
|
||||
, exceptEnd = TimeOfDay 12 13 0
|
||||
}
|
||||
@ -1112,7 +1112,7 @@ fillDb = do
|
||||
, tutorialDeregisterUntil = jtt TermDayLectureStart (-5) (Just Monday) toMidnight
|
||||
, tutorialLastChanged = now
|
||||
, tutorialTutorControlled = True
|
||||
, tutorialFirstDay = Just $ succ $ succ $ firstDay
|
||||
, tutorialFirstDay = Just $ succ $ succ firstDay
|
||||
}
|
||||
when (odd tyear) $
|
||||
void . insert' $ Exam
|
||||
|
||||
Loading…
Reference in New Issue
Block a user