diff --git a/messages/uniworx/utils/table_column/de-de-formal.msg b/messages/uniworx/utils/table_column/de-de-formal.msg index a4d2818fa..f3cc58366 100644 --- a/messages/uniworx/utils/table_column/de-de-formal.msg +++ b/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 diff --git a/messages/uniworx/utils/table_column/en-eu.msg b/messages/uniworx/utils/table_column/en-eu.msg index d213ba05f..65eb98114 100644 --- a/messages/uniworx/utils/table_column/en-eu.msg +++ b/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 diff --git a/src/Handler/Course/Show.hs b/src/Handler/Course/Show.hs index d211bcda5..8b5de3739 100644 --- a/src/Handler/Course/Show.hs +++ b/src/Handler/Course/Show.hs @@ -180,7 +180,7 @@ getCShowR tid ssh csh = do
  • ^{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 diff --git a/src/Handler/Course/User.hs b/src/Handler/Course/User.hs index 2d2d221c2..25b8bf904 100644 --- a/src/Handler/Course/User.hs +++ b/src/Handler/Course/User.hs @@ -444,7 +444,7 @@ courseUserTutorialsSection (Entity cid Course{..}) (Entity uid _) = do
  • ^{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 diff --git a/src/Handler/Tutorial/List.hs b/src/Handler/Tutorial/List.hs index a628215c2..9f50c1182 100644 --- a/src/Handler/Tutorial/List.hs +++ b/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 diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs index 93b707a70..65fef8d50 100644 --- a/src/Handler/Utils/Form.hs +++ b/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 - [sqlQQ| - SELECT room FROM ( - SELECT DISTINCT ON (room) - j.value #>> '{room,text}' AS room - , t.@{TutorialLastChanged} AS changed - FROM ^{Tutorial} AS t - , jsonb_array_elements((@{TutorialTime}->'exceptions') || (@{TutorialTime}->'scheduled')) AS j - ORDER BY 1, 2 DESC - ) AS sq - WHERE room IS NOT NULL - ORDER BY changed DESC - LIMIT 7; - |] ) - $logDebugS "Room" $ mconcat suggsRaw + -- suggsRaw :: [Text] <- $(memcachedByHere) (Just $ Right $ 30 * diffSecond) ("rooms-recently-used"::Text) (E.unSingle <<$>> runDB + suggsRaw :: [Text] <- $(memcachedHere) (Just $ Right $ 42 * diffSecond) $ catchAllMonoid $ E.unSingle <<$>> runDB + [sqlQQ| + SELECT room FROM ( + SELECT DISTINCT ON (room) + j.value #>> '{room,text}' AS room + , t.@{TutorialLastChanged} AS changed + FROM ^{Tutorial} AS t + , jsonb_array_elements((@{TutorialTime}->'exceptions') || (@{TutorialTime}->'scheduled')) AS j + ORDER BY 1, 2 DESC + ) AS sq + WHERE room IS NOT NULL + ORDER BY changed DESC + LIMIT 7; + |] + -- $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 diff --git a/src/Handler/Utils/Form/Occurrences.hs b/src/Handler/Utils/Form/Occurrences.hs index 5bc3f5dff..c37368891 100644 --- a/src/Handler/Utils/Form/Occurrences.hs +++ b/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 MsgOccurrenceEnd & addName (nudge "occur-end")) Nothing - <*> roomReferenceForm' Nothing (fslI MsgTableTutorialRoom & addName (nudge "occur-room")) Nothing + <*> apreq timeFieldTypeTime (fslI MsgOccurrenceStart & addName (nudge "occur-start")) Nothing + <*> apreq timeFieldTypeTime (fslI MsgOccurrenceEnd & addName (nudge "occur-end" )) 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 MsgOccurrenceEnd & addName (nudge "occur-end")) Nothing - <*> roomReferenceForm' Nothing (fslI MsgTableTutorialRoom & addName (nudge "occur-room")) Nothing + <*> apreq timeFieldTypeTime (fslI MsgOccurrenceStart & addName (nudge "occur-start")) Nothing + <*> apreq timeFieldTypeTime (fslI MsgOccurrenceEnd & addName (nudge "occur-end" )) Nothing + <*> roomReferenceFormOpt (fslI MsgTableTutorialRoom & addName (nudge "occur-room" )) (Just Nothing) -- <*> aopt roomReferenceSimpleField (fslI MsgTableTutorialRoom & addName (nudge "occur-room")) Nothing ) , ( ExceptionKindNoOccur diff --git a/src/Utils.hs b/src/Utils.hs index 80b54245d..ab779de78 100644 --- a/src/Utils.hs +++ b/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 diff --git a/templates/tutorial-participants.hamlet b/templates/tutorial-participants.hamlet index ef2d80c93..8886de37a 100644 --- a/templates/tutorial-participants.hamlet +++ b/templates/tutorial-participants.hamlet @@ -6,7 +6,7 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
    -
    _{MsgTableTutorialTime} +
    _{MsgTableTutorialOccurrence}
    ^{occurrencesWidget tutorialRoomHidden tutorialTime}
    _{MsgTableTutorialTutors} diff --git a/templates/widgets/occurrence/cell/except-occur.hamlet b/templates/widgets/occurrence/cell/except-occur.hamlet index f75f8f00c..f17dbce9d 100644 --- a/templates/widgets/occurrence/cell/except-occur.hamlet +++ b/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