88 lines
4.1 KiB
Haskell
88 lines
4.1 KiB
Haskell
{-# OPTIONS_GHC -Wwarn #-}
|
|
|
|
module Handler.Course
|
|
( module Handler.Course
|
|
) where
|
|
|
|
import Import
|
|
|
|
import qualified Database.Esqueleto as E
|
|
import qualified Database.Persist as P
|
|
|
|
import Handler.Course.Communication as Handler.Course
|
|
import Handler.Course.Delete as Handler.Course
|
|
import Handler.Course.Edit as Handler.Course
|
|
import Handler.Course.LecturerInvite as Handler.Course
|
|
import Handler.Course.List as Handler.Course
|
|
import Handler.Course.ParticipantInvite as Handler.Course
|
|
import Handler.Course.Register as Handler.Course
|
|
import Handler.Course.Show as Handler.Course
|
|
import Handler.Course.User as Handler.Course
|
|
import Handler.Course.Users as Handler.Course
|
|
import Handler.Course.Application as Handler.Course
|
|
import Handler.ExamOffice.Course as Handler.Course
|
|
import Handler.Course.News as Handler.Course
|
|
import Handler.Course.Events as Handler.Course
|
|
import Handler.Sheet.PersonalisedFiles as Handler.Course (getCPersonalFilesR)
|
|
|
|
|
|
getCHiWisR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
|
|
getCHiWisR = error "CHiWisR: Not implemented"
|
|
|
|
getCNotesR, postCNotesR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
|
|
-- NOTE: The route getNotesR is abused for correctorORlecturer access rights!
|
|
-- PROBLEM: Correctors usually don't know Participants by name (anonymous), maybe notes are not shared?
|
|
-- If they are shared, adjust MsgCourseUserNoteTooltip
|
|
getCNotesR = postCNotesR
|
|
postCNotesR _ _ _ = defaultLayout [whamlet|You have corrector access to this course.|]
|
|
|
|
postCFavouriteR :: TermId -> SchoolId -> CourseShorthand -> Handler ()
|
|
postCFavouriteR tid ssh csh = void $ do
|
|
muid <- maybeAuthPair
|
|
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
|
|
redirect $ CourseR tid ssh csh CShowR
|