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

chore(term): change to 4 digit format for disambiguation

Browse Source
This commit is contained in:
Steffen Jost 2022-03-30 17:25:12 +02:00
parent 88b22d50e8
commit 4fd4462045
9 changed files with 81 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
messages/uniworx/categories/term/de-de-formal.msg
View File

@ -5,24 +5,23 @@ TermStartMustBeBeforeLectureStart: Semester muss vor der Vorlesungszeit beginnen
TermEndMustBeAfterLectureEnd: Vorlesungszeit muss vor dem Semester enden.
TermShort: Kürzel
TermCourseCount: Kurse
TermStart: Semesteranfang
TermEnd: Semesterende
LectureStart: Beginn Vorlesungen
TermStart: Anfang Kursperiode
TermEnd: Ende Kursperiode
LectureStart: Beginn Kurse
TermEdited tid@TermId: Semester #{tid} erfolgreich editiert.
TermNewTitle: Semester editieren/anlegen.
InvalidInput: Eingaben bitte korrigieren.
Term !ident-ok: Semester
TermPlaceholder: JJJJ-MM-TT (Erster Tag einer Schulung)
TermStartDay: Erster Tag
TermStartDayTooltip: Üblicherweise immer 1. April oder 1. Oktober
TermEndDay: Letzter Tag
TermEndDayTooltip: Üblicherweise immer 30. September oder 31. März
TermHolidays: Feiertage
TermHolidayPlaceholder: Feiertag
TermHolidayMissing: Feiertag wird benötigt
TermLectureStart: Beginn Vorlesungen
TermLectureEnd: Ende Vorlesungen
TermLectureEndTooltip: Meistens dauer das Sommersemester 14 Wochen und das Wintersemester 15 Wochen.
TermLectureStartTooltip: Muss am oder nach dem Beginn liegen
TermLectureEndTooltip: Muss am oder vor dem Ende liegen
TermActive: Aktiv
NumCourses num@Int64: #{num} #{pluralDE num "Kurs" "Kurse"}
TermsHeading: Semesterübersicht

11
messages/uniworx/categories/term/en-eu.msg
View File

@ -5,24 +5,23 @@ TermStartMustBeBeforeLectureStart: Semester start must be before lecture start.
TermEndMustBeAfterLectureEnd: Lecture end must be before semester end.
TermShort: Shorthand
TermCourseCount: Courses
TermStart: Semester start
TermEnd: Semester end
LectureStart: Lectures start
TermStart: Start of teaching period
TermEnd: End of teaching perios
LectureStart: Courses start
TermEdited tid: Successfully edited semester #{tid}
TermNewTitle: Edit/create semester
InvalidInput: Invalid input
Term: Semester
TermPlaceholder: YYYY-MM-DD (First day of courses)
TermStartDay: Starting day
TermStartDayTooltip: Usually 1st of April or 1st of October
TermEndDay: Last day
TermEndDayTooltip: Usually 30th of September or 31st of March
TermHolidays: Legal holidays
TermHolidayPlaceholder: Legal holiday
TermHolidayMissing: Holiday is required
TermLectureStart: Lectures start
TermLectureEnd: Lectures end
TermLectureEndTooltip: Summer semesters are usually 14 weeks; winter semesters 15
TermLectureStartTooltip: Must be on or after starting day
TermLectureEndTooltip: Must be before or on ending day
TermActive: Active
NumCourses num: #{num} #{pluralEN num "course" "courses"}
TermsHeading: Semesters

18
models/lms.model
View File

@ -21,13 +21,14 @@ Qualification
-- A: Es kann gleich eine LMS Pin generiert und verschickt werden!
-- - Aufteilung Qualification "R" in zwei Teile: "R e-learning" und "R praxis" okay?
-- Fragen an Know-How:
-- - Bedeutung LMS Übermittlung interner Mitarbeiter?
-- - LmsUser shall submit DELTA only: Beware, GET Request will always return the same; until POST Request was processed!
-- - Success/Failure: is an explicit LMS-delete still necessary?
-- - User: pin reset = 1 to existing pin problematic? Resubmission of existing users with pin causes which problems?
-- - ident unique for all qualifications F/R or duplicated? (F/R refreshers might be simultaneous)
-- - Anzahl Fehlversuche: wird pro Durchfallen ein Failed gemeldet oder nur einmal?
-- Besonderheiten:
-- - LmsIdent muss für alle Qualificationen einzigartig sein!
-- - Durchfallen wird mit UserList ständig erneut gesandt, bis Löschantrag gestellt wurde.
-- - Bestehen mit Result wird nur ein einziges mal gesendet! (Ausfallrisiko: keine Bestätigung der Kommunikation!)
-- - Explizites Löschen eines LmsIdent nach Success/Failure ist notwendig (feedback bei Block)
-- - LmsUser soll nur DELTA übermitteln. (GET Request will always return the same; until POST Request was processed!)
-- - PinReset==1 mit bestehendem Passwort kann problemlos erneut gesendet werden
-- - Flag "interner Mitarbeiter" wird von Know-How ignoriert / nicht ausgewertet (legacy)
QualificationPrecondition
qualification QualificationId -- AND: not unique, ie. qualification can have multiple required preconditions
@ -46,7 +47,7 @@ QualificationEdit
QualificationUser
user UserId
qualification QualificationId OnDeleteCascade OnUpdateCascade
validUntil UTCTime
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
-- temporärer Entzug vorsehen
@ -95,6 +96,7 @@ LmsUser
started UTCTime default=now()
received UTCTime Maybe -- last acknowledgement by LMS
ended UTCTime Maybe -- ident was deleted from LMS
-- Primary ident -- newtype Key LmsUserId = LmsUserKey { unLmsUser :: Text } -- change LmsIdent -> Text. Do we want this?
UniqueLmsUser ident -- idents must be unique accross all qualifications, since idents are global within LMS!
deriving Generic

8
src/Handler/Term.hs
View File

@ -354,11 +354,11 @@ newTermForm mtid template = validateForm validateTerm $ \html -> do
fRequired = False
flip (renderAForm FormStandard) html $ TermForm
<$> tidForm
<*> areq dayField (fslI MsgTermStartDay & setTooltip MsgTermStartDayTooltip) (tftStart template)
<*> areq dayField (fslI MsgTermEndDay & setTooltip MsgTermEndDayTooltip) (tftEnd template)
<*> areq dayField (fslI MsgTermStartDay) (tftStart template)
<*> areq dayField (fslI MsgTermEndDay ) (tftEnd template)
<*> (ungroupHolidays <$> holidayForm (groupHolidays <$> tftHolidays template))
<*> areq dayField (fslI MsgTermLectureStart) (tftLectureStart template)
<*> areq dayField (fslI MsgTermLectureEnd & setTooltip MsgTermLectureEndTooltip) (tftLectureEnd template)
<*> areq dayField (fslI MsgTermLectureStart & setTooltip MsgTermLectureStartTooltip) (tftLectureStart template)
<*> areq dayField (fslI MsgTermLectureEnd & setTooltip MsgTermLectureEndTooltip) (tftLectureEnd template)
<*> activeForm (tftActive template)

6
src/Handler/Utils/DateTime.hs
View File

@ -12,7 +12,7 @@ module Handler.Utils.DateTime
, getTimeLocale, getDateTimeFormat
, getDateTimeFormatter
, validDateTimeFormats, dateTimeFormatOptions
, addLocalDays
, addLocalDays, addDiffDays
, addOneWeek, addWeeks
, weeksToAdd
, setYear, getYear
@ -249,6 +249,10 @@ addLocalDays n utct = localTimeToUTCTZ appTZ newLocal
newDay = addDays n oldDay
newLocal = oldLocal { localDay = newDay }
addDiffDays :: CalendarDiffDays -> UTCTime -> UTCTime
addDiffDays = over _utctDay . addGregorianDurationClip
weeksToAdd :: UTCTime -> UTCTime -> Integer
-- ^ Number of weeks needed to add so that first
-- time occurs later than second time

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

@ -1,7 +1,9 @@
{-# LANGUAGE TypeApplications #-}
module Jobs.Handler.LMS
( dispatchJobLmsResults
( dispatchJobLmsEnqueue
, dispatchJobLmsDequeue
, dispatchJobLmsResults
, dispatchJobLmsUserlist
) where
@ -13,6 +15,47 @@ import qualified Database.Esqueleto.Experimental as E
-- import qualified Database.Esqueleto.PostgreSQL as E -- for insertSelect variant
import qualified Database.Esqueleto.Utils as E
import Handler.Utils.DateTime (addDiffDays)
dispatchJobLmsEnqueue :: QualificationId -> JobHandler UniWorX
dispatchJobLmsEnqueue qid = JobHandlerAtomic act
where
-- act :: YesodJobDB UniWorX ()
act = hoist lift $ do
now <- liftIO getCurrentTime
Just (Entity _ quali) <- E.selectOne $ E.from $ \quali -> E.where_ (quali E.^. QualificationId E.==. E.val qid) >> pure quali
-- Just quali <- get qid
let Just refreshTime = qualificationRefreshWithin quali -- HACK / TODO
freshIdent = LmsIdent "abcd" -- TODO
freshPin = "1234" -- TODO
cutoff = addDiffDays refreshTime now
res <- E.insertSelect $ do
quser <- from (E.table @QualificationUser)
E.where_ ( quser E.^. QualificationUserQualification E.==. E.val qid
E.&&. quser E.^. QualificationUserValidUntil E.>=. E.val now
E.&&. quser E.^. QualificationUserValidUntil E.<=. E.val cutoff
)
-- and not exists already as LMS User
return $ LmsUser
E.<# E.val qid
E.<&> (quser E.^. QualificationUserUser)
E.<&> E.val freshIdent -- ident -- THIS IS A PROBLEM! MUST ALSO BE UNIQUE!
E.<&> E.val freshPin -- pin -- THIS IS A PROBLEM!
E.<&> E.false -- reset
E.<&> E.nothing -- status
E.<&> E.val now -- started
E.<&> E.nothing -- received
E.<&> E.nothing -- ended
-- find qualification holders
error "lms dequeu stub"
dispatchJobLmsDequeue :: QualificationId -> JobHandler UniWorX
dispatchJobLmsDequeue qid =
-- wenn bestanden: qualification verlängern & LmsIdent löschen
-- wenn durchgefallen: LmsIdent löschen
-- wenn Zeit abgelaufen: LmsIdent löschen
error "lms dequeu stub"
dispatchJobLmsResults :: QualificationId -> JobHandler UniWorX
dispatchJobLmsResults qid = JobHandlerAtomic act

2
src/Jobs/Types.hs
View File

@ -105,6 +105,8 @@ data Job
, jEpoch
, jIteration :: Natural
}
| JobLmsEnqueue { jQualification :: QualificationId }
| JobLmsDequeue { jQualification :: QualificationId }
| JobLmsUserlist { jQualification :: QualificationId }
| JobLmsResults { jQualification :: QualificationId }
deriving (Eq, Ord, Show, Read, Generic, Typeable)

6
src/Model/Types/DateTime.hs
View File

@ -71,12 +71,14 @@ shortened = iso shorten expand
-- Handler.Utils.Widget.tidFromText
-- MsgTermPlaceHolder
termToText :: TermIdentifier -> Text
termToText TermIdentifier{..} = Text.pack . show $ year ^. shortened
termToText TermIdentifier{..} = Text.pack . show $ year -- ^. shortened
termFromText :: Text -> Either Text TermIdentifier
termFromText t
| Just (review shortened -> year) <- readMaybe $ Text.unpack t
| Just year <- readMaybe $ Text.unpack t
= Right TermIdentifier {..}
-- | Just (review shortened -> year) <- readMaybe $ Text.unpack t
-- = Right TermIdentifier {..}
| otherwise
= Left $ "Invalid TermIdentifier: “" <> t <> "”; expected is just a year number."

5
test/Model/TypesSpec.hs
View File

@ -46,7 +46,6 @@ import qualified Data.Text.Lazy as LT
import Text.Blaze.Html.Renderer.Text (renderHtml)
import Handler.Utils.DateTime (getYear)
{-
instance Arbitrary Day where
@ -65,7 +64,7 @@ instance CoArbitrary Day where
instance Arbitrary TermIdentifier where
arbitrary = TermIdentifier <$> arbitrary
shrink = fmap TermIdentifier . shrink . getTermDay
shrink = fmap TermIdentifier . shrink . year
instance CoArbitrary TermIdentifier
instance Function TermIdentifier
@ -471,7 +470,7 @@ spec = do
--it "has compatible encoding/decoding to/from PersistValue" . property $
-- \term -> fromPersistValue (toPersistValue term) == term
it "has human readable year encoding to Rational" . property $
\term -> truncate (termToRational term) == getYear (getTermDay term)
\term -> truncate (termToRational term) == year term
describe "Pseudonym" $ do
it "has sufficient vocabulary" $
(length pseudonymWordlist ^ 2) `shouldSatisfy` (> (fromIntegral (maxBound :: Pseudonym) - fromIntegral (minBound :: Pseudonym)))