From 7896c0bb1632217cd400760257b41642d9b582b8 Mon Sep 17 00:00:00 2001 From: Wolfgang Witt Date: Tue, 6 Apr 2021 15:13:07 +0200 Subject: [PATCH] chore: remove special case for participants --- src/Handler/Course.hs | 34 ++++++++++++----------------- src/Handler/Course/Show.hs | 44 +++++++++----------------------------- 2 files changed, 24 insertions(+), 54 deletions(-) diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs index d263c7757..2a0e564b0 100644 --- a/src/Handler/Course.hs +++ b/src/Handler/Course.hs @@ -48,32 +48,26 @@ postCFavouriteR tid ssh csh = void $ do now <- liftIO getCurrentTime -- Nothing means blacklist -- should never return FavouriteCurrent - (maybeReason, blacklist) <- storedFavouriteReason tid ssh csh muid >>= pure . \case - -- Maybe (Maybe reason, blacklist, associated) - Nothing -> (Just FavouriteManual, False) - -- participants can't remove favourite (only toggle between automatic/manual) - Just (Just FavouriteManual, _blacklist, True) -> (Just FavouriteVisited, False) - Just (_reason, _blacklist, True) -> (Just FavouriteManual, False) - Just (_reason, True, False) -> (Just FavouriteVisited, False) - Just (Just FavouriteManual, False, False) -> (Nothing, True) - Just (_reason, False, False) -> (Just FavouriteManual, False) + newReason <- storedFavouriteReason tid ssh csh muid >>= pure . \case + -- Maybe (Maybe reason, blacklist) + Nothing -> Just FavouriteManual + Just (_reason, True) -> Just FavouriteVisited + Just (Just FavouriteManual, False) -> Nothing + Just (_reason, False) -> Just FavouriteManual -- change stored reason in DB - if blacklist - then do + case newReason of + (Just reason) -> do + void $ E.upsertBy + (UniqueCourseFavourite uid cid) + (CourseFavourite uid cid reason now) + [P.Update CourseFavouriteReason reason P.Assign] + E.deleteBy $ UniqueCourseNoFavourite uid cid + Nothing -> do E.deleteBy $ UniqueCourseFavourite uid cid void $ E.upsertBy (UniqueCourseNoFavourite uid cid) (CourseNoFavourite uid cid) [] -- entry shouldn't exists, but keep it unchanged anyway - else do - case maybeReason of - (Just reason) -> void $ E.upsertBy - (UniqueCourseFavourite uid cid) - (CourseFavourite uid cid reason now) - [P.Update CourseFavouriteReason reason P.Assign] - -- [CourseFavouriteReason E.=. E.val reason] - Nothing -> E.deleteBy $ UniqueCourseFavourite uid cid - E.deleteBy $ UniqueCourseNoFavourite uid cid | otherwise -> pure () -- show course page again redirect $ CourseR tid ssh csh CShowR diff --git a/src/Handler/Course/Show.hs b/src/Handler/Course/Show.hs index 66b53bf74..df845f544 100644 --- a/src/Handler/Course/Show.hs +++ b/src/Handler/Course/Show.hs @@ -61,7 +61,7 @@ courseFavouriteToggleForm currentReason html -- Will never return FavouriteCurrent -- Nothing if no entry for current user (e.g. not logged in) storedFavouriteReason :: (MonadIO m) => TermId -> SchoolId -> CourseShorthand -> Maybe (AuthId UniWorX, AuthEntity UniWorX) - -> ReaderT SqlBackend m (Maybe (Maybe FavouriteReason, Bool, Bool)) + -> ReaderT SqlBackend m (Maybe (Maybe FavouriteReason, Bool)) storedFavouriteReason tid ssh csh muid = fmap unValueFirst . E.select . E.from $ \(course `E.LeftOuterJoin` courseFavourite) -> do E.on $ E.just (course E.^. CourseId) E.==. courseFavourite E.?. CourseFavouriteCourse E.&&. courseFavourite E.?. CourseFavouriteUser E.==. E.val (view _1 <$> muid) @@ -72,36 +72,13 @@ storedFavouriteReason tid ssh csh muid = fmap unValueFirst . E.select . E.from $ let isBlacklist = E.exists . E.from $ \courseNoFavourite -> E.where_ $ E.just (courseNoFavourite E.^. CourseNoFavouriteUser) E.==. E.val (view _1 <$> muid) E.&&. courseNoFavourite E.^. CourseNoFavouriteCourse E.==. course E.^. CourseId - isParticipant = E.exists . E.from $ \participant -> - E.where_ $ participant E.^. CourseParticipantCourse E.==. course E.^. CourseId - E.&&. E.just (participant E.^. CourseParticipantUser) E.==. E.val (view _1 <$> muid) - E.&&. participant E.^. CourseParticipantState E.==. E.val CourseParticipantActive - isLecturer = E.exists . E.from $ \lecturer -> - E.where_ $ lecturer E.^. LecturerCourse E.==. course E.^. CourseId - E.&&. E.just (lecturer E.^. LecturerUser) E.==. E.val (view _1 <$> muid) - isCorrector = E.exists . E.from $ \(corrector `E.InnerJoin` sheet) -> do - E.on $ corrector E.^. SheetCorrectorSheet E.==. sheet E.^. SheetId - E.&&. sheet E.^. SheetCourse E.==. course E.^. CourseId - E.where_ $ E.just (corrector E.^. SheetCorrectorUser) E.==. E.val (view _1 <$> muid) - isTutor = E.exists . E.from $ \(tutor `E.InnerJoin` tutorial) -> do - E.on $ tutor E.^. TutorTutorial E.==. tutorial E.^. TutorialId - E.&&. tutorial E.^. TutorialCourse E.==. course E.^. CourseId - E.where_ $ E.just (tutor E.^. TutorUser) E.==. E.val (view _1 <$> muid) - isAssociated = isParticipant E.||. isLecturer E.||. isCorrector E.||. isTutor - reason :: (E.SqlExpr (E.Value (Maybe FavouriteReason)), E.SqlExpr (E.Value Bool), E.SqlExpr (E.Value Bool)) - reason = (courseFavourite E.?. CourseFavouriteReason, isBlacklist, isAssociated) - {- - reason :: E.SqlExpr (E.Value (Maybe FavouriteReason)) - reason = E.case_ - [ E.when_ isBlacklist E.then_ E.nothing, - E.when_ isAssociated E.then_ . E.just $ E.val FavouriteParticipant - ] (E.else_ . E.just $ E.coalesceDefault [courseFavourite E.?. CourseFavouriteReason] (E.val FavouriteVisited)) - -} + reason :: (E.SqlExpr (E.Value (Maybe FavouriteReason)), E.SqlExpr (E.Value Bool)) + reason = (courseFavourite E.?. CourseFavouriteReason, isBlacklist) pure reason where - unValueFirst :: [(E.Value (Maybe a), E.Value Bool, E.Value Bool)] -> Maybe (Maybe a, Bool, Bool) + unValueFirst :: [(E.Value (Maybe a), E.Value Bool)] -> Maybe (Maybe a, Bool) -- `over each E.unValue` doesn't work here, since E.unValue is monomorphised - unValueFirst = fmap (over _1 E.unValue . over _2 E.unValue . over _3 E.unValue) . listToMaybe + unValueFirst = fmap (over _1 E.unValue . over _2 E.unValue) . listToMaybe -- TODO add toggle Manual favorite Icon here getCShowR :: TermId -> SchoolId -> CourseShorthand -> Handler Html @@ -342,12 +319,11 @@ getCShowR tid ssh csh = do mayEdit <- hasWriteAccessTo $ CourseR tid ssh csh CEditR let favouriteReason = case favouriteReason' of - -- (reason, blacklist, associated) - (Just (_reason, _blacklist, True)) -> Just FavouriteParticipant - (Just (_reason, True, False)) -> Nothing - (Just (Just reason, False, False)) -> Just reason - (Just (Nothing, False, False)) -> Just FavouriteCurrent - Nothing -> Just FavouriteCurrent + -- (reason, blacklist) + (Just (_reason, True)) -> Nothing + (Just (Just reason, False)) -> Just reason + (Just (Nothing, False)) -> Just FavouriteCurrent + Nothing -> Just FavouriteCurrent favouriteToggleRes <- runFormPost $ courseFavouriteToggleForm favouriteReason let favouriteToggleWgt = favouriteToggleRes & \((_, favouriteToggleView), favouriteToggleEncoding) -> wrapForm favouriteToggleView def