fraport/fradrive-old
Archived
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

chore: implement favourite/blacklist toggle

Browse Source
This commit is contained in:
Wolfgang Witt 2021-04-06 14:49:59 +02:00 committed by Gregor Kleen
parent 3f48d5aa0c
commit 91a7e11987
1 changed files with 47 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

65
src/Handler/Course.hs
View File

@ -7,7 +7,7 @@ module Handler.Course
import Import import Import
import qualified Database.Esqueleto as E import qualified Database.Esqueleto as E
import qualified Database.Esqueleto.Utils as E import qualified Database.Persist as P
import Handler.Course.Communication as Handler.Course import Handler.Course.Communication as Handler.Course
import Handler.Course.Delete as Handler.Course import Handler.Course.Delete as Handler.Course
@ -37,22 +37,51 @@ getCNotesR = postCNotesR
postCNotesR _ _ _ = defaultLayout [whamlet|You have corrector access to this course.|] postCNotesR _ _ _ = defaultLayout [whamlet|You have corrector access to this course.|]
postCFavouriteR :: TermId -> SchoolId -> CourseShorthand -> Handler () postCFavouriteR :: TermId -> SchoolId -> CourseShorthand -> Handler ()
postCFavouriteR tid ssh csh = do postCFavouriteR tid ssh csh = void $ do
muid <- maybeAuthPair muid <- maybeAuthPair
-- TODO swap FavouriteReason here runDB $ void $ do
runDB $ do mcid <- fmap (fmap E.unValue . listToMaybe) . E.select . E.from $ \course -> do
-- Nothing means blacklist E.where_ $ course E.^. CourseTerm E.==. E.val tid
-- should never return FavouriteCurrent E.&&. course E.^. CourseSchool E.==. E.val ssh
-- Just (Maybe reason, blacklist, associated) E.&&. course E.^. CourseShorthand E.==. E.val csh
currentReason <- storedFavouriteReason tid ssh csh muid E.limit 1 -- we know that there is at most one match, but we tell the DB this info too
-- TODO change stored reason in DB pure $ course E.^. CourseId
-- TODO participants can't remove favourite (only toggle between automatic/manual)? if | Just cid <- mcid, Just uid <- view _1 <$> muid -> do
pure () now <- liftIO getCurrentTime
-- Nothing means blacklist
-- TODO participants can't remove favourite? -- should never return FavouriteCurrent
liftIO $ do (maybeReason, blacklist) <- storedFavouriteReason tid ssh csh muid >>= pure . \case
putStrLn "\nswapping FavouriteReason" -- Maybe (Maybe reason, blacklist, associated)
print (tid, ssh, csh) 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)
-- change stored reason in DB
before <- storedFavouriteReason tid ssh csh muid
if blacklist
then 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
after <- storedFavouriteReason tid ssh csh muid
liftIO $ do
putStrLn $ "before: " <> pack (show before)
putStrLn $ "after: " <> pack (show after)
print (maybeReason, blacklist)
| otherwise -> pure ()
-- show course page again -- show course page again
void $ redirect $ CourseR tid ssh csh CShowR redirect $ CourseR tid ssh csh CShowR
-- TODO Route for Icon to toggle manual Favorite