refactor(occurrences): fold RoomReference into Occurrences (WIP)

Each Occurrence now has its own RoomReference, i.e. Mondays may have a different Room assigned than Tuesdays

WIP Problem: occurrencesAFrom does not work, always insists on Room missing

messages/uniworx/utils/utils/de-de-formal.msg

@@ -91,6 +91,7 @@ UtilExamResultVoided: Entwertet
 CourseOption tid@TermId ssh@SchoolId csh@CourseShorthand coursen@CourseName !ident-ok: #{tid} - #{ssh} - #{csh}: #{coursen}
 RoomReferenceNone !ident-ok: —
 RoomReferenceSimple !ident-ok: Text
+RoomReferenceSimpleAt r@Text: in Raum #{r}
 RoomReferenceLink: Link & Anweisungen
 RoomReferenceSimpleText: Raum
 RoomReferenceSimpleTextPlaceholder: Raum

messages/uniworx/utils/utils/en-eu.msg

@@ -91,6 +91,7 @@ UtilExamResultVoided: Voided
 CourseOption tid ssh csh coursen: #{tid} - #{ssh} - #{csh}: #{coursen}
 RoomReferenceNone: —
 RoomReferenceSimple: Text
+RoomReferenceSimpleAt r: at room #{r}
 RoomReferenceLink: Link & Instructions
 RoomReferenceSimpleText: Room
 RoomReferenceSimpleTextPlaceholder: Room

src/Handler/Course/Events/Delete.hs

@@ -34,7 +34,7 @@ postCEvDeleteR tid ssh csh cID = do
         $maybe room <- courseEventRoom
           , #{roomReferenceText room}
         :
-        ^{occurrencesWidget courseEventTime}
+        ^{occurrencesWidget False courseEventTime}
       |]
 
     drRecordConfirmString :: Entity CourseEvent -> DB Text

src/Handler/Course/Show.hs

@@ -1,4 +1,4 @@
--- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Sarah Vaupel <vaupel.sarah@campus.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>
+-- SPDX-FileCopyrightText: 2022-24 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Sarah Vaupel <vaupel.sarah@campus.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>,Steffen Jost <s.jost@fraport.de>
 --
 -- SPDX-License-Identifier: AGPL-3.0-or-later
 
@@ -154,14 +154,14 @@ getCShowR tid ssh csh = do
     tutorialDBTable = DBTable{..}
       where
         resultTutorial :: Lens' (DBRow (Entity Tutorial, Bool)) (Entity Tutorial)
-        resultTutorial = _dbrOutput . _1
+        resultTutorial  = _dbrOutput . _1
-        resultShowRoom = _dbrOutput . _2
+        resultHideRoom  = _dbrOutput . _2
 
         dbtSQLQuery tutorial = do
           E.where_ $ tutorial E.^. TutorialCourse E.==. E.val cid
-          let showRoom = maybe E.false (flip showTutorialRoom tutorial . E.val) mbAid
+          let hideRoom = maybe E.true (E.not__ . flip showTutorialRoom tutorial . E.val) mbAid
-                   E.||. E.not_ (tutorial E.^. TutorialRoomHidden)
+                   E.&&. (tutorial E.^. TutorialRoomHidden)
-          return (tutorial, showRoom)
+          return (tutorial, hideRoom)
         dbtRowKey = (E.^. TutorialId)
         dbtProj = over (_dbrOutput . _2) E.unValue <$> dbtProjId
         dbtColonnade = dbColonnade $ mconcat
@@ -180,10 +180,13 @@ getCShowR tid ssh csh = do
                            <li>
                              ^{nameEmailWidget' tutor}
                      |]
-          , sortable (Just "room") (i18nCell MsgTableTutorialRoom) $ \res -> if
+          , sortable (Just "room") (i18nCell MsgTableTutorialRoom) $ \res -> if -- TODO REMOVE
-              | res ^. resultShowRoom -> maybe (i18nCell MsgTableTutorialRoomIsUnset) roomReferenceCell $ views (resultTutorial . _entityVal) tutorialRoom res
+              | res ^. resultHideRoom . _not -> maybe (i18nCell MsgTableTutorialRoomIsUnset) roomReferenceCell $ views (resultTutorial . _entityVal) tutorialRoom res
               | otherwise -> i18nCell MsgTableTutorialRoomIsHidden & addCellClass ("explanation" :: Text)
-          , sortable Nothing (i18nCell MsgTableTutorialTime) $ \(view $ resultTutorial . _entityVal -> Tutorial{..}) -> occurrencesCell tutorialTime
+          , sortable Nothing (i18nCell MsgTableTutorialTime) $ \res ->
+              let roomHidden = res ^. resultHideRoom
+                  ttime      = res ^. resultTutorial . _entityVal . _tutorialTime
+              in occurrencesCell roomHidden ttime
           , sortable (Just "register-from") (i18nCell MsgTutorialRegisterFrom) $ \(view $ resultTutorial . _entityVal -> Tutorial{..}) -> maybeDateTimeCell tutorialRegisterFrom
           , sortable (Just "register-to") (i18nCell MsgTutorialRegisterTo) $ \(view $ resultTutorial . _entityVal -> Tutorial{..}) -> maybeDateTimeCell tutorialRegisterTo
           , sortable (Just "deregister-until") (i18nCell MsgTableTutorialDeregisterUntil) $ \(view $ resultTutorial . _entityVal -> Tutorial{..}) -> maybeDateTimeCell tutorialDeregisterUntil

src/Handler/Course/User.hs

@@ -445,7 +445,7 @@ courseUserTutorialsSection (Entity cid Course{..}) (Entity uid _) = do
                       ^{userEmailWidget usr}
               |]
           , sortable (Just "room") (i18nCell MsgTableTutorialRoom) $ maybe (i18nCell MsgTableTutorialRoomIsUnset) roomReferenceCell . view (_dbrOutput . _1 . _entityVal . _tutorialRoom)
-          , sortable Nothing (i18nCell MsgTableTutorialTime) $ occurrencesCell . view (_dbrOutput . _1 . _entityVal . _tutorialTime)
+          , sortable Nothing (i18nCell MsgTableTutorialTime) $ occurrencesCell False . view (_dbrOutput . _1 . _entityVal . _tutorialTime)
           ]
         dbtSorting = mconcat
           [ singletonMap "type" . SortColumn $ \(tutorial `E.InnerJoin` _) -> tutorial E.^. TutorialType

src/Handler/Tutorial/List.hs

@@ -29,18 +29,18 @@ getCTutorialListR tid ssh csh = do
     tutorialDBTable = DBTable{..}
       where
         resultTutorial :: Lens' (DBRow (Entity Tutorial, Int, Bool)) (Entity Tutorial)
-        resultTutorial = _dbrOutput . _1
+        resultTutorial     = _dbrOutput . _1
         resultParticipants = _dbrOutput . _2
-        resultShowRoom = _dbrOutput . _3
+        resultHideRoom     = _dbrOutput . _3
 
         dbtSQLQuery tutorial = do
           E.where_ $ tutorial E.^. TutorialCourse E.==. E.val cid
           let participants :: E.SqlExpr (E.Value Int)
               participants = E.subSelectCount . E.from $ \tutorialParticipant ->
                 E.where_ $ tutorialParticipant E.^. TutorialParticipantTutorial E.==. tutorial E.^. TutorialId
-          let showRoom = maybe E.false (flip showTutorialRoom tutorial . E.val) muid
+          let hideRoom = maybe E.true (E.not__ . flip showTutorialRoom tutorial . E.val) muid
-                   E.||. E.not_ (tutorial E.^. TutorialRoomHidden)
+                   E.&&. (tutorial E.^. TutorialRoomHidden)
-          return (tutorial, participants, showRoom)
+          return (tutorial, participants, hideRoom)
         dbtRowKey = (E.^. TutorialId)
         dbtProj = over (_dbrOutput . _2) E.unValue . over (_dbrOutput . _3) E.unValue <$> dbtProjId
         dbtColonnade = dbColonnade $ mconcat
@@ -61,10 +61,13 @@ getCTutorialListR tid ssh csh = do
                      |]
           , sortable (Just "participants") (i18nCell MsgTutorialParticipants) $ \(view $ $(multifocusL 2) (resultTutorial . _entityVal) resultParticipants -> (Tutorial{..}, n)) -> anchorCell (CTutorialR tid ssh csh tutorialName TUsersR) $ tshow n
           , sortable (Just "capacity") (i18nCell MsgTutorialCapacity) $ \(view $ resultTutorial . _entityVal -> Tutorial{..}) -> maybe mempty (textCell . tshow) tutorialCapacity
-          , sortable (Just "room") (i18nCell MsgTableTutorialRoom) $ \res -> if
+          , sortable (Just "room") (i18nCell MsgTableTutorialRoom) $ \res -> if -- TODO REMOVE
-              | res ^. resultShowRoom -> maybe (i18nCell MsgTableTutorialRoomIsUnset) roomReferenceCell $ views (resultTutorial . _entityVal) tutorialRoom res
+              | res ^. resultHideRoom . _not -> cellMaybe roomReferenceCell $ views (resultTutorial . _entityVal) tutorialRoom res
               | otherwise -> i18nCell MsgTableTutorialRoomIsHidden & addCellClass ("explanation" :: Text)
-          , sortable Nothing (i18nCell MsgTableTutorialTime) $ \(view $ resultTutorial . _entityVal . _tutorialTime -> ttime) -> occurrencesCell ttime
+          , sortable Nothing (i18nCell MsgTableTutorialTime) $ \res ->
+              let roomHidden = res ^. resultHideRoom
+                  ttime      = res ^. resultTutorial . _entityVal . _tutorialTime
+              in occurrencesCell roomHidden ttime
           , sortable (Just "register-group") (i18nCell MsgTutorialRegGroup) $ \(view $ resultTutorial . _entityVal -> Tutorial{..}) -> maybe mempty (textCell . CI.original) tutorialRegGroup
           , sortable (Just "register-from") (i18nCell MsgRegisterFrom) $ \(view $ resultTutorial . _entityVal -> Tutorial{..}) -> maybeDateTimeCell tutorialRegisterFrom
           , sortable (Just "register-to") (i18nCell MsgRegisterTo) $ \(view $ resultTutorial . _entityVal -> Tutorial{..}) -> maybeDateTimeCell tutorialRegisterTo

src/Handler/Utils/Form/Occurrences.hs

@@ -8,6 +8,7 @@ module Handler.Utils.Form.Occurrences
 
 import Import
 import Handler.Utils.Form
+import Handler.Utils.Widgets
 import Handler.Utils.DateTime
 
 import qualified Data.Set as Set
@@ -60,6 +61,7 @@ occurrencesAForm (toPathPiece -> miIdent') mPrev = wFormToAForm $ do
                                 <$> apreq (selectField' Nothing optionsFinite) (fslI MsgOccurrenceWeekDay & addName (nudge "occur-week-day")) Nothing
                                 <*> apreq timeFieldTypeTime (fslI MsgOccurrenceStart & addName (nudge "occur-start")) Nothing
                                 <*> apreq timeFieldTypeTime (fslI MsgOccurrenceEnd & addName (nudge "occur-end")) Nothing
+                                <*> roomReferenceFormOpt (fslI MsgTableTutorialRoom) Nothing
                             )
                           ]
             ) (fslI MsgScheduleRegularKind & addName (nudge "kind")) Nothing
@@ -96,6 +98,7 @@ occurrencesAForm (toPathPiece -> miIdent') mPrev = wFormToAForm $ do
                                 <$> apreq dayField (fslI MsgDay & addName (nudge "occur-day")) Nothing
                                 <*> apreq timeFieldTypeTime (fslI MsgOccurrenceStart & addName (nudge "occur-start")) Nothing
                                 <*> apreq timeFieldTypeTime (fslI MsgOccurrenceEnd & addName (nudge "occur-end")) Nothing
+                                <*> roomReferenceFormOpt (fslI MsgTableTutorialRoom) Nothing
                             )
                           , ( ExceptionKindNoOccur
                             , ExceptNoOccur

src/Handler/Utils/Occurrences.hs

@@ -19,6 +19,7 @@ import Utils.Holidays (isWeekend)
 import Utils.Occurrences
 
 import Handler.Utils.DateTime
+import Handler.Utils.Widgets (roomReferenceWidget)
 
 -- import Text.Read (read) -- for DEBUGGING only
 
@@ -34,15 +35,15 @@ data LessonTime = LessonTime { lessonStart, lessonEnd :: LocalTime }
   deriving (Eq, Ord, Read, Show, Generic) -- BEWARE: Ord instance might not be intuitive, but needed for Set
 
 occurringLessons :: Term -> Occurrences -> Set LessonTime
-occurringLessons t Occurrences{..} = Set.union exceptOcc $ Set.filter isExcept scheduledLessons
+occurringLessons term Occurrences{..} = Set.union exceptOcc $ Set.filter isExcept scheduledLessons
   where
-    scheduledLessons      = occurrenceScheduleToLessons t `foldMap` occurrencesScheduled
+    scheduledLessons      = occurrenceScheduleToLessons term `foldMap` occurrencesScheduled
     (exceptOcc, exceptNo) = occurrenceExceptionToLessons  occurrencesExceptions
     isExcept LessonTime{lessonStart} = Set.notMember lessonStart exceptNo
 
 occurrenceScheduleToLessons :: Term -> OccurrenceSchedule -> Set LessonTime
 occurrenceScheduleToLessons Term{..} =
-  let setHolidays = Set.fromList termHolidays
+  let setHolidays = Set.fromList termHolidays -- ensure that the conversion is performed only once for repeated calls
   in \ScheduleWeekly{..} ->
         let occDays = daysOfWeekBetween (termLectureStart, termLectureEnd) scheduleDayOfWeek \\ setHolidays
             toLesson d = LessonTime { lessonStart = LocalTime d scheduleStart
@@ -66,9 +67,8 @@ occurrenceExceptionToLessons = Set.foldr aux mempty
 -- Occurrences --
 -----------------
 
-
+occurrencesWidget :: Bool -> JSONB Occurrences -> Widget
-occurrencesWidget :: JSONB Occurrences -> Widget
+occurrencesWidget roomHidden (normalizeOccurrences . unJSONB -> Occurrences{..}) = do
-occurrencesWidget (normalizeOccurrences . unJSONB -> Occurrences{..}) = do
   let occurrencesScheduled' = flip map (Set.toList occurrencesScheduled) $ \case
         ScheduleWeekly{..} -> do
           scheduleStart' <- formatTime SelFormatTime scheduleStart

src/Handler/Utils/Table/Cells.hs

@@ -48,10 +48,11 @@ addIndicatorCell = tellCell $ Any True
 writerCell :: IsDBTable m w => WriterT w m () -> DBCell m w
 writerCell act = mempty & cellContents %~ (<* act)
 
--- for documentation purposes
+-- for documentation purposes and better error message
 cellMaybe :: IsDBTable m b => (a -> DBCell m b) -> Maybe a -> DBCell m b
 cellMaybe = foldMap
 
+-- for documentation purposes and better error message
 maybeCell :: IsDBTable m b => Maybe a -> (a -> DBCell m b) -> DBCell m b
 maybeCell = flip foldMap
 
@@ -509,8 +510,8 @@ correctorLoadCell :: IsDBTable m a => SheetCorrector -> DBCell m a
 correctorLoadCell sc =
   i18nCell $ sheetCorrectorLoad sc
 
-occurrencesCell :: IsDBTable m a => JSONB Occurrences -> DBCell m a
+occurrencesCell :: IsDBTable m a => Bool -> JSONB Occurrences -> DBCell m a
-occurrencesCell = cell . occurrencesWidget
+occurrencesCell roomHidden occs = cell $ occurrencesWidget roomHidden occs
 
 roomReferenceCell :: IsDBTable m a => RoomReference -> DBCell m a
 roomReferenceCell = cell . roomReferenceWidget

src/Handler/Utils/Widgets.hs

@@ -293,8 +293,8 @@ examOccurrenceMappingDescriptionWidget rule descriptions = $(widgetFile "widgets
 
 
 roomReferenceWidget :: RoomReference -> Widget
-roomReferenceWidget RoomReferenceSimple{..} = toWidget roomRefText
+roomReferenceWidget RoomReferenceSimple{..} = msg2widget $ MsgRoomReferenceSimpleAt roomRefText
-roomReferenceWidget RoomReferenceLink{..} = $(widgetFile "widgets/room-reference/link")
+roomReferenceWidget RoomReferenceLink{..}   = $(widgetFile "widgets/room-reference/link")
   where
     linkText = uriToString id roomRefLink mempty
     instrModal = modal (i18n MsgRoomReferenceLinkInstructions) $ Right $(widgetFile "widgets/room-reference/link-instructions-modal")

src/Model/Types/DateTime.hs

@@ -14,6 +14,7 @@ module Model.Types.DateTime
   ) where
 
 import Import.NoModel
+import Model.Types.Room
 
 -- import qualified Data.Set as Set
 import Data.Ratio ((%))
@@ -167,8 +168,9 @@ data OccurrenceSchedule = ScheduleWeekly
                           { scheduleDayOfWeek :: WeekDay
                           , scheduleStart     :: TimeOfDay
                           , scheduleEnd       :: TimeOfDay
+                          , scheduleRoom      :: Maybe RoomReference
                           }
-  deriving (Eq, Ord, Read, Show, Generic)
+  deriving (Eq, Ord, Show, Generic)
   deriving anyclass (NFData)
 
 deriveJSON defaultOptions
@@ -182,11 +184,12 @@ data OccurrenceException = ExceptOccur
                           { exceptDay   :: Day
                           , exceptStart :: TimeOfDay
                           , exceptEnd   :: TimeOfDay
+                          , exceptRoom  :: Maybe RoomReference -- ignored in Ord instance
                           }
                         | ExceptNoOccur
                           { exceptTime  :: LocalTime
                           }
-  deriving (Eq, Read, Show, Generic)
+  deriving (Eq, Show, Generic)
   deriving anyclass (NFData)
 
 -- Handler.Utils.Occurrences.occurrencesAddBusinessDays assumes that OccurrenceException is ordered chronologically
@@ -218,7 +221,7 @@ data Occurrences = Occurrences
   { occurrencesScheduled  :: Set OccurrenceSchedule
   , occurrencesExceptions :: Set OccurrenceException
   }
-  deriving (Eq, Ord, Read, Show, Generic)
+  deriving (Eq, Ord, Show, Generic)
   deriving anyclass (NFData)
 
 deriveJSON defaultOptions
@@ -256,10 +259,10 @@ nullaryPathPiece ''DayOfWeek camelToPathPiece
 --       yesterday = addUTCTime (negate nominalDay) now
 --       lt3 = utcToLocalTime tz yesterday
 --   pure
---     [ ExceptOccur (utctDay tomorrow ) midday midnight
+--     [ ExceptOccur (utctDay tomorrow ) midday   midnight Nothing
---     , ExceptOccur (utctDay now      ) midnight midnight
+--     , ExceptOccur (utctDay now      ) midnight midnight Nothing
---     , ExceptOccur (utctDay now      ) midday midnight
+--     , ExceptOccur (utctDay now      ) midday   midnight Nothing
---     , ExceptOccur (utctDay yesterday) midday midnight
+--     , ExceptOccur (utctDay yesterday) midday   midnight Nothing
 --     , ExceptNoOccur lt3
 --     , ExceptNoOccur lt1
 --     , ExceptNoOccur lt2

src/Utils.hs

@@ -923,7 +923,14 @@ toNothing = const Nothing
 toNothingS :: String -> Maybe b
 toNothingS = const Nothing
 
--- | change second of maybe pair to Nothing, if both are Just and equal
+infix 4 ==~
+
+-- | Equality treating `Nothing` as an always matching wildcard
+(==~) :: Eq a => Maybe a -> Maybe a -> Bool
+(==~) (Just x) (Just y) = x == y
+(==~) _        _        = True
+
+-- | change second of maybe pair to `Nothing`, if both are `Just` and equal
 eq2nothing :: Eq a => (Maybe a, Maybe a) -> (Maybe a, Maybe a)
 eq2nothing (mx@(Just x), Just y) | x==y = (mx, Nothing)
 eq2nothing p = p

src/Utils/Occurrences.hs

@@ -44,13 +44,15 @@ normalizeOccurrences initial
           let
             merge b@ScheduleWeekly{}
               | scheduleDayOfWeek a == scheduleDayOfWeek b -- b starts during a
-              , scheduleStart a <= scheduleStart b
+              , scheduleStart a <=  scheduleStart b
-              , scheduleEnd a >= scheduleStart b
+              , scheduleEnd   a >=  scheduleStart b
-              = Just $ ScheduleWeekly (scheduleDayOfWeek a) (scheduleStart a) ((max `on` scheduleEnd) a b)
+              , scheduleRoom  a ==~ scheduleRoom  b
+              = Just $ ScheduleWeekly (scheduleDayOfWeek a) (scheduleStart a) ((max `on` scheduleEnd) a b) (scheduleRoom a <|> scheduleRoom b)
               | scheduleDayOfWeek a == scheduleDayOfWeek b -- b ends during a
-              , scheduleStart a <= scheduleEnd b
+              , scheduleStart a <=  scheduleEnd  b
-              , scheduleEnd a >= scheduleEnd b
+              , scheduleEnd   a >=  scheduleEnd  b
-              = Just $ ScheduleWeekly (scheduleDayOfWeek a) ((min `on` scheduleStart) a b) (scheduleEnd a)
+              , scheduleRoom  a ==~ scheduleRoom b
+              = Just $ ScheduleWeekly (scheduleDayOfWeek a) ((min `on` scheduleStart) a b) (scheduleEnd a) (scheduleRoom a <|> scheduleRoom b)
               | otherwise
               = Nothing
             merge _ = Nothing
@@ -83,6 +85,7 @@ normalizeOccurrences initial
               [ scheduleDayOfWeek == localWeekDay
               , scheduleStart == exceptStart
               , scheduleEnd == exceptEnd
+              , scheduleRoom ==~ exceptRoom
               ]
           unless needed $
             throwE =<< asks (over _occurrencesExceptions $ Set.filter (not . withinNeedle) . Set.delete needle)

templates/course.hamlet

@@ -255,7 +255,7 @@ $#    $if NTop (Just 0) < NTop (courseCapacity course)
                       #{courseEventType}
                   <td .table__td>
                     <div .table__td-content>
-                      ^{occurrencesWidget courseEventTime}
+                      ^{occurrencesWidget (not showRoom) courseEventTime}
                   <td .table__td>
                     $if showRoom
                       <div .table__td-content>

templates/tutorial-participants.hamlet

@@ -8,7 +8,7 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
   <dl .deflist>
     <dt .deflist__dt>_{MsgTableTutorialTime}
     <dd .deflist__dd>
-      ^{occurrencesWidget tutorialTime}
+      ^{occurrencesWidget tutorialRoomHidden tutorialTime}
     <dt .deflist__dt>_{MsgTableTutorialTutors}
     <dd .deflist__dd>
       <ul>

templates/widgets/occurrence/cell/except-no-occurr.hamlet

@@ -1,7 +0,0 @@
-$newline never
-
-$# SPDX-FileCopyrightText: 2022 Sarah Vaupel <vaupel.sarah@campus.lmu.de>
-$#
-$# SPDX-License-Identifier: AGPL-3.0-or-later
-
-_{MsgExceptionKindNoOccur}: #{exceptTime'}

templates/widgets/occurrence/cell/except-occur.hamlet

@@ -6,5 +6,7 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
 
 $if not (null occurrencesScheduled')
   _{MsgExceptionKindOccur}: #{exceptStart'}–#{exceptEnd'} 
+  $if not roomHidden
+    ^{foldMap roomReferenceWidget exceptRoom}
 $else
   #{exceptStart'}–#{exceptEnd'}

templates/widgets/occurrence/cell/except-occurr.hamlet

@@ -1,7 +0,0 @@
-$newline never
-
-$# SPDX-FileCopyrightText: 2022 Sarah Vaupel <vaupel.sarah@campus.lmu.de>
-$#
-$# SPDX-License-Identifier: AGPL-3.0-or-later
-
-_{MsgExceptionKindOccur}: #{exceptStart'}–#{exceptEnd'}

templates/widgets/occurrence/cell/weekly.hamlet

@@ -5,3 +5,5 @@ $#
 $# SPDX-License-Identifier: AGPL-3.0-or-later
 
 _{ShortWeekDay scheduleDayOfWeek} #{scheduleStart'}–#{scheduleEnd'} 
+$if not roomHidden
+  ^{foldMap roomReferenceWidget scheduleRoom}

templates/widgets/occurrence/form/except-occur.hamlet

@@ -7,4 +7,4 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
 <td>
   _{ExceptionKindOccur}
 <td>
-  #{exceptStart'}–#{exceptEnd'}
+  #{exceptStart'}–#{exceptEnd'} ^{foldMap roomReferenceWidget exceptRoom}

templates/widgets/occurrence/form/weekly.hamlet

@@ -7,4 +7,4 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
 <td>
   _{ScheduleKindWeekly}
 <td>
-  _{scheduleDayOfWeek}, #{scheduleStart'}–#{scheduleEnd'}
+  _{scheduleDayOfWeek}, #{scheduleStart'}–#{scheduleEnd'} ^{foldMap roomReferenceWidget scheduleRoom}

test/Database/Fill.hs

@@ -1081,16 +1081,19 @@ fillDb = do
                     { scheduleDayOfWeek = Thursday
                     , scheduleStart     = TimeOfDay 11 11 0
                     , scheduleEnd       = TimeOfDay 12 22 0
+                    , scheduleRoom      = Just $ RoomReferenceSimple "B777"
                     }
                 , ScheduleWeekly
                     { scheduleDayOfWeek = Friday
                     , scheduleStart     = TimeOfDay 13 33 0
                     , scheduleEnd       = TimeOfDay 14 44 0
+                    , scheduleRoom      = Just $ RoomReferenceSimple "A320neo"
                     }
                 , ScheduleWeekly
                     { scheduleDayOfWeek = Sunday
                     , scheduleStart     = TimeOfDay 15 55 0
                     , scheduleEnd       = TimeOfDay 16 06 0
+                    , scheduleRoom      = Nothing
                     }
                 ]
             , occurrencesExceptions = Set.fromList
@@ -1098,16 +1101,19 @@ fillDb = do
                     { exceptDay   = nTimes 7 succ firstDay
                     , exceptStart = TimeOfDay  8 30  0
                     , exceptEnd   = TimeOfDay 16  0  0
+                    , exceptRoom  = Just $ RoomReferenceSimple "A380"
                     }
                 , ExceptOccur
                     { exceptDay   = nTimes 8 succ secondDay
                     , exceptStart = TimeOfDay  9  0  0
                     , exceptEnd   = TimeOfDay 16  0  0
+                    , exceptRoom  = Just $ RoomReferenceSimple "B747"
                     }
                 , ExceptOccur
                     { exceptDay   = nowaday
                     , exceptStart = TimeOfDay  9  10  0
                     , exceptEnd   = TimeOfDay 16  10  0
+                    , exceptRoom  = Nothing
                     }
                 ]
             }
@@ -1139,21 +1145,25 @@ fillDb = do
                     { exceptDay   = firstDay
                     , exceptStart = TimeOfDay  8 30  0
                     , exceptEnd   = TimeOfDay 16  0  0
+                    , exceptRoom  = Nothing
                     }
                 , ExceptOccur
                     { exceptDay   = succ firstDay
                     , exceptStart = TimeOfDay  9  0  0
                     , exceptEnd   = TimeOfDay 16  0  0
+                    , exceptRoom  = Nothing
                     }
                 , ExceptOccur
                     { exceptDay   = secondDay
                     , exceptStart = TimeOfDay 10  12  0
                     , exceptEnd   = TimeOfDay 12  13  0
+                    , exceptRoom  = Nothing
                     }
                 , ExceptOccur
                     { exceptDay   = nowaday
                     , exceptStart = TimeOfDay 17  10  0
                     , exceptEnd   = TimeOfDay 18  10  0
+                    , exceptRoom  = Nothing
                     }
                 ]
             }
@@ -1184,16 +1194,19 @@ fillDb = do
                     { exceptDay   = succ $ succ firstDay
                     , exceptStart = TimeOfDay  8  25  0
                     , exceptEnd   = TimeOfDay 16  25  0
+                    , exceptRoom  = Nothing
                     }
                 , ExceptOccur
                     { exceptDay   = succ $ succ $ succ $ succ firstDay
                     , exceptStart = TimeOfDay  9  20  0
                     , exceptEnd   = TimeOfDay 16  20  0
+                    , exceptRoom  = Nothing
                     }
                 , ExceptOccur
                     { exceptDay   = succ $ succ secondDay
                     , exceptStart = TimeOfDay 10  12  0
                     , exceptEnd   = TimeOfDay 12  13  0
+                    , exceptRoom  = Nothing
                     }
                 ]
             }