fix(favourites): clear old favourites when changing max number

src/Foundation.hs

@@ -1510,6 +1510,35 @@ evalAccessCorrector :: (MonadThrow m, MonadHandler m, HandlerSite m ~ UniWorX)
 evalAccessCorrector tid ssh csh = evalAccess (CourseR tid ssh csh CNotesR) False
 
 
+updateFavourites :: forall m. (MonadHandler m, HandlerSite m ~ UniWorX)
+                 => Maybe (TermId, SchoolId, CourseShorthand) -- ^ Insert course into favourites, as appropriate
+                 -> ReaderT SqlBackend m ()
+updateFavourites cData = void . runMaybeT $ do
+  $logDebugS "updateFavourites" "Updating favourites"
+
+  now <- liftIO $ getCurrentTime
+  uid <- MaybeT $ liftHandler maybeAuthId
+  mcid  <- for cData $ \(tid, ssh, csh) -> MaybeT . getKeyBy $ TermSchoolCourseShort tid ssh csh
+  User{userMaxFavourites} <- MaybeT $ get uid
+
+  -- update Favourites
+  for_ mcid $ \cid ->
+    void . lift $ upsertBy
+      (UniqueCourseFavourite uid cid)
+      (CourseFavourite uid cid FavouriteVisited now)
+      [CourseFavouriteLastVisit =. now]
+  -- prune Favourites to user-defined size
+  oldFavs <- lift $ selectList [CourseFavouriteUser ==. uid] []
+  let deleteFavs = oldFavs
+        & sortOn ((courseFavouriteReason &&& Down . courseFavouriteLastVisit) . entityVal)
+        & drop userMaxFavourites
+        & filter ((<= FavouriteVisited) . courseFavouriteReason . entityVal)
+        & map entityKey
+  unless (null deleteFavs) $
+    lift $ deleteWhere [CourseFavouriteId <-. deleteFavs]
+
+
+
 -- Please see the documentation for the Yesod typeclass. There are a number
 -- of settings which can be configured by overriding methods here.
 instance Yesod UniWorX where
@@ -1544,27 +1573,7 @@ instance Yesod UniWorX where
             CourseR tid ssh csh _  -> do
               void . lift . runDB . runMaybeT $ do
                 guardM . lift $ (== Authorized) <$> evalAccessDB (CourseR tid ssh csh CShowR) False
-                $logDebugS "updateFavourites" "Updating favourites"
-
-                now <- liftIO $ getCurrentTime
-                uid <- MaybeT $ liftHandler maybeAuthId
-                cid  <- MaybeT . getKeyBy $ TermSchoolCourseShort tid ssh csh
-                User{userMaxFavourites} <- MaybeT $ get uid
-
-                -- update Favourites
-                void . lift $ upsertBy
-                  (UniqueCourseFavourite uid cid)
-                  (CourseFavourite uid cid FavouriteVisited now)
-                  [CourseFavouriteLastVisit =. now]
-                -- prune Favourites to user-defined size
-                oldFavs <- lift $ selectList [CourseFavouriteUser ==. uid] []
-                let deleteFavs = oldFavs
-                      & sortOn ((courseFavouriteReason &&& Down . courseFavouriteLastVisit) . entityVal)
-                      & drop userMaxFavourites
-                      & filter ((<= FavouriteVisited) . courseFavouriteReason . entityVal)
-                      & map entityKey
-                unless (null deleteFavs) $
-                  lift $ deleteWhere [CourseFavouriteId <-. deleteFavs]
+                lift . updateFavourites $ Just (tid, ssh, csh)
             _other -> return ()
         normalizeRouteMiddleware :: Handler a -> Handler a
         normalizeRouteMiddleware handler = (*> handler) . runMaybeT $ do

src/Handler/Profile.hs

@@ -278,6 +278,7 @@ postProfileR = do
         , UserNotificationSettings =. stgNotificationSettings
         , UserShowSex              =. stgShowSex
         ] ++ [ UserDisplayEmail =. stgDisplayEmail | userDisplayEmail == stgDisplayEmail ]
+      updateFavourites Nothing
       when (stgDisplayEmail /= userDisplayEmail) $ do
         queueDBJob $ JobChangeUserDisplayEmail uid stgDisplayEmail
         addMessageI Info $ MsgUserDisplayEmailChangeSent stgDisplayEmail