chore: remove special case for participants
This commit is contained in:
Wolfgang Witt
Gregor Kleen
parent
664c915065
commit
7896c0bb16
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Reference in New Issue
Block a user