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

chore(testdata): terms changes to yearly quarters working now

Browse Source
This commit is contained in:
Steffen Jost 2021-09-23 18:00:13 +02:00
parent aeafe3118b
commit bcbaad0da8
2 changed files with 75 additions and 116 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

185
test/Database/Fill.hs
View File

@ -12,7 +12,7 @@ import qualified Data.Text as Text
import qualified Data.Set as Set import qualified Data.Set as Set
import qualified Data.Map as Map import qualified Data.Map as Map
import Data.Time.Calendar.OrdinalDate -- import Data.Time.Calendar.OrdinalDate
import Data.Time.Calendar.WeekDate import Data.Time.Calendar.WeekDate
import Control.Applicative (ZipList(..)) import Control.Applicative (ZipList(..))
@ -57,48 +57,31 @@ fillDb = do
(currentYear, currentMonth, _) = toGregorian $ utctDay now (currentYear, currentMonth, _) = toGregorian $ utctDay now
currentTerm currentTerm
| 4 <= currentMonth | 3 <= currentMonth = TermIdentifier currentYear Q1
, currentMonth <= 9 | 6 <= currentMonth = TermIdentifier currentYear Q2
= TermIdentifier currentYear Summer | 9 <= currentMonth = TermIdentifier currentYear Q3
| otherwise | otherwise = TermIdentifier currentYear Q4
= TermIdentifier (pred currentYear) Winter
nextTerm = succ currentTerm nextTerm = succ currentTerm
prevTerm = pred currentTerm prevTerm = pred currentTerm
prevPrevTerm = pred prevTerm prevPrevTerm = pred prevTerm
seasonTerm next wSeason seasonTerm next wSeason = until (((==) wSeason) . season) prog currentTerm
| wSeason == season currentTerm where prog | next = succ
, next = currentTerm | otherwise = pred
| wSeason == season currentTerm
= prevPrevTerm
| next
= nextTerm
| otherwise
= prevTerm
termTime :: Bool -- ^ Next term? termTime :: Bool -- ^ Next term?
-> Season -> Season
-> Rational -> Rational
-> Bool -- ^ Relative to end of semester? -> Bool -- ^ Relative to end of semester?
-> WeekDay -> WeekDay
-> (Day -> UTCTime) -> (Day -> UTCTime) -- ^ Add time to day
-> UTCTime -> UTCTime
termTime next gSeason weekOffset fromEnd d = ($ utctDay) termTime next gSeason weekOffset fromEnd d = ($ utctDay)
where where
utctDay = fromWeekDate wYear wWeek $ fromEnum d utctDay = fromWeekDate wYear wWeek $ fromEnum d
(wYear, wWeek, _) = toWeekDate . addDays (round $ 7 * weekOffset) $ fromGregorian gYear rMonth rDay (wYear, wWeek, _) = toWeekDate . addDays (round $ 7 * weekOffset) $ fromGregorian rYear rMonth rDay
gYear = year $ seasonTerm next gSeason gTid = seasonTerm next gSeason
(rMonth, rDay) (rYear, rMonth, rDay) = toGregorian $ guessDay gTid $ bool TermDayLectureStart TermDayLectureEnd fromEnd
| Winter <- gSeason
, True <- fromEnd
= (03, 31)
| Winter <- gSeason
, False <- fromEnd
= (10, 01)
| True <- fromEnd
= (09, 30)
| otherwise
= (04, 01)
gkleen <- insert User gkleen <- insert User
{ userIdent = "G.Kleen@campus.lmu.de" { userIdent = "G.Kleen@campus.lmu.de"
@ -369,42 +352,18 @@ fillDb = do
Nothing -> repack [st|#{firstName}.#{userSurname}@example.invalid|] Nothing -> repack [st|#{firstName}.#{userSurname}@example.invalid|]
matrikel <- toMatrikel <$> getRandomRs (0 :: Int, 9 :: Int) matrikel <- toMatrikel <$> getRandomRs (0 :: Int, 9 :: Int)
manyUsers <- insertMany . getZipList $ manyUser <$> ZipList ((,,) <$> firstNames <*> middlenames <*> surnames) <*> ZipList matrikel manyUsers <- insertMany . getZipList $ manyUser <$> ZipList ((,,) <$> firstNames <*> middlenames <*> surnames) <*> ZipList matrikel
forM_ [prevPrevTerm, prevTerm, currentTerm, nextTerm, succ nextTerm] $ \tid -> do
let term = Term { termName = tid
, termStart = guessDay tid TermDayStart
, termEnd = guessDay tid TermDayEnd
, termHolidays = []
, termLectureStart = guessDay tid TermDayLectureStart
, termLectureEnd = guessDay tid TermDayLectureEnd
}
void $ repsert (TermKey tid) term
void . insert_ $ TermActive (TermKey tid) (toMidnight $ addDays (-60) $ termStart term) (Just . beforeMidnight $ addDays 60 $ termEnd term) Nothing
forM_ [prevPrevTerm, prevTerm, currentTerm, nextTerm] $ \term@TermIdentifier{..} -> case season of
Summer -> do
let (wYearStart, wWeekStart, _) = toWeekDate $ fromGregorian year 04 01
termLectureStart = fromWeekDate wYearStart (wWeekStart + 2) 1
termLectureEnd = fromWeekDate wYearStart (wWeekStart + 16) 5
termStart = fromGregorian year 04 01
termEnd = fromGregorian year 09 30
void . repsert (TermKey term) $ Term
{ termName = term
, termStart
, termEnd
, termHolidays = []
, termLectureStart
, termLectureEnd
}
void . insert_ $ TermActive (TermKey term) (toMidnight $ addDays (-60) termStart) (Just . beforeMidnight $ addDays 60 termEnd) Nothing
Winter -> do
let (wYearStart, wWeekStart, _) = toWeekDate $ fromGregorian year 10 01
termLectureStart = fromWeekDate wYearStart (wWeekStart + 2) 1
(fromIntegral -> wYearOffset, wWeekEnd) = (wWeekStart + 18) `divMod` bool 53 54 longYear
termLectureEnd = fromWeekDate (wYearStart + wYearOffset) (bool id succ (wYearOffset /= 0) wWeekEnd) 5
longYear = case toWeekDate $ fromOrdinalDate wYearStart 365 of
(_, 53, _) -> True
_other -> False
termStart = fromGregorian year 10 01
termEnd = fromGregorian (succ year) 03 31
void . repsert (TermKey term) $ Term
{ termName = term
, termStart
, termEnd
, termHolidays = []
, termLectureStart
, termLectureEnd
}
void . insert_ $ TermActive (TermKey term) (toMidnight $ addDays (-60) termStart) (Just . beforeMidnight $ addDays 60 termEnd) Nothing
ifiAuthorshipStatement <- insertAuthorshipStatement I18n ifiAuthorshipStatement <- insertAuthorshipStatement I18n
{ i18nFallback = htmlToStoredMarkup { i18nFallback = htmlToStoredMarkup
[shamlet| [shamlet|
@ -616,7 +575,7 @@ fillDb = do
now now
True True
Nothing Nothing
-- FFP -- FFP
let nbrs :: [Int] let nbrs :: [Int]
nbrs = [1,2,3,27,7,1] nbrs = [1,2,3,27,7,1]
@ -636,13 +595,13 @@ fillDb = do
|] |]
, courseLinkExternal = Nothing , courseLinkExternal = Nothing
, courseShorthand = "FFP" , courseShorthand = "FFP"
, courseTerm = TermKey $ seasonTerm True Summer , courseTerm = TermKey $ seasonTerm True Q1
, courseSchool = ifi , courseSchool = ifi
, courseCapacity = Just 20 , courseCapacity = Just 20
, courseVisibleFrom = Just now , courseVisibleFrom = Just now
, courseVisibleTo = Nothing , courseVisibleTo = Nothing
, courseRegisterFrom = Just $ termTime True Summer (-2) False Monday toMidnight , courseRegisterFrom = Just $ termTime True Q1 (-2) False Monday toMidnight
, courseRegisterTo = Just $ termTime True Summer 0 True Sunday beforeMidnight , courseRegisterTo = Just $ termTime True Q1 0 True Sunday beforeMidnight
, courseDeregisterUntil = Nothing , courseDeregisterUntil = Nothing
, courseRegisterSecret = Nothing , courseRegisterSecret = Nothing
, courseMaterialFree = True , courseMaterialFree = True
@ -665,9 +624,9 @@ fillDb = do
, sheetType = NotGraded , sheetType = NotGraded
, sheetGrouping = Arbitrary 3 , sheetGrouping = Arbitrary 3
, sheetMarkingText = Nothing , sheetMarkingText = Nothing
, sheetVisibleFrom = Just $ termTime True Summer 0 False Monday toMidnight , sheetVisibleFrom = Just $ termTime True Q1 0 False Monday toMidnight
, sheetActiveFrom = Just $ termTime True Summer 1 False Monday toMidnight , sheetActiveFrom = Just $ termTime True Q1 1 False Monday toMidnight
, sheetActiveTo = Just $ termTime True Summer 2 False Sunday beforeMidnight , sheetActiveTo = Just $ termTime True Q1 2 False Sunday beforeMidnight
, sheetSubmissionMode = SubmissionMode False . Just $ UploadAny True Nothing False , sheetSubmissionMode = SubmissionMode False . Just $ UploadAny True Nothing False
, sheetHintFrom = Nothing , sheetHintFrom = Nothing
, sheetSolutionFrom = Nothing , sheetSolutionFrom = Nothing
@ -687,9 +646,9 @@ fillDb = do
, sheetType = NotGraded , sheetType = NotGraded
, sheetGrouping = RegisteredGroups , sheetGrouping = RegisteredGroups
, sheetMarkingText = Nothing , sheetMarkingText = Nothing
, sheetVisibleFrom = Just $ termTime True Summer 1 False Monday toMidnight , sheetVisibleFrom = Just $ termTime True Q1 1 False Monday toMidnight
, sheetActiveFrom = Just $ termTime True Summer 2 False Monday toMidnight , sheetActiveFrom = Just $ termTime True Q1 2 False Monday toMidnight
, sheetActiveTo = Just $ termTime True Summer 3 False Sunday beforeMidnight , sheetActiveTo = Just $ termTime True Q1 3 False Sunday beforeMidnight
, sheetSubmissionMode = SubmissionMode False . Just $ UploadAny True Nothing False , sheetSubmissionMode = SubmissionMode False . Just $ UploadAny True Nothing False
, sheetHintFrom = Nothing , sheetHintFrom = Nothing
, sheetSolutionFrom = Nothing , sheetSolutionFrom = Nothing
@ -709,9 +668,9 @@ fillDb = do
, sheetType = NotGraded , sheetType = NotGraded
, sheetGrouping = NoGroups , sheetGrouping = NoGroups
, sheetMarkingText = Nothing , sheetMarkingText = Nothing
, sheetVisibleFrom = Just $ termTime True Summer 2 False Monday toMidnight , sheetVisibleFrom = Just $ termTime True Q1 2 False Monday toMidnight
, sheetActiveFrom = Just $ termTime True Summer 3 False Monday toMidnight , sheetActiveFrom = Just $ termTime True Q1 3 False Monday toMidnight
, sheetActiveTo = Just $ termTime True Summer 4 False Sunday beforeMidnight , sheetActiveTo = Just $ termTime True Q1 4 False Sunday beforeMidnight
, sheetSubmissionMode = SubmissionMode False . Just $ UploadAny True Nothing False , sheetSubmissionMode = SubmissionMode False . Just $ UploadAny True Nothing False
, sheetHintFrom = Nothing , sheetHintFrom = Nothing
, sheetSolutionFrom = Nothing , sheetSolutionFrom = Nothing
@ -737,15 +696,15 @@ fillDb = do
, examBonusRule = Nothing , examBonusRule = Nothing
, examOccurrenceRule = ExamRoomManual , examOccurrenceRule = ExamRoomManual
, examExamOccurrenceMapping = Nothing , examExamOccurrenceMapping = Nothing
, examVisibleFrom = Just $ termTime True Summer (-4) True Monday toMidnight , examVisibleFrom = Just $ termTime True Q1 (-4) True Monday toMidnight
, examRegisterFrom = Just $ termTime True Summer (-4) True Monday toMidnight , examRegisterFrom = Just $ termTime True Q1 (-4) True Monday toMidnight
, examRegisterTo = Just $ termTime True Summer 1 True Sunday beforeMidnight , examRegisterTo = Just $ termTime True Q1 1 True Sunday beforeMidnight
, examDeregisterUntil = Just $ termTime True Summer 2 True Wednesday beforeMidnight , examDeregisterUntil = Just $ termTime True Q1 2 True Wednesday beforeMidnight
, examPublishOccurrenceAssignments = Just $ termTime True Summer 3 True Monday toMidnight , examPublishOccurrenceAssignments = Just $ termTime True Q1 3 True Monday toMidnight
, examStart = Just $ termTime True Summer 3 True Tuesday (toTimeOfDay 10 0 0) , examStart = Just $ termTime True Q1 3 True Tuesday (toTimeOfDay 10 0 0)
, examEnd = Just $ termTime True Summer 3 True Tuesday (toTimeOfDay 12 0 0) , examEnd = Just $ termTime True Q1 3 True Tuesday (toTimeOfDay 12 0 0)
, examFinished = Just $ termTime True Summer 3 True Wednesday (toTimeOfDay 22 0 0) , examFinished = Just $ termTime True Q1 3 True Wednesday (toTimeOfDay 22 0 0)
, examPartsFrom = Just $ termTime True Summer (-4) True Monday toMidnight , examPartsFrom = Just $ termTime True Q1 (-4) True Monday toMidnight
, examClosed = Nothing , examClosed = Nothing
, examPublicStatistics = True , examPublicStatistics = True
, examGradingMode = ExamGradingGrades , examGradingMode = ExamGradingGrades
@ -789,12 +748,12 @@ fillDb = do
, courseDescription = Nothing , courseDescription = Nothing
, courseLinkExternal = Nothing , courseLinkExternal = Nothing
, courseShorthand = "EIP" , courseShorthand = "EIP"
, courseTerm = TermKey $ seasonTerm False Winter , courseTerm = TermKey $ seasonTerm False Q4
, courseSchool = ifi , courseSchool = ifi
, courseCapacity = Just 20 , courseCapacity = Just 20
, courseVisibleFrom = Just now , courseVisibleFrom = Just now
, courseVisibleTo = Nothing , courseVisibleTo = Nothing
, courseRegisterFrom = Just $ termTime False Winter (-4) False Monday toMidnight , courseRegisterFrom = Just $ termTime False Q4 (-4) False Monday toMidnight
, courseRegisterTo = Nothing , courseRegisterTo = Nothing
, courseDeregisterUntil = Nothing , courseDeregisterUntil = Nothing
, courseRegisterSecret = Nothing , courseRegisterSecret = Nothing
@ -815,13 +774,13 @@ fillDb = do
, courseDescription = Nothing , courseDescription = Nothing
, courseLinkExternal = Nothing , courseLinkExternal = Nothing
, courseShorthand = "IXD" , courseShorthand = "IXD"
, courseTerm = TermKey $ seasonTerm True Summer , courseTerm = TermKey $ seasonTerm True Q1
, courseSchool = ifi , courseSchool = ifi
, courseCapacity = Just 20 , courseCapacity = Just 20
, courseVisibleFrom = Just now , courseVisibleFrom = Just now
, courseVisibleTo = Nothing , courseVisibleTo = Nothing
, courseRegisterFrom = Just $ termTime True Summer 0 False Monday toMidnight , courseRegisterFrom = Just $ termTime True Q1 0 False Monday toMidnight
, courseRegisterTo = Just $ termTime True Summer (-2) True Sunday beforeMidnight , courseRegisterTo = Just $ termTime True Q1 (-2) True Sunday beforeMidnight
, courseDeregisterUntil = Nothing , courseDeregisterUntil = Nothing
, courseRegisterSecret = Nothing , courseRegisterSecret = Nothing
, courseMaterialFree = True , courseMaterialFree = True
@ -841,7 +800,7 @@ fillDb = do
, courseDescription = Nothing , courseDescription = Nothing
, courseLinkExternal = Nothing , courseLinkExternal = Nothing
, courseShorthand = "UX3" , courseShorthand = "UX3"
, courseTerm = TermKey $ seasonTerm True Winter , courseTerm = TermKey $ seasonTerm True Q4
, courseSchool = ifi , courseSchool = ifi
, courseCapacity = Just 30 , courseCapacity = Just 30
, courseVisibleFrom = Just now , courseVisibleFrom = Just now
@ -867,12 +826,12 @@ fillDb = do
, courseDescription = Nothing , courseDescription = Nothing
, courseLinkExternal = Nothing , courseLinkExternal = Nothing
, courseShorthand = "ProMo" , courseShorthand = "ProMo"
, courseTerm = TermKey $ seasonTerm True Summer , courseTerm = TermKey $ seasonTerm True Q1
, courseSchool = ifi , courseSchool = ifi
, courseCapacity = Just 50 , courseCapacity = Just 50
, courseVisibleFrom = Just now , courseVisibleFrom = Just now
, courseVisibleTo = Nothing , courseVisibleTo = Nothing
, courseRegisterFrom = Just $ termTime True Summer (-2) False Monday toMidnight , courseRegisterFrom = Just $ termTime True Q1 (-2) False Monday toMidnight
, courseRegisterTo = Nothing , courseRegisterTo = Nothing
, courseDeregisterUntil = Nothing , courseDeregisterUntil = Nothing
, courseRegisterSecret = Nothing , courseRegisterSecret = Nothing
@ -958,11 +917,11 @@ fillDb = do
, sheetDescription = Nothing , sheetDescription = Nothing
, sheetType, sheetGrouping, sheetSubmissionMode , sheetType, sheetGrouping, sheetSubmissionMode
, sheetMarkingText = Nothing , sheetMarkingText = Nothing
, sheetVisibleFrom = Just $ termTime True Summer prog False Monday toMidnight , sheetVisibleFrom = Just $ termTime True Q1 prog False Monday toMidnight
, sheetActiveFrom = Just $ termTime True Summer (prog + 1) False Monday toMidnight , sheetActiveFrom = Just $ termTime True Q1 (prog + 1) False Monday toMidnight
, sheetActiveTo = Just $ termTime True Summer (prog + 2) False Sunday beforeMidnight , sheetActiveTo = Just $ termTime True Q1 (prog + 2) False Sunday beforeMidnight
, sheetHintFrom = Just $ termTime True Summer (prog + 1) False Sunday beforeMidnight , sheetHintFrom = Just $ termTime True Q1 (prog + 1) False Sunday beforeMidnight
, sheetSolutionFrom = Just $ termTime True Summer (prog + 2) False Sunday beforeMidnight , sheetSolutionFrom = Just $ termTime True Q1 (prog + 2) False Sunday beforeMidnight
, sheetAutoDistribute = True , sheetAutoDistribute = True
, sheetAnonymousCorrection = True , sheetAnonymousCorrection = True
, sheetRequireExamRegistration = Nothing , sheetRequireExamRegistration = Nothing
@ -1007,7 +966,7 @@ fillDb = do
, occurrencesExceptions = Set.empty , occurrencesExceptions = Set.empty
} }
, tutorialRegGroup = Just "tutorium" , tutorialRegGroup = Just "tutorium"
, tutorialRegisterFrom = Just $ termTime True Summer 0 False Monday toMidnight , tutorialRegisterFrom = Just $ termTime True Q1 0 False Monday toMidnight
, tutorialRegisterTo = Nothing , tutorialRegisterTo = Nothing
, tutorialDeregisterUntil = Nothing , tutorialDeregisterUntil = Nothing
, tutorialLastChanged = now , tutorialLastChanged = now
@ -1027,7 +986,7 @@ fillDb = do
, occurrencesExceptions = Set.empty , occurrencesExceptions = Set.empty
} }
, tutorialRegGroup = Just "tutorium" , tutorialRegGroup = Just "tutorium"
, tutorialRegisterFrom = Just $ termTime True Summer 0 False Monday toMidnight , tutorialRegisterFrom = Just $ termTime True Q1 0 False Monday toMidnight
, tutorialRegisterTo = Nothing , tutorialRegisterTo = Nothing
, tutorialDeregisterUntil = Nothing , tutorialDeregisterUntil = Nothing
, tutorialLastChanged = now , tutorialLastChanged = now
@ -1040,7 +999,7 @@ fillDb = do
, courseDescription = Just "Datenbanken banken Daten damit die Daten nicht wanken. Die Datenschützer danken!" , courseDescription = Just "Datenbanken banken Daten damit die Daten nicht wanken. Die Datenschützer danken!"
, courseLinkExternal = Nothing , courseLinkExternal = Nothing
, courseShorthand = "DBS" , courseShorthand = "DBS"
, courseTerm = TermKey $ seasonTerm False Winter , courseTerm = TermKey $ seasonTerm False Q4
, courseSchool = ifi , courseSchool = ifi
, courseCapacity = Just 50 , courseCapacity = Just 50
, courseVisibleFrom = Just now , courseVisibleFrom = Just now
@ -1062,7 +1021,7 @@ fillDb = do
void . insert' $ DegreeCourse dbs sdBsc sdMath void . insert' $ DegreeCourse dbs sdBsc sdMath
void . insert' $ Lecturer gkleen dbs CourseLecturer void . insert' $ Lecturer gkleen dbs CourseLecturer
void . insert' $ Lecturer jost dbs CourseAssistant void . insert' $ Lecturer jost dbs CourseAssistant
testMsg <- insert SystemMessage testMsg <- insert SystemMessage
{ systemMessageNewsOnly = False { systemMessageNewsOnly = False
, systemMessageFrom = Just now , systemMessageFrom = Just now
@ -1140,7 +1099,7 @@ fillDb = do
funAlloc <- insert' Allocation funAlloc <- insert' Allocation
{ allocationName = "Funktionale Zentralanmeldung" { allocationName = "Funktionale Zentralanmeldung"
, allocationShorthand = "fun" , allocationShorthand = "fun"
, allocationTerm = TermKey $ seasonTerm True Summer , allocationTerm = TermKey currentTerm
, allocationSchool = ifi , allocationSchool = ifi
, allocationLegacyShorthands = [] , allocationLegacyShorthands = []
, allocationDescription = Nothing , allocationDescription = Nothing
@ -1154,7 +1113,7 @@ fillDb = do
, allocationRegisterByStaffFrom = Nothing , allocationRegisterByStaffFrom = Nothing
, allocationRegisterByStaffTo = Nothing , allocationRegisterByStaffTo = Nothing
, allocationRegisterByCourse = Nothing , allocationRegisterByCourse = Nothing
, allocationOverrideDeregister = Just $ termTime True Summer 1 False Monday toMidnight , allocationOverrideDeregister = Just $ termTime True Q1 1 False Monday toMidnight
, allocationMatchingSeed = aSeedFunc , allocationMatchingSeed = aSeedFunc
} }
insert_ $ AllocationCourse funAlloc pmo 100 Nothing Nothing insert_ $ AllocationCourse funAlloc pmo 100 Nothing Nothing
@ -1173,7 +1132,7 @@ fillDb = do
, courseDescription = Nothing , courseDescription = Nothing
, courseLinkExternal = Nothing , courseLinkExternal = Nothing
, courseShorthand = "BS" , courseShorthand = "BS"
, courseTerm = TermKey $ seasonTerm False Winter , courseTerm = TermKey $ seasonTerm False Q4
, courseSchool = ifi , courseSchool = ifi
, courseCapacity = Just 50 , courseCapacity = Just 50
, courseVisibleFrom = Just now , courseVisibleFrom = Just now
@ -1203,9 +1162,9 @@ fillDb = do
, sheetType = Normal $ PassPoints 12 6 , sheetType = Normal $ PassPoints 12 6
, sheetGrouping = Arbitrary 3 , sheetGrouping = Arbitrary 3
, sheetMarkingText = Nothing , sheetMarkingText = Nothing
, sheetVisibleFrom = Just $ termTime False Winter (fromInteger shNr) False Monday toMidnight , sheetVisibleFrom = Just $ termTime False Q4 (fromInteger shNr) False Monday toMidnight
, sheetActiveFrom = Just $ termTime False Winter (fromInteger $ succ shNr) False Monday toMidnight , sheetActiveFrom = Just $ termTime False Q4 (fromInteger $ succ shNr) False Monday toMidnight
, sheetActiveTo = Just $ termTime False Winter (fromInteger $ succ shNr) False Sunday beforeMidnight , sheetActiveTo = Just $ termTime False Q4 (fromInteger $ succ shNr) False Sunday beforeMidnight
, sheetSubmissionMode = SubmissionMode False . Just $ UploadAny True Nothing False , sheetSubmissionMode = SubmissionMode False . Just $ UploadAny True Nothing False
, sheetHintFrom = Nothing , sheetHintFrom = Nothing
, sheetSolutionFrom = Nothing , sheetSolutionFrom = Nothing
@ -1249,7 +1208,7 @@ fillDb = do
, courseDescription = Nothing , courseDescription = Nothing
, courseLinkExternal = Nothing , courseLinkExternal = Nothing
, courseShorthand = CI.mk csh , courseShorthand = CI.mk csh
, courseTerm = TermKey $ seasonTerm False Winter , courseTerm = TermKey $ seasonTerm False Q4
, courseSchool = ifi , courseSchool = ifi
, courseCapacity = Just 50 , courseCapacity = Just 50
, courseVisibleFrom = Just now , courseVisibleFrom = Just now
@ -1278,7 +1237,7 @@ fillDb = do
bigAlloc <- insert' Allocation bigAlloc <- insert' Allocation
{ allocationName = "Große Zentralanmeldung" { allocationName = "Große Zentralanmeldung"
, allocationShorthand = "big" , allocationShorthand = "big"
, allocationTerm = TermKey $ seasonTerm True Summer , allocationTerm = TermKey $ seasonTerm True Q1
, allocationSchool = ifi , allocationSchool = ifi
, allocationLegacyShorthands = [] , allocationLegacyShorthands = []
, allocationDescription = Nothing , allocationDescription = Nothing
@ -1292,7 +1251,7 @@ fillDb = do
, allocationRegisterByStaffFrom = Nothing , allocationRegisterByStaffFrom = Nothing
, allocationRegisterByStaffTo = Nothing , allocationRegisterByStaffTo = Nothing
, allocationRegisterByCourse = Nothing , allocationRegisterByCourse = Nothing
, allocationOverrideDeregister = Just $ termTime True Summer 1 False Monday toMidnight , allocationOverrideDeregister = Just $ termTime True Q1 1 False Monday toMidnight
, allocationMatchingSeed = aSeedBig , allocationMatchingSeed = aSeedBig
} }
bigAllocShorthands <- bigAllocShorthands <-
@ -1311,7 +1270,7 @@ fillDb = do
, courseDescription = Nothing , courseDescription = Nothing
, courseLinkExternal = Nothing , courseLinkExternal = Nothing
, courseShorthand = CI.mk csh , courseShorthand = CI.mk csh
, courseTerm = TermKey $ seasonTerm False Winter , courseTerm = TermKey $ seasonTerm False Q4
, courseSchool = ifi , courseSchool = ifi
, courseCapacity = Just cap , courseCapacity = Just cap
, courseVisibleFrom = Just now , courseVisibleFrom = Just now

6
test/Model/TypesSpec.hs
View File

@ -462,9 +462,9 @@ spec = do
it "has compatible encoding/decoding to/from Text" . property $ it "has compatible encoding/decoding to/from Text" . property $
\term -> termFromText (termToText term) == Right term \term -> termFromText (termToText term) == Right term
it "works for some examples" . mapM_ termExample $ it "works for some examples" . mapM_ termExample $
[ (TermIdentifier 2017 Summer, "S17") [ (TermIdentifier 2017 Q2, "17Q2")
, (TermIdentifier 1995 Winter, "W95") , (TermIdentifier 1995 Q4, "95Q4")
, (TermIdentifier 3068 Winter, "W3068") , (TermIdentifier 3068 Q1, "3068Q1")
] ]
it "has compatbile encoding/decoding to/from Rational" . property $ it "has compatbile encoding/decoding to/from Rational" . property $
\term -> termFromRational (termToRational term) == term \term -> termFromRational (termToRational term) == term