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