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

feat(schedule-opts): add course schedule opt actions to CShowR

Browse Source
This commit is contained in:
Sarah Vaupel 2020-11-09 11:30:53 +01:00
parent 2ceced4b64
commit bab72a5e2e
2 changed files with 15 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/Handler/Course/Show.hs
View File

@ -28,7 +28,7 @@ getCShowR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
getCShowR tid ssh csh = do getCShowR tid ssh csh = do
mbAuth <- maybeAuthPair mbAuth <- maybeAuthPair
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
(cid,course,courseVisible,schoolName,participants,registration,lecturers,assistants,correctors,tutors,mAllocation,hasApplicationTemplate,mApplication,news,events,submissionGroup,hasAllocationRegistrationOpen,mayReRegister) <- runDB . maybeT notFound $ do (cid,course,courseVisible,schoolName,participants,registration,lecturers,assistants,correctors,tutors,mAllocation,hasApplicationTemplate,mApplication,news,events,submissionGroup,hasAllocationRegistrationOpen,mayReRegister,mCourseScheduleOpt) <- runDB . maybeT notFound $ do
[(E.Entity cid course, E.Value courseVisible, E.Value schoolName, E.Value participants, fmap entityVal -> registration, E.Value hasAllocationRegistrationOpen)] [(E.Entity cid course, E.Value courseVisible, E.Value schoolName, E.Value participants, fmap entityVal -> registration, E.Value hasAllocationRegistrationOpen)]
<- lift . E.select . E.from $ <- lift . E.select . E.from $
\((school `E.InnerJoin` course) `E.LeftOuterJoin` participant) -> do \((school `E.InnerJoin` course) `E.LeftOuterJoin` participant) -> do
@ -113,7 +113,11 @@ getCShowR tid ssh csh = do
mayReRegister <- lift . courseMayReRegister $ Entity cid course mayReRegister <- lift . courseMayReRegister $ Entity cid course
return (cid,course,courseVisible,schoolName,participants,registration,lecturers,assistants,correctors,tutors,mAllocation,hasApplicationTemplate,mApplication,news,events,submissionGroup,hasAllocationRegistrationOpen,mayReRegister) mCourseScheduleOpt <- case mbAuth of
Just (uid,_) -> lift $ getBy $ UniqueCourseScheduleOpt cid uid
Nothing -> return Nothing
return (cid,course,courseVisible,schoolName,participants,registration,lecturers,assistants,correctors,tutors,mAllocation,hasApplicationTemplate,mApplication,news,events,submissionGroup,hasAllocationRegistrationOpen,mayReRegister,mCourseScheduleOpt)
let mDereg' = maybe id min (allocationOverrideDeregister =<< mAllocation) <$> courseDeregisterUntil course let mDereg' = maybe id min (allocationOverrideDeregister =<< mAllocation) <$> courseDeregisterUntil course
mDereg <- traverse (formatTime SelFormatDateTime) mDereg' mDereg <- traverse (formatTime SelFormatDateTime) mDereg'

9
templates/course.hamlet
View File

@ -315,3 +315,12 @@ $# $if NTop (Just 0) < NTop (courseCapacity course)
<dd .deflist__dd> <dd .deflist__dd>
^{tutorialTable} ^{tutorialTable}
$maybe (_, User{userScheduleOccurrenceDisplayDefault}) <- mbAuth
<dt .deflist__dt>
_{MsgScheduleOptActions}
<dd .deflist__dd>
<a .btn .btn-primary href=@{CourseR tid ssh csh (CScheduleOptSetR (not (maybe userScheduleOccurrenceDisplayDefault (courseScheduleOptOpt . entityVal) mCourseScheduleOpt)))}>
_{bool MsgCourseScheduleOptIn MsgCourseScheduleOptOut (maybe userScheduleOccurrenceDisplayDefault (courseScheduleOptOpt . entityVal) mCourseScheduleOpt)}
$if is _Just mCourseScheduleOpt
<a .btn .btn-primary href=@{CourseR tid ssh csh CScheduleOptDelR}>
_{MsgCourseScheduleOptDelete}