From b982e59b630fbdb3fe8f37c979de8e8726b78ea9 Mon Sep 17 00:00:00 2001
From: Steffen Jost <S.Jost@Fraport.de>
Date: Fri, 2 Jun 2023 11:50:50 +0000
Subject: [PATCH] fix(tutorial): template moving works now

---
 src/Handler/Course/ParticipantInvite.hs |  3 ++-
 src/Handler/Utils/Occurrences.hs        | 14 +++++++-------
 test/Database/Fill.hs                   |  9 +++++++--
 3 files changed, 16 insertions(+), 10 deletions(-)

diff --git a/src/Handler/Course/ParticipantInvite.hs b/src/Handler/Course/ParticipantInvite.hs
index d1b53069a..2c079fdbd 100644
--- a/src/Handler/Course/ParticipantInvite.hs
+++ b/src/Handler/Course/ParticipantInvite.hs
@@ -32,6 +32,7 @@ import Generics.Deriving.Monoid (memptydefault, mappenddefault)
 import qualified Database.Esqueleto.Experimental as E -- needs TypeApplications Lang-Pragma
 import qualified Database.Esqueleto.Utils        as E
 
+import Utils.Occurrences
 
 
 type UserSearchKey = Text
@@ -316,7 +317,7 @@ upsertNewTutorial cid newTutorialName newTutorialType newFirstDay = runDB $ do
       Course{..} <- get404 cid
       term <- get404 courseTerm
       let oldFirstDay = fromMaybe moveDay $ tutorialFirstDay <|> fst (occurrencesBounds term tutorialTime)
-          newTime     = occurrencesAddBusinessDays term (oldFirstDay, moveDay) tutorialTime          
+          newTime     = normalizeOccurrences $ occurrencesAddBusinessDays term (oldFirstDay, moveDay) tutorialTime          
           dayDiff   = maybe 0 (diffDays moveDay) tutorialFirstDay
           mvTime    = fmap $ addLocalDays dayDiff
           newType0  = CI.mk . snd . Text.breakOnEnd tutorialTypeSeparator $ CI.original tutorialType
diff --git a/src/Handler/Utils/Occurrences.hs b/src/Handler/Utils/Occurrences.hs
index 2d3aa97e2..984a4b7a2 100644
--- a/src/Handler/Utils/Occurrences.hs
+++ b/src/Handler/Utils/Occurrences.hs
@@ -51,8 +51,8 @@ occurrencesBounds Term{..} Occurrences{..} = (Set.lookupMin occDays, Set.lookupM
     getOccDays :: OccurrenceSchedule -> Set Day -> Set Day
     getOccDays ScheduleWeekly{scheduleDayOfWeek=wday} = Set.union $ daysOfWeekBetween (termLectureStart,termLectureEnd) wday
 
-occurrencesAddBusinessDays :: Term -> (Day,Day) -> Occurrences -> (Occurrences,_)
-occurrencesAddBusinessDays Term{..} (dayOld, dayNew) Occurrences{..} = (Occurrences newSchedule newExceptions,(dayDiff, offDays,loff,dgb))
+occurrencesAddBusinessDays :: Term -> (Day,Day) -> Occurrences -> Occurrences
+occurrencesAddBusinessDays Term{..} (dayOld, dayNew) Occurrences{..} = Occurrences newSchedule newExceptions
   where
     newSchedule = Set.map switchDayOfWeek occurrencesScheduled
     dayDiff = diffDays dayNew dayOld
@@ -64,16 +64,16 @@ occurrencesAddBusinessDays Term{..} (dayOld, dayNew) Occurrences{..} = (Occurren
     switchDayOfWeek os | 0 == dayDiff `mod` 7 = os
     switchDayOfWeek os@ScheduleWeekly{scheduleDayOfWeek=wday} = os{scheduleDayOfWeek= toEnum (fromIntegral dayDiff + fromEnum wday)}
 
-    (loff,newExceptions,dgb) = Set.foldl (flip advanceExceptions) (dayDiff,mempty,mempty) occurrencesExceptions
+    newExceptions = snd $ Set.foldl' advanceExceptions (dayDiff,mempty) occurrencesExceptions
 
     -- we assume that instance Ord OccurrenceException is ordered chronologically
-    advanceExceptions :: OccurrenceException -> (Integer, Set OccurrenceException,_) -> (Integer, Set OccurrenceException,_)
-    advanceExceptions ex (offset, acc, dbg) 
+    advanceExceptions :: (Integer, Set OccurrenceException) -> OccurrenceException -> (Integer, Set OccurrenceException)
+    advanceExceptions (offset, acc) ex
         | ed `Set.notMember` offDays   -- skip term-holidays and weekends, unless the original day was a holiday or weekend
         , nd `Set.member`    offDays
-          = advanceExceptions ex (succ offset, acc, ("skip"<>show offset) :dbg)
+          = advanceExceptions (succ offset, acc) ex
         | otherwise
-          = (offset, Set.insert (setDayOfOccurrenceException nd ex) acc, show ex : dbg)
+          = (offset, Set.insert (setDayOfOccurrenceException nd ex) acc)
       where 
         ed = dayOfOccurrenceException ex
         nd = addDays offset ed
diff --git a/test/Database/Fill.hs b/test/Database/Fill.hs
index 8b91824f0..147edec6f 100644
--- a/test/Database/Fill.hs
+++ b/test/Database/Fill.hs
@@ -1027,7 +1027,7 @@ fillDb = do
         insert_ Tutorial
           { tutorialName = mkName "Vorlage"
           , tutorialCourse = c
-          , tutorialType = "Vorlage___Schulung"
+          , tutorialType = "Vorlage"
           , tutorialCapacity = capacity
           , tutorialRoom = Just $ case weekDay of
                 Monday -> "A380"
@@ -1045,10 +1045,15 @@ fillDb = do
                     , exceptEnd   = TimeOfDay 16  0  0
                     }
                 , ExceptOccur
-                    { exceptDay   = secondDay
+                    { exceptDay   = succ firstDay
                     , exceptStart = TimeOfDay  9  0  0
                     , exceptEnd   = TimeOfDay 16  0  0
                     }
+                , ExceptOccur
+                    { exceptDay   = secondDay
+                    , exceptStart = TimeOfDay 10  12  0
+                    , exceptEnd   = TimeOfDay 12  13  0
+                    }
                 ]
             }
           , tutorialRegGroup        = Just "schulung"