refactor(occurrences): remove RoomReference from model and add migration

models/courses.model

@@ -29,8 +29,7 @@ Course    -- Information about a single course; contained info is always visible
     deriving Generic
 CourseEvent
     type            (CI Text)
-    course          CourseId OnDeleteCascade OnUpdateCascade
+    course          CourseId OnDeleteCascade OnUpdateCascade    
-    room            RoomReference Maybe
     roomHidden      Bool default=false
     time            (JSONB Occurrences)
     note            StoredMarkup Maybe

models/tutorials.model

@@ -6,8 +6,7 @@ Tutorial json
     name            TutorialName
     course          CourseId OnDeleteCascade OnUpdateCascade
     type            (CI Text) -- "Tutorium", "Zentralübung", ...
-    capacity        Int Maybe -- limit for enrolment in this tutorial
+    capacity        Int Maybe -- limit for enrolment in this tutorial    
-    room            RoomReference Maybe
     roomHidden      Bool default=false
     time            (JSONB Occurrences)
     regGroup        (CI Text) Maybe -- each participant may register for one tutorial per regGroup

src/Handler/Course/Events/Delete.hs

@@ -31,8 +31,6 @@ postCEvDeleteR tid ssh csh cID = do
       [whamlet|
         $newline never
         #{courseEventType}
-        $maybe room <- courseEventRoom
-          , #{roomReferenceText room}
         :
         ^{occurrencesWidget False courseEventTime}
       |]

src/Handler/Course/Events/Edit.hs

@@ -26,7 +26,6 @@ postCEvEditR tid ssh csh cID = do
       replace eId CourseEvent
         { courseEventCourse
         , courseEventType = cefType
-        , courseEventRoom = cefRoom
         , courseEventRoomHidden = cefRoomHidden
         , courseEventTime = cefTime & JSONB
         , courseEventNote = cefNote

src/Handler/Course/Events/Form.hs

@@ -17,7 +17,6 @@ import qualified Database.Esqueleto.Legacy as E
 
 data CourseEventForm = CourseEventForm
   { cefType             :: CI Text
-  , cefRoom             :: Maybe RoomReference
   , cefRoomHidden       :: Bool
   , cefTime             :: Occurrences
   , cefNote             :: Maybe StoredMarkup
@@ -37,14 +36,12 @@ courseEventForm template = identifyForm FIDCourseEvent . renderWForm FormStandar
   let courseEventTypes = optionsPairs [ (courseEventType, courseEventType) | Entity _ CourseEvent{..} <- existingEvents ]
 
   cefType' <- wreq (textField & cfStrip & cfCI & addDatalist courseEventTypes) (fslI MsgCourseEventType & addPlaceholder (mr MsgCourseEventTypePlaceholder)) (cefType <$> template)
-  cefRoom' <- aFormToWForm $ roomReferenceFormOpt (fslI MsgCourseEventRoom) (cefRoom <$> template)
   cefRoomHidden' <- wpopt checkBoxField (fslI MsgCourseEventRoomHidden & setTooltip MsgCourseEventRoomHiddenTip) (cefRoomHidden <$> template)
   cefTime' <- aFormToWForm $ occurrencesAForm ("time" :: Text) (cefTime <$> template)
   cefNote' <- wopt htmlField (fslI MsgCourseEventNote) (cefNote <$> template)
 
   return $ CourseEventForm
     <$> cefType'
-    <*> cefRoom'
     <*> cefRoomHidden'
     <*> cefTime'
     <*> cefNote'
@@ -52,7 +49,6 @@ courseEventForm template = identifyForm FIDCourseEvent . renderWForm FormStandar
 courseEventToForm :: CourseEvent -> CourseEventForm
 courseEventToForm CourseEvent{..} = CourseEventForm
   { cefType = courseEventType
-  , cefRoom = courseEventRoom
   , cefRoomHidden = courseEventRoomHidden
   , cefTime = courseEventTime & unJSONB
   , cefNote = courseEventNote

src/Handler/Course/Events/New.hs

@@ -24,7 +24,6 @@ postCEventsNewR tid ssh csh = do
       eId <- insert CourseEvent
         { courseEventCourse      = cid
         , courseEventType        = cefType
-        , courseEventRoom        = cefRoom
         , courseEventRoomHidden  = cefRoomHidden
         , courseEventTime        = cefTime & JSONB
         , courseEventNote        = cefNote

src/Handler/Course/ParticipantInvite.hs

@@ -1,4 +1,4 @@
--- SPDX-FileCopyrightText: 2022-23 Sarah Vaupel <sarah.vaupel@ifi.lmu.de>, Steffen Jost <s.jost@fraport.de>
+-- SPDX-FileCopyrightText: 2022-24 Sarah Vaupel <sarah.vaupel@ifi.lmu.de>, Steffen Jost <s.jost@fraport.de>
 --
 -- SPDX-License-Identifier: AGPL-3.0-or-later
 
@@ -384,7 +384,6 @@ upsertNewTutorial cid newTutorialName newTutorialType newFirstDay = runDB $ do
           , tutorialCourse          = cid
           , tutorialType            = fromMaybe defaultTutorialType newTutorialType
           , tutorialCapacity        = Nothing
-          , tutorialRoom            = Nothing
           , tutorialRoomHidden      = False
           , tutorialTime            = mempty
           , tutorialRegGroup        = Nothing

src/Handler/Course/Show.hs

@@ -180,9 +180,6 @@ getCShowR tid ssh csh = do
                            <li>
                              ^{nameEmailWidget' tutor}
                      |]
-          , sortable (Just "room") (i18nCell MsgTableTutorialRoom) $ \res -> if -- TODO REMOVE
-              | res ^. resultHideRoom . _not -> maybe (i18nCell MsgTableTutorialRoomIsUnset) roomReferenceCell $ views (resultTutorial . _entityVal) tutorialRoom res
-              | otherwise -> i18nCell MsgTableTutorialRoomIsHidden & addCellClass ("explanation" :: Text)
           , sortable Nothing (i18nCell MsgTableTutorialTime) $ \res ->
               let roomHidden = res ^. resultHideRoom
                   ttime      = res ^. resultTutorial . _entityVal . _tutorialTime
@@ -223,7 +220,6 @@ getCShowR tid ssh csh = do
           [ ("type", SortColumn $ \tutorial -> tutorial E.^. TutorialType )
           , ("name", SortColumn $ \tutorial -> tutorial E.^. TutorialName )
           , ("first-day", SortColumnNullsInv  $ \tutorial -> tutorial E.^. TutorialFirstDay )
-          , ("room", SortColumn $ \tutorial -> tutorial E.^. TutorialRoom )
           , ("register-from", SortColumn $ \tutorial -> tutorial E.^. TutorialRegisterFrom )
           , ("register-to", SortColumn $ \tutorial -> tutorial E.^. TutorialRegisterTo )
           , ("deregister-until", SortColumn $ \tutorial -> tutorial E.^. TutorialDeregisterUntil )

src/Handler/Course/User.hs

@@ -444,13 +444,11 @@ courseUserTutorialsSection (Entity cid Course{..}) (Entity uid _) = do
                     <li>
                       ^{userEmailWidget usr}
               |]
-          , sortable (Just "room") (i18nCell MsgTableTutorialRoom) $ maybe (i18nCell MsgTableTutorialRoomIsUnset) roomReferenceCell . view (_dbrOutput . _1 . _entityVal . _tutorialRoom)
           , sortable Nothing (i18nCell MsgTableTutorialTime) $ occurrencesCell False . view (_dbrOutput . _1 . _entityVal . _tutorialTime)
           ]
         dbtSorting = mconcat
           [ singletonMap "type" . SortColumn $ \(tutorial `E.InnerJoin` _) -> tutorial E.^. TutorialType
           , singletonMap "name" . SortColumn $ \(tutorial `E.InnerJoin` _) -> tutorial E.^. TutorialName
-          , singletonMap "room" . SortColumn $ \(tutorial `E.InnerJoin` _) -> tutorial E.^. TutorialRoom
           , singletonMap "tutors" . SortColumn $ \(tutorial `E.InnerJoin` _) -> E.subSelectMaybe . E.from $ \(tutor `E.InnerJoin` user) -> do
               E.on $ tutor E.^. TutorUser E.==. user E.^. UserId
               E.where_ $ tutorial E.^. TutorialId E.==. tutor E.^. TutorTutorial

src/Handler/Tutorial/Edit.hs

@@ -37,7 +37,6 @@ postTEditR tid ssh csh tutn = do
         { tfName            = tutorialName
         , tfType            = tutorialType
         , tfCapacity        = tutorialCapacity
-        , tfRoom            = tutorialRoom
         , tfRoomHidden      = tutorialRoomHidden
         , tfTime            = tutorialTime & unJSONB
         , tfRegGroup        = tutorialRegGroup
@@ -62,7 +61,6 @@ postTEditR tid ssh csh tutn = do
         , tutorialCourse          = cid
         , tutorialType            = tfType
         , tutorialCapacity        = tfCapacity
-        , tutorialRoom            = tfRoom
         , tutorialRoomHidden      = tfRoomHidden
         , tutorialTime            = tfTime & JSONB
         , tutorialRegGroup        = tfRegGroup

src/Handler/Tutorial/Form.hs

@@ -25,7 +25,6 @@ data TutorialForm = TutorialForm
   , tfRegGroup        :: Maybe (CI Text)
   , tfTutorControlled :: Bool
   , tfCapacity        :: Maybe Int
-  , tfRoom            :: Maybe RoomReference
   , tfRoomHidden      :: Bool
   , tfTime            :: Occurrences
   , tfRegisterFrom    :: Maybe UTCTime
@@ -75,7 +74,6 @@ tutorialForm cid template html = do
     <*> aopt (textField & cfStrip & cfCI) (fslI MsgTutorialRegGroup & setTooltip MsgTutorialRegGroupTip) ((tfRegGroup <$> template) <|> Just (Just "tutorial"))
     <*> apopt checkBoxField (fslI MsgTutorialTutorControlled & setTooltip MsgTutorialTutorControlledTip) (tfTutorControlled <$> template)
     <*> aopt (natFieldI MsgTutorialCapacityNonPositive) (fslpI MsgTutorialCapacity (mr MsgTutorialCapacity) & setTooltip MsgTutorialCapacityTip) (tfCapacity <$> template)
-    <*> roomReferenceFormOpt (fslI MsgTableTutorialRoom) (tfRoom <$> template)
     <*> apopt checkBoxField (fslI MsgTableTutorialRoomHidden & setTooltip MsgTutorialRoomHiddenTip) (tfRoomHidden <$> template <|> Just False)
     <*> occurrencesAForm ("occurrences" :: Text) (tfTime <$> template)
     <*> aopt utcTimeField   (fslpI MsgRegisterFrom (mr MsgTutorialDate)

src/Handler/Tutorial/List.hs

@@ -61,9 +61,6 @@ 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 -- TODO REMOVE
-              | res ^. resultHideRoom . _not -> cellMaybe roomReferenceCell $ views (resultTutorial . _entityVal) tutorialRoom res
-              | otherwise -> i18nCell MsgTableTutorialRoomIsHidden & addCellClass ("explanation" :: Text)
           , sortable Nothing (i18nCell MsgTableTutorialTime) $ \res ->
               let roomHidden = res ^. resultHideRoom
                   ttime      = res ^. resultTutorial . _entityVal . _tutorialTime
@@ -92,7 +89,6 @@ getCTutorialListR tid ssh csh = do
                                                         in participantCount
             )
           , ("capacity", SortColumn $ \tutorial -> tutorial E.^. TutorialCapacity )
-          , ("room", SortColumn $ \tutorial -> tutorial E.^. TutorialRoom )
           , ("register-group", SortColumn $ \tutorial -> tutorial E.^. TutorialRegGroup )
           , ("register-from"    , SortColumnNullsInv $ \tutorial -> tutorial E.^. TutorialRegisterFrom )
           , ("register-to"      , SortColumnNullsInv $ \tutorial -> tutorial E.^. TutorialRegisterTo )

src/Handler/Tutorial/New.hs

@@ -33,7 +33,6 @@ postCTutorialNewR tid ssh csh = do
         , tutorialCourse          = cid
         , tutorialType            = tfType
         , tutorialCapacity        = tfCapacity
-        , tutorialRoom            = tfRoom
         , tutorialRoomHidden      = tfRoomHidden
         , tutorialTime            = JSONB tfTime
         , tutorialRegGroup        = tfRegGroup

src/Handler/Utils/Form/Occurrences.hs

@@ -61,7 +61,9 @@ 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
+                                -- DEBUG TODO
+                                -- <*> roomReferenceFormOpt (fslI MsgTableTutorialRoom) Nothing
+                                <*> pure Nothing
                             )
                           ]
             ) (fslI MsgScheduleRegularKind & addName (nudge "kind")) Nothing
@@ -98,7 +100,9 @@ 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
+                                -- DEBUG TODO
                                 <*> roomReferenceFormOpt (fslI MsgTableTutorialRoom) Nothing
+                                -- <*> pure Nothing
                             )
                           , ( ExceptionKindNoOccur
                             , ExceptNoOccur

src/Model/Migration/Definitions.hs

@@ -48,9 +48,10 @@ import qualified Data.Time.Zones as TZ
 
 data ManualMigration
   = Migration20230524QualificationUserBlock
-  | Migration20230703LmsUserStatus    
+  | Migration20230703LmsUserStatus
   | Migration20240212InitInterfaceHealth        -- create table interface_health and fill with default values
-  | Migration20240224UniquenessCompanyAvsNr  
+  | Migration20240224UniquenessCompanyAvsNr
+  | Migration20240930RoomOccurrences            -- rooms become a part of occurrences
   deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic)
   deriving anyclass (Universe, Finite)
 
@@ -89,16 +90,16 @@ migrateManual = do
     , ("study_features_relevance_cached",     "CREATE INDEX study_features_relevance_cached ON \"study_features\" (relevance_cached)")
     , ("submission_rating_by",                "CREATE INDEX submission_rating_by ON submission (rating_by) WHERE rating_by IS NOT NULL"  )
     , ("exam_corrector_user",                 "CREATE INDEX exam_corrector_user ON exam_corrector (\"user\")"                            )
-    , ("submission_rating_time",              "CREATE INDEX submission_rating_time ON submission (rating_time)"                          )    
+    , ("submission_rating_time",              "CREATE INDEX submission_rating_time ON submission (rating_time)"                          )
     , ("idx_qualification_user_first_held"   ,"CREATE INDEX idx_qualification_user_first_held ON \"qualification_user\" (\"first_held\")")
     , ("idx_qualification_user_valid_until"  ,"CREATE INDEX idx_qualification_user_valid_until ON \"qualification_user\" (\"valid_until\")")
     , ("idx_qualification_user_block_quser"  ,"CREATE INDEX idx_qualification_user_block_quser ON \"qualification_user_block\" (\"qualification_user\")")
     , ("idx_qualification_user_block_unblock","CREATE INDEX idx_qualification_user_block_unblock ON \"qualification_user_block\" (\"unblock\")")
-    , ("idx_qualification_user_block_from"   ,"CREATE INDEX idx_qualification_user_block_from ON \"qualification_user_block\" (\"from\")")    
+    , ("idx_qualification_user_block_from"   ,"CREATE INDEX idx_qualification_user_block_from ON \"qualification_user_block\" (\"from\")")
-    , ("idx_print_job_apc_ident"             ,"CREATE INDEX idx_print_job_apc_ident ON \"print_job\" (\"apc_ident\")")    
+    , ("idx_print_job_apc_ident"             ,"CREATE INDEX idx_print_job_apc_ident ON \"print_job\" (\"apc_ident\")")
     , ("idx_lms_report_log_q_ident_time"     ,"CREATE INDEX idx_lms_report_log_q_ident_time ON \"lms_report_log\" (\"qualification\",\"ident\",\"timestamp\")")
     , ("idx_user_company_company"            ,"CREATE INDEX idx_user_company_company ON \"user_company\" (\"company\")") -- composed index from unique cannot be used for frequently used filters on company
-    , ("idx_user_supervisor_user"            ,"CREATE INDEX idx_user_supervisor_user ON \"user_supervisor\" (\"user\")") -- composed index from unique cannot be used for frequently used filters on user    
+    , ("idx_user_supervisor_user"            ,"CREATE INDEX idx_user_supervisor_user ON \"user_supervisor\" (\"user\")") -- composed index from unique cannot be used for frequently used filters on user
     ]
   where
     addIndex :: Text -> Sql -> Migration
@@ -142,17 +143,17 @@ customMigrations = mapF $ \case
 
   Migration20230524QualificationUserBlock ->
     whenM (andM [ not <$> tableExists "qualification_user_block"
-                , tableExists  "qualification_user" 
+                , tableExists  "qualification_user"
-                , columnExists "qualification_user" "blocked_due" 
+                , columnExists "qualification_user" "blocked_due"
                 ] ) $ do
         [executeQQ|
-          CREATE TABLE "qualification_user_block" 
+          CREATE TABLE "qualification_user_block"
             ( "id" SERIAL8 PRIMARY KEY UNIQUE
             , "qualification_user" bigint NOT NULL
             , "unblock" boolean NOT NULL
             , "from" timestamp with time zone NOT NULL
             , "reason" character varying NOT NULL
-            , "blocker" bigint 
+            , "blocker" bigint
             , CONSTRAINT qualification_user_block_qualification_user_fkey FOREIGN KEY ("qualification_user") REFERENCES "qualification_user"(id) ON DELETE CASCADE ON UPDATE CASCADE
             , CONSTRAINT qualification_user_block_blocker_fkey FOREIGN KEY ("blocker") REFERENCES "user"(id)
             );
@@ -175,27 +176,27 @@ customMigrations = mapF $ \case
         UPDATE "lms_user"
           SET "status_day" = CAST("status"->>'day' AS date)
             , "status" = "status"->'lms-status'
-        ;  
+        ;
       |]
 
   Migration20240212InitInterfaceHealth ->
     unlessM (tableExists "interface_health") $ do -- fill health table with some defaults
       [executeQQ|
         CREATE TABLE "interface_health"
-          ( id BIGSERIAL NOT NULL 
+          ( id BIGSERIAL NOT NULL
-          , interface CHARACTER VARYING NOT NULL 
+          , interface CHARACTER VARYING NOT NULL
-          , subtype   CHARACTER VARYING 
+          , subtype   CHARACTER VARYING
-          , write     BOOLEAN 
+          , write     BOOLEAN
-          , hours     BIGINT NOT NULL 
+          , hours     BIGINT NOT NULL
-          , PRIMARY KEY(id) 
+          , PRIMARY KEY(id)
-          , CONSTRAINT unique_interface_health UNIQUE(interface, subtype, write) 
+          , CONSTRAINT unique_interface_health UNIQUE(interface, subtype, write)
-          ); 
+          );
-        INSERT INTO "interface_health" ("interface", "subtype", "write", "hours") 
+        INSERT INTO "interface_health" ("interface", "subtype", "write", "hours")
-        VALUES 
+        VALUES
-            ('Printer', 'Acknowledge', True, 168) 
+            ('Printer', 'Acknowledge', True, 168)
-          , ('AVS'    , 'Synch'      , True , 96) 
+          , ('AVS'    , 'Synch'      , True , 96)
-        ON CONFLICT DO NOTHING; 
+        ON CONFLICT DO NOTHING;
-      |]    
+      |]
 
   Migration20240224UniquenessCompanyAvsNr ->
     whenM (tableExists "company" `and2M` notM (indexExists "unique_company_avs_id")) $ do -- companies with avs_id == 0 can be deleted; company users are deleted automatically by cascade
@@ -204,6 +205,81 @@ customMigrations = mapF $ \case
         ALTER TABLE "company" DROP CONSTRAINT IF EXISTS "unique_company_shorthand";
       |]
 
+  Migration20240930RoomOccurrences -> do
+    whenM (tableColumnExists "tutorial" "room")
+      [executeQQ|
+        WITH updated_scheduled AS (
+            SELECT id
+                , jsonb_agg(
+                    CASE
+                        WHEN jsonb_exists(elem, 'room') THEN elem
+                        ELSE jsonb_set(elem, '{room}', to_jsonb(t.room))
+                    END
+                ) AS new_scheduled
+            FROM tutorial AS t
+            CROSS JOIN jsonb_array_elements(t."time"->'scheduled') AS elem
+            GROUP BY t.id, t.room
+        ), updated_exceptions AS (
+            SELECT id
+                , jsonb_agg(
+                    CASE
+                        WHEN jsonb_exists(elem, 'room') THEN elem
+                        ELSE jsonb_set(elem, '{room}', to_jsonb(t.room))
+                    END
+                ) AS new_exceptions
+            FROM tutorial AS t
+            CROSS JOIN jsonb_array_elements(t."time"->'exceptions') AS elem
+            GROUP BY t.id, t.room
+        )
+        UPDATE tutorial AS t
+        SET "time" = jsonb_set(
+                        jsonb_set(t."time", '{scheduled}', us.new_scheduled),
+                        '{exceptions}', ue.new_exceptions
+                    )
+        FROM updated_scheduled AS us JOIN updated_exceptions AS ue ON us.id = ue.id
+        WHERE t.id = us.id
+        ;
+
+        ALTER TABLE "tutorial" DROP COLUMN "room";
+      |]
+
+    whenM (tableColumnExists "course_event" "room")
+      [executeQQ|
+        WITH updated_scheduled AS (
+            SELECT id
+                , jsonb_agg(
+                    CASE
+                        WHEN jsonb_exists(elem, 'room') THEN elem
+                        ELSE jsonb_set(elem, '{room}', to_jsonb(t.room))
+                    END
+                ) AS new_scheduled
+            FROM course_event AS t
+            CROSS JOIN jsonb_array_elements(t."time"->'scheduled') AS elem
+            GROUP BY t.id, t.room
+        ), updated_exceptions AS (
+            SELECT id
+                , jsonb_agg(
+                    CASE
+                        WHEN jsonb_exists(elem, 'room') THEN elem
+                        ELSE jsonb_set(elem, '{room}', to_jsonb(t.room))
+                    END
+                ) AS new_exceptions
+            FROM course_event AS t
+            CROSS JOIN jsonb_array_elements(t."time"->'exceptions') AS elem
+            GROUP BY t.id, t.room
+        )
+        UPDATE course_event AS t
+        SET "time" = jsonb_set(
+                        jsonb_set(t."time", '{scheduled}', us.new_scheduled),
+                        '{exceptions}', ue.new_exceptions
+                    )
+        FROM updated_scheduled AS us JOIN updated_exceptions AS ue ON us.id = ue.id
+        WHERE t.id = us.id
+        ;
+
+        ALTER TABLE "course_event" DROP COLUMN "room";
+      |]
+
 
 tableExists :: MonadIO m => Text -> ReaderT SqlBackend m Bool
 tableExists table = do
@@ -232,15 +308,22 @@ tableDropEmpty table = whenM (tableExists table) $ do
 columnExists :: MonadIO m
              => Text -- ^ Table
              -> Text -- ^ Column
-             -> ReaderT SqlBackend m Bool -- BEWARE: use tablesExist beforehand!!! 
+             -> ReaderT SqlBackend m Bool -- BEWARE: use tablesExist beforehand!!!
 columnExists table column = do
   haveColumn <- [sqlQQ|SELECT column_name FROM information_schema.columns WHERE table_name=#{table} and column_name=#{column};|]
   case haveColumn :: [Single PersistValue] of
     [_]    -> return True
     _other -> return False
 
+-- | checks table existence before checking column existence to avoid errors
+tableColumnExists :: MonadIO m
+             => Text -- ^ Table
+             -> Text -- ^ Column
+             -> ReaderT SqlBackend m Bool
+tableColumnExists table column = and2M (tableExists table) (columnExists table column)
+
 -- | equivalent to andM [ tableExists, not <$> columnExists]
-columnNotExists :: MonadIO m 
+columnNotExists :: MonadIO m
              => Text -- ^ Table
              -> Text -- ^ Column
              -> ReaderT SqlBackend m Bool
@@ -248,7 +331,7 @@ columnNotExists table column = and2M (tableExists table) (not <$> columnExists t
 
 indexExists :: MonadIO m => Text -> ReaderT SqlBackend m Bool
 indexExists ixName = do
-  res <- [sqlQQ|SELECT EXISTS (SELECT 1 FROM pg_indexes WHERE schemaname = current_schema() AND indexname = #{ixName})|] 
+  res <- [sqlQQ|SELECT EXISTS (SELECT 1 FROM pg_indexes WHERE schemaname = current_schema() AND indexname = #{ixName})|]
   return $ case res of
     [Single e]  -> e
     _other      -> True

templates/course.hamlet

@@ -239,8 +239,6 @@ $#    $if NTop (Just 0) < NTop (courseCapacity course)
                   _{MsgCourseEventType}
                 <th .table__th uw-hide-column-header="time">
                   _{MsgCourseEventTime}
-                <th .table__th uw-hide-column-header="room">
-                  _{MsgCourseEventRoom}
                 <th .table__th uw-hide-column-header="note" :hiddenEventNotes:.course-event-note--hidden>
                   _{MsgCourseEventNote}
                 $if mayCreateEvents
@@ -248,7 +246,7 @@ $#    $if NTop (Just 0) < NTop (courseCapacity course)
                     _{MsgCourseEventActions}
                     \ #{iconInvisible}
             <tbody>
-              $forall (cID, CourseEvent{courseEventType, courseEventTime, courseEventRoom, courseEventNote}, showRoom) <- events
+              $forall (cID, CourseEvent{courseEventType, courseEventTime, courseEventNote}, showRoom) <- events
                 <tr .table__row ##{"event-" <> toPathPiece cID}>
                   <td .table__td>
                     <div .table__td-content>
@@ -256,16 +254,6 @@ $#    $if NTop (Just 0) < NTop (courseCapacity course)
                   <td .table__td>
                     <div .table__td-content>
                       ^{occurrencesWidget (not showRoom) courseEventTime}
-                  <td .table__td>
-                    $if showRoom
-                      <div .table__td-content>
-                        $maybe room <- courseEventRoom
-                          ^{roomReferenceWidget room}
-                        $nothing
-                          _{MsgCourseEventRoomIsUnset}
-                    $else
-                      <div .table__td-content .explanation>
-                        _{MsgCourseEventRoomIsHidden}
                   <td .table__td :hiddenEventNotes:.course-event-note--hidden>
                     <div .table__td-content>
                       #{courseEventNote}

templates/widgets/occurrence/cell/weekly.hamlet

@@ -1,9 +1,11 @@
 $newline never
 
-$# SPDX-FileCopyrightText: 2022 Sarah Vaupel <vaupel.sarah@campus.lmu.de>
+$# SPDX-FileCopyrightText: 2022-24 Sarah Vaupel <vaupel.sarah@campus.lmu.de>, Steffen Jost <s.jost@fraport.de>
 $#
 $# SPDX-License-Identifier: AGPL-3.0-or-later
 
 _{ShortWeekDay scheduleDayOfWeek} #{scheduleStart'}–#{scheduleEnd'} 
-$if not roomHidden
+$if roomHidden
+  _{MsgTableTutorialRoomIsHidden}
+$else 
   ^{foldMap roomReferenceWidget scheduleRoom}

test/Database/Fill.hs

@@ -1005,7 +1005,6 @@ fillDb = do
          firstDay  = utctDay $ termTime tid TermDayLectureStart 0 Nothing toMidnight
          secondDay = utctDay $ termTime tid TermDayLectureStart 1 Nothing toMidnight
          tyear = year tid
-         weekDay = dayOfWeek firstDay
          -- thirdDay  = utctDay $ termTime tid TermDayLectureStart 2 Nothing toMidnight
          capacity = Just 8
          mkName = CI.mk
@@ -1068,12 +1067,6 @@ fillDb = do
           , tutorialCourse = c
           , tutorialType = "Schulung"
           , tutorialCapacity = capacity
-          , tutorialRoom = Just $ case weekDay of
-                Monday -> "A380"
-                Tuesday -> "B747"
-                Wednesday -> "MD11"
-                Thursday -> "A380"
-                _ -> "B777"
           , tutorialRoomHidden = False
           , tutorialTime = JSONB $ Occurrences
             { occurrencesScheduled = Set.fromList
@@ -1131,12 +1124,6 @@ fillDb = do
           , tutorialCourse = c
           , tutorialType = "Vorlage"
           , tutorialCapacity = capacity
-          , tutorialRoom = Just $ case weekDay of
-                Monday -> "A380"
-                Tuesday -> "B747"
-                Wednesday -> "MD11"
-                Thursday -> "A380"
-                _ -> "B777"
           , tutorialRoomHidden = False
           , tutorialTime = JSONB $ Occurrences
             { occurrencesScheduled = Set.empty
@@ -1180,13 +1167,7 @@ fillDb = do
           , tutorialCourse = c
           , tutorialType = "Vorlage_Sondertutorium"
           , tutorialCapacity = capacity
-          , tutorialRoom = Just $ case weekDay of
+          , tutorialRoomHidden = True
-                Monday -> "A380"
-                Tuesday -> "B747"
-                Wednesday -> "MD11"
-                Thursday -> "A380"
-                _ -> "B777"
-          , tutorialRoomHidden = False
           , tutorialTime = JSONB $ Occurrences
             { occurrencesScheduled = Set.empty
             , occurrencesExceptions = Set.fromList
@@ -1194,13 +1175,13 @@ fillDb = do
                     { exceptDay   = succ $ succ firstDay
                     , exceptStart = TimeOfDay  8  25  0
                     , exceptEnd   = TimeOfDay 16  25  0
-                    , exceptRoom  = Nothing
+                    , exceptRoom  = Just $ RoomReferenceSimple "E175"
                     }
                 , ExceptOccur
                     { exceptDay   = succ $ succ $ succ $ succ firstDay
                     , exceptStart = TimeOfDay  9  20  0
                     , exceptEnd   = TimeOfDay 16  20  0
-                    , exceptRoom  = Nothing
+                    , exceptRoom  = Just $ RoomReferenceSimple "LJ45"
                     }
                 , ExceptOccur
                     { exceptDay   = succ $ succ secondDay