From 538aa5b3b9f0741e1dba80cd9e2ba70adfce1938 Mon Sep 17 00:00:00 2001
From: Steffen Jost <jost@cip.ifi.lmu.de>
Date: Thu, 30 Sep 2021 09:41:23 +0200
Subject: [PATCH] fix(fill): correct term start day guessing

---
 src/Model/Types/DateTime.hs |  8 ++++----
 test/Database/Fill.hs       | 16 ++++++++--------
 2 files changed, 12 insertions(+), 12 deletions(-)

diff --git a/src/Model/Types/DateTime.hs b/src/Model/Types/DateTime.hs
index d96f71f14..c5f7324a4 100644
--- a/src/Model/Types/DateTime.hs
+++ b/src/Model/Types/DateTime.hs
@@ -167,10 +167,10 @@ guessDay TermIdentifier{ year, season = Q2 } TermDayStart  = fromGregorian year
 guessDay TermIdentifier{ year, season = Q3 } TermDayStart  = fromGregorian year  7  1
 guessDay TermIdentifier{ year, season = Q4 } TermDayStart  = fromGregorian year 10  1
 guessDay tid TermDayEnd = pred $ guessDay (succ tid) TermDayStart
-guessDay tid@TermIdentifier{ year } TermDayLectureStart = fromWeekDate year weekStart 1 -- first Monday within Quarter
-  where (_, weekStart, _) = toWeekDate $ guessDay tid TermDayStart
-guessDay tid@TermIdentifier{ year } TermDayLectureEnd   = fromWeekDate year weekStart 5 -- Friday of last week within Quarter
-  where (_, weekStart, _) = toWeekDate $ guessDay tid TermDayEnd
+guessDay tid TermDayLectureStart = fromWeekDate year weekStart 1 -- first Monday within Quarter
+  where ( year, weekStart, _) = toWeekDate $ guessDay tid TermDayStart
+guessDay tid TermDayLectureEnd   = fromWeekDate year weekStart 5 -- Friday of last week within Quarter
+  where ( year, weekStart, _) = toWeekDate $ guessDay tid TermDayEnd
 
 withinTerm :: Day -> TermIdentifier -> Bool 
 withinTerm d tid = guessDay tid TermDayStart <= d && d <= guessDay tid TermDayEnd
diff --git a/test/Database/Fill.hs b/test/Database/Fill.hs
index 15e5b77dc..ee98f74e2 100644
--- a/test/Database/Fill.hs
+++ b/test/Database/Fill.hs
@@ -66,7 +66,7 @@ fillDb = do
     prevTerm = pred currentTerm
     prevPrevTerm = pred prevTerm
 
-    seasonTerm next wSeason = until (((==) wSeason) . season) prog currentTerm
+    seasonTerm next wSeason = until ((wSeason ==) . season) prog currentTerm
       where prog | next      = succ
                  | otherwise = pred
 
@@ -597,7 +597,7 @@ fillDb = do
         |]
     , courseLinkExternal = Nothing
     , courseShorthand = "F"
-    , courseTerm = TermKey $ currentTerm
+    , courseTerm = TermKey currentTerm
     , courseSchool = avn
     , courseCapacity = Nothing
     , courseVisibleFrom = Just now 
@@ -618,10 +618,10 @@ fillDb = do
   
   forM_ [(Monday)..Thursday] $ \td -> do
     forM_ [(1::Int)..(4*4)] $ \tw -> do
-      let firstTT  = utctDay $ termTime True (season currentTerm) (toRational $ tw - 1) False td (toMorning)
-          secondTT = utctDay $ termTime True (season currentTerm) (toRational $ tw - 1) False (succ td) (toMorning)
+      let firstTT  = utctDay $ termTime True (season currentTerm) (toRational $ tw - 1) False td toMorning
+          secondTT = utctDay $ termTime True (season currentTerm) (toRational $ tw - 1) False (succ td) toMorning
       tut1 <- insert Tutorial
-        { tutorialName = CI.mk $ Text.pack $ "KW" ++ (show $ snd3 $ toWeekDate firstTT) ++ (take 3 $ show td)
+        { tutorialName = CI.mk $ Text.pack $ "KW" ++ show (snd3 $ toWeekDate firstTT) ++ take 3 (show td)
         , tutorialCourse = fdf
         , tutorialType = "Schulung"
         , tutorialCapacity = Just 16
@@ -647,8 +647,8 @@ fillDb = do
               ]              
           }
         , tutorialRegGroup = Just "schulung"
-        , tutorialRegisterFrom = Just $ termTime True (season currentTerm) (toRational $ tw - 9) False td (toMorning)
-        , tutorialRegisterTo   = Just $ termTime True (season currentTerm) (toRational $ tw - 2) False td (toMorning)
+        , tutorialRegisterFrom = Just $ termTime True (season currentTerm) (toRational $ tw - 9) False td toMorning
+        , tutorialRegisterTo   = Just $ termTime True (season currentTerm) (toRational $ tw - 2) False td toMorning
         , tutorialDeregisterUntil = Nothing
         , tutorialLastChanged = now
         , tutorialTutorControlled = True
@@ -951,7 +951,7 @@ fillDb = do
                , let uploadEmptyOk = False
                ]
 
-      sheetCombinations = ((,,) <$> shTypes <*> shGroupings <*> shSubModes)
+      sheetCombinations = (,,) <$> shTypes <*> shGroupings <*> shSubModes
 
   forM_ (zip [0..] sheetCombinations) $ \(shNr, (sheetType, sheetGrouping, sheetSubmissionMode)) -> do
     MsgRenderer mr <- getMsgRenderer