From e4ba4414c67fd22e423d9344029cc98d2d373937 Mon Sep 17 00:00:00 2001
From: Sarah Vaupel <sarah.vaupel@ifi.lmu.de>
Date: Thu, 6 May 2021 14:35:34 +0200
Subject: [PATCH] refactor(schedule): move SlotAssociation, move weekDays

---
 src/Utils/Schedule/Week.hs                 | 44 +++++-----------------
 src/Utils/Schedule/Week/SlotAssociation.hs | 34 +++++++++++++++++
 2 files changed, 43 insertions(+), 35 deletions(-)
 create mode 100644 src/Utils/Schedule/Week/SlotAssociation.hs

diff --git a/src/Utils/Schedule/Week.hs b/src/Utils/Schedule/Week.hs
index 3b9538fec..8da02ba5b 100644
--- a/src/Utils/Schedule/Week.hs
+++ b/src/Utils/Schedule/Week.hs
@@ -16,36 +16,10 @@ import Handler.Utils.Widgets (roomReferenceWidget)
 
 import Utils.Schedule
 import Utils.Schedule.Types
+import Utils.Schedule.Week.SlotAssociation
 import Utils.Schedule.Week.TimeSlot
 
 
-data SlotAssociation
-  = SlotIntersects -- ^ Slot is true subset of event
-  | SlotEnds       -- ^ Event ends in slot, but does not begin within
-  | SlotBegins     -- ^ Event begins in slot, but does not end within
-  | SlotContained  -- ^ Event starts and ends within slot
-  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
-  deriving anyclass (Universe, Finite)
-nullaryPathPiece ''SlotAssociation $ camelToPathPiece' 1
-
-_SlotAssociation :: Iso' SlotAssociation (Bool, Bool)
-_SlotAssociation = iso toBools fromBools
-  where
-    toBools = \case
-      SlotIntersects -> (False, False)
-      SlotEnds       -> (False, True )
-      SlotBegins     -> (True,  False)
-      SlotContained  -> (True,  True )
-    fromBools = \case
-      (False, False) -> SlotIntersects
-      (False, True ) -> SlotEnds
-      (True,  False) -> SlotBegins
-      (True,  True ) -> SlotContained
-
-slotAssocIsCont :: SlotAssociation -> Bool
-slotAssocIsCont = views (_SlotAssociation . _1) not
-
-
 weekOffsets :: UTCTime -> Entity User -> ScheduleOffset -> [ScheduleOffset]
 weekOffsets now user@(Entity _ User{userScheduleWeekDays = ScheduleWeekDays userScheduleWeekDays}) scheduleOffset
   = nub [ ScheduleOffsetDays (-7)
@@ -69,15 +43,7 @@ weekOffsets now user@(Entity _ User{userScheduleWeekDays = ScheduleWeekDays user
     weeksEqual = on (==) $ filter (\d' -> dayOfWeek d' `elem` userScheduleWeekDays) . week
       where week d = weekDays now user $ ScheduleOffsetDays d `addOffset` scheduleOffset
 
-weekDays :: UTCTime -> Entity User -> ScheduleOffset -> [Day]
-weekDays now (Entity _ User{userWeekStart}) scheduleOffset = go dayNowOffset
-  where go d
-          | dayOfWeek d == firstDay = [d .. addDays 6 d]
-          | otherwise = go $ pred d
-        firstDay = toEnum $ fromEnum userWeekStart + offsetInDays scheduleOffset
-        dayNowOffset = toInteger (offsetInDays scheduleOffset) `addDays` localDay (utcToLocalTime now)
 
-  
 weekSchedule :: UTCTime -> Entity User -> ScheduleOffset -> Widget
 weekSchedule now user@(Entity uid User{userScheduleWeekDays = ScheduleWeekDays userScheduleWeekDays, ..}) scheduleOffset = do
   ata <- getSessionActiveAuthTags
@@ -214,6 +180,14 @@ weekSchedule now user@(Entity uid User{userScheduleWeekDays = ScheduleWeekDays u
 
 -- Local helper functions
 
+weekDays :: UTCTime -> Entity User -> ScheduleOffset -> [Day]
+weekDays now (Entity _ User{userWeekStart}) scheduleOffset = go dayNowOffset
+  where go d
+          | dayOfWeek d == firstDay = [d .. addDays 6 d]
+          | otherwise = go $ pred d
+        firstDay = toEnum $ fromEnum userWeekStart + offsetInDays scheduleOffset
+        dayNowOffset = toInteger (offsetInDays scheduleOffset) `addDays` localDay (utcToLocalTime now)
+
 -- | Check whether a given ScheduleEntry lies in a given TimeSlot
 seIsInSlot :: Day -> TimeSlot -> ScheduleEntry -> Maybe SlotAssociation
 seIsInSlot d slot = \case
diff --git a/src/Utils/Schedule/Week/SlotAssociation.hs b/src/Utils/Schedule/Week/SlotAssociation.hs
new file mode 100644
index 000000000..67427e078
--- /dev/null
+++ b/src/Utils/Schedule/Week/SlotAssociation.hs
@@ -0,0 +1,34 @@
+module Utils.Schedule.Week.SlotAssociation
+  ( SlotAssociation(..)
+  , _SlotAssociation
+  , slotAssocIsCont
+  ) where
+
+import Import
+
+
+data SlotAssociation
+  = SlotIntersects -- ^ Slot is true subset of event
+  | SlotEnds       -- ^ Event ends in slot, but does not begin within
+  | SlotBegins     -- ^ Event begins in slot, but does not end within
+  | SlotContained  -- ^ Event starts and ends within slot
+  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
+  deriving anyclass (Universe, Finite)
+nullaryPathPiece ''SlotAssociation $ camelToPathPiece' 1
+
+_SlotAssociation :: Iso' SlotAssociation (Bool, Bool)
+_SlotAssociation = iso toBools fromBools
+  where
+    toBools = \case
+      SlotIntersects -> (False, False)
+      SlotEnds       -> (False, True )
+      SlotBegins     -> (True,  False)
+      SlotContained  -> (True,  True )
+    fromBools = \case
+      (False, False) -> SlotIntersects
+      (False, True ) -> SlotEnds
+      (True,  False) -> SlotBegins
+      (True,  True ) -> SlotContained
+
+slotAssocIsCont :: SlotAssociation -> Bool
+slotAssocIsCont = views (_SlotAssociation . _1) not