fradrive/src/Handler/Course.hs
2022-12-13 19:39:37 +01:00

72 lines
3.1 KiB
Haskell

-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Wolfgang Witt <Wolfgang.Witt@campus.lmu.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later
module Handler.Course
( module Handler.Course
) where
import Import
import qualified Database.Esqueleto.Legacy 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.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.|]
-- simple redirect for now to avoid running into HTTP method not supported.
getCFavouriteR :: TermId -> SchoolId -> CourseShorthand -> Handler ()
getCFavouriteR tid ssh csh = redirect $ CourseR tid ssh csh CShowR
postCFavouriteR :: TermId -> SchoolId -> CourseShorthand -> Handler ()
postCFavouriteR tid ssh csh = void $ do
authPair@(uid, _) <- requireAuthPair
runDB $ void $ do
cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
now <- liftIO getCurrentTime
-- should never return FavouriteCurrent
newReason <- storedFavouriteReason tid ssh csh (Just authPair) <&> (\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
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
-- show course page again
redirect $ CourseR tid ssh csh CShowR