refactor(occurrences): fold RoomReference into Occurrences, completed

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

@@ -48,11 +48,11 @@ TableNotPassed: Nicht bestanden
 TableTutorialTutors: Ausbilder
 TableTutorialName: Bezeichnung
 TableTutorialType: Art
-TableTutorialRoom: Regulärer Raum
+TableTutorialRoom: Raum
 TableTutorialRoomHidden: Raum nur für Teilnehmer
 TableTutorialRoomIsUnset !ident-ok: —
 TableTutorialRoomIsHidden: Raum wird nur Teilnehmern angezeigt
-TableTutorialTime: Zeit
+TableTutorialOccurrence: Termin
 TableTutorialDeregisterUntil: Abmeldungen bis
 TableTutorialFirstDay: Starttag
 TableActionsHead: Aktionen

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

@@ -48,14 +48,14 @@ TableNotPassed: Failed
 TableTutorialTutors: Instructors
 TableTutorialName: Name
 TableTutorialType: Type
-TableTutorialRoom: Regular room
+TableTutorialRoom: Room
 TableTutorialRoomHidden: Room only for participants
 TableTutorialRoomIsUnset: —
 TableTutorialRoomIsHidden: Room is only displayed to participants
 TableTutorialDeregisterUntil: Deregister until
 TableTutorialFirstDay: Start date
 TableActionsHead: Actions
-TableTutorialTime: Time
+TableTutorialOccurrence: Session
 TableNoFilter: No restriction
 TableUserMatriculation: AVS number
 TableColumnStudyFeatures: Features of study

src/Handler/Course/Show.hs

@@ -180,7 +180,7 @@ getCShowR tid ssh csh = do
                            <li>
                              ^{nameEmailWidget' tutor}
                      |]
-          , sortable Nothing (i18nCell MsgTableTutorialTime) $ \res ->
+          , sortable Nothing (i18nCell MsgTableTutorialOccurrence) $ \res ->
               let roomHidden = res ^. resultHideRoom
                   ttime      = res ^. resultTutorial . _entityVal . _tutorialTime
               in occurrencesCell roomHidden ttime

src/Handler/Course/User.hs

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

src/Handler/Tutorial/List.hs

@@ -61,7 +61,7 @@ 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 Nothing (i18nCell MsgTableTutorialTime) $ \res ->
+          , sortable Nothing (i18nCell MsgTableTutorialOccurrence) $ \res ->
               let roomHidden = res ^. resultHideRoom
                   ttime      = res ^. resultTutorial . _entityVal . _tutorialTime
               in occurrencesCell roomHidden ttime

src/Handler/Utils/Form.hs

@@ -285,7 +285,7 @@ multiActionOpts :: forall action a.
                 -> FieldSettings UniWorX
                 -> Maybe action
                 -> (Html -> MForm Handler (FormResult a, [FieldView UniWorX]))
-multiActionOpts = multiActionOpts' mpreq
+multiActionOpts = multiActionOpts' mpopt
 
 multiAction' :: forall action a.
                 ( RenderMessage UniWorX action, PathPiece action, Ord action )
@@ -2348,21 +2348,22 @@ roomReferenceSimpleField =
 
 roomReferenceSimpleSuggestions :: HandlerFor UniWorX (OptionList Text)
 roomReferenceSimpleSuggestions = do
-  suggsRaw :: [Text] <- $(memcachedByHere) (Just $ Right $ 30 * diffSecond) ("rooms-recently-used"::Text) (E.unSingle  <<$>> runDB
+  -- suggsRaw :: [Text] <- $(memcachedByHere) (Just $ Right $ 30 * diffSecond) ("rooms-recently-used"::Text) (E.unSingle <<$>> runDB
-    [sqlQQ|
+  suggsRaw :: [Text] <- $(memcachedHere) (Just $ Right $ 42 * diffSecond) $ catchAllMonoid $ E.unSingle <<$>> runDB
-      SELECT room FROM (
+      [sqlQQ|
-        SELECT DISTINCT ON (room)
+        SELECT room FROM (
-            j.value #>> '{room,text}' AS room
+          SELECT DISTINCT ON (room)
-          , t.@{TutorialLastChanged} AS changed
+              j.value #>> '{room,text}' AS room
-        FROM ^{Tutorial} AS t
+            , t.@{TutorialLastChanged} AS changed
-          , jsonb_array_elements((@{TutorialTime}->'exceptions') || (@{TutorialTime}->'scheduled')) AS j
+          FROM ^{Tutorial} AS t
-        ORDER BY 1, 2 DESC
+            , jsonb_array_elements((@{TutorialTime}->'exceptions') || (@{TutorialTime}->'scheduled')) AS j
-      ) AS sq
+          ORDER BY 1, 2 DESC
-      WHERE room IS NOT NULL
+        ) AS sq
-      ORDER BY changed DESC
+        WHERE room IS NOT NULL
-      LIMIT 7;
+        ORDER BY changed DESC
-    |] )
+        LIMIT 7;
-  $logDebugS "Room" $ mconcat suggsRaw
+      |]
+  --  $logDebugS "Room" $ mconcat suggsRaw
   return $ mkOptionList $ fmap (\t -> Option t t t) suggsRaw
   -- suggs <- liftHandler $ runDBRead $ E.select $ do
   --       tut <- E.from $ E.table @Tutorial

src/Handler/Utils/Form/Occurrences.hs

@@ -59,9 +59,9 @@ occurrencesAForm (toPathPiece -> miIdent') mPrev = wFormToAForm $ do
             (Map.fromList [ ( ScheduleKindWeekly
                             , ScheduleWeekly
                                 <$> apreq (selectField' Nothing optionsFinite) (fslI MsgOccurrenceWeekDay & addName (nudge "occur-week-day")) Nothing
-                                <*> apreq timeFieldTypeTime (fslI MsgOccurrenceStart & addName (nudge "occur-start")) Nothing
+                                <*> apreq timeFieldTypeTime (fslI MsgOccurrenceStart   & addName (nudge "occur-start")) Nothing
-                                <*> apreq timeFieldTypeTime (fslI MsgOccurrenceEnd & addName (nudge "occur-end")) Nothing
+                                <*> apreq timeFieldTypeTime (fslI MsgOccurrenceEnd     & addName (nudge "occur-end"  )) Nothing
-                                <*> roomReferenceForm' Nothing (fslI MsgTableTutorialRoom & addName (nudge "occur-room")) Nothing
+                                <*> roomReferenceFormOpt    (fslI MsgTableTutorialRoom & addName (nudge "occur-room" )) (Just Nothing)
                                 --   <*> aopt roomReferenceSimpleField (fslI MsgTableTutorialRoom & addName (nudge "occur-room")) (Just Nothing)
                             )
                           ]
@@ -97,9 +97,9 @@ occurrencesAForm (toPathPiece -> miIdent') mPrev = wFormToAForm $ do
             (Map.fromList [ ( ExceptionKindOccur
                             , ExceptOccur
                                 <$> apreq dayField (fslI MsgDay & addName (nudge "occur-day")) Nothing
-                                <*> apreq timeFieldTypeTime (fslI MsgOccurrenceStart & addName (nudge "occur-start")) Nothing
+                                <*> apreq timeFieldTypeTime (fslI MsgOccurrenceStart   & addName (nudge "occur-start"))       Nothing
-                                <*> apreq timeFieldTypeTime (fslI MsgOccurrenceEnd & addName (nudge "occur-end")) Nothing
+                                <*> apreq timeFieldTypeTime (fslI MsgOccurrenceEnd     & addName (nudge "occur-end"  ))       Nothing
-                                <*> roomReferenceForm' Nothing (fslI MsgTableTutorialRoom & addName (nudge "occur-room")) Nothing
+                                <*> roomReferenceFormOpt    (fslI MsgTableTutorialRoom & addName (nudge "occur-room" )) (Just Nothing)
                                 --   <*> aopt roomReferenceSimpleField (fslI MsgTableTutorialRoom & addName (nudge "occur-room")) Nothing
                             )
                           , ( ExceptionKindNoOccur

src/Utils.hs

@@ -1190,6 +1190,17 @@ maybeCatchAll act = catch act ignore
     ignore :: Monad m => SomeException -> m (Maybe a)
     ignore _ = return Nothing
 
+-- | Ignore all errors by returning a monadic default value.
+catchAllDefault :: MonadCatch m => m a -> m (Maybe a) -> m a
+catchAllDefault dft = fromMaybeM dft .  maybeCatchAll
+
+-- | Ignore all errors by returning mempty. (Not sure if this function is a good idea)
+catchAllMonoid :: (MonadCatch m, Monoid a) => m a -> m a
+catchAllMonoid act = catch act ignore
+  where
+    ignore :: (Monad m, Monoid a) => SomeException -> m a
+    ignore _ = pure mempty
+
 maybeExceptT :: Monad m => e -> m (Maybe b) -> ExceptT e m b
 maybeExceptT err act = lift act >>= maybe (throwE err) return
 

templates/tutorial-participants.hamlet

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

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

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