diff --git a/src/Handler/Course/Show.hs b/src/Handler/Course/Show.hs index d8a5cddb2..b1f33ae5f 100644 --- a/src/Handler/Course/Show.hs +++ b/src/Handler/Course/Show.hs @@ -92,13 +92,30 @@ getCShowR tid ssh csh = do mayDelete <- hasWriteAccessTo $ CNewsR tid ssh csh cID CNDeleteR return (cID, n, visible, files, lastEditText, mayEditNews, mayDelete) + mCourseScheduleOpt <- case mbAuth of + Just (uid,_) -> lift $ getBy $ UniqueCourseScheduleOpt cid uid + Nothing -> return Nothing + events' <- fmap (sortOn $ courseEventTime . entityVal) . lift $ selectList [ CourseEventCourse ==. cid ] [] events <- forM events' $ \(Entity evId ev) -> do evId' <- encrypt evId - mScheduleOpt <- case mbAuth of + mCourseEventScheduleOpt <- case mbAuth of Just (aid,_) -> lift $ getBy $ UniqueCourseEventScheduleOpt evId aid Nothing -> return Nothing - return (evId', ev, entityVal <$> mScheduleOpt) + let + currentOpt = maybe + ( maybe + ( maybe + False + ((&&) (is _Just registration) . userScheduleOccurrenceDisplayDefault . view _2) + mbAuth + ) + (courseScheduleOptOpt . entityVal) + mCourseScheduleOpt + ) + (courseEventScheduleOptOpt . entityVal) + mCourseEventScheduleOpt + return (evId', ev, currentOpt, mCourseEventScheduleOpt) hasSubmissionGroups <- lift . E.selectExists . E.from $ \(submissionGroupUser `E.InnerJoin` submissionGroup) -> do E.on $ submissionGroupUser E.^. SubmissionGroupUserSubmissionGroup E.==. submissionGroup E.^. SubmissionGroupId @@ -113,10 +130,6 @@ getCShowR tid ssh csh = do mayReRegister <- lift . courseMayReRegister $ Entity cid course - 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 @@ -253,7 +266,7 @@ getCShowR tid ssh csh = do , length fs <= 3 , all (notElem pathSeparator . view _2) fs ] - hiddenEventNotes = all (\(_,CourseEvent{..},_) -> is _Nothing courseEventNote) events + hiddenEventNotes = all (\(_,CourseEvent{..},_,_) -> is _Nothing courseEventNote) events Course{courseVisibleFrom,courseVisibleTo} = course mayCreateNews <- hasWriteAccessTo $ CourseR tid ssh csh CNewsNewR mayCreateEvents <- hasWriteAccessTo $ CourseR tid ssh csh CEventsNewR diff --git a/templates/course.hamlet b/templates/course.hamlet index 96e90fd75..7fb570bed 100644 --- a/templates/course.hamlet +++ b/templates/course.hamlet @@ -269,7 +269,7 @@ $# $if NTop (Just 0) < NTop (courseCapacity course) _{MsgCourseEventActions} \ #{iconInvisible} - $forall (cID, CourseEvent{courseEventType, courseEventTime, courseEventRoom, courseEventNote}, mEventScheduleOpt) <- events + $forall (cID, CourseEvent{courseEventType, courseEventTime, courseEventRoom, courseEventNote}, courseEventCurrentOpt, mEventScheduleOpt) <- events toPathPiece cID}>
@@ -284,11 +284,11 @@ $# $if NTop (Just 0) < NTop (courseCapacity course)
#{courseEventNote} $# TODO: merge with actions column - $maybe (_, User{userScheduleOccurrenceDisplayDefault}) <- mbAuth + $if is _Just mbAuth
- - _{bool MsgScheduleOptIn MsgScheduleOptOut (maybe userScheduleOccurrenceDisplayDefault courseEventScheduleOptOpt mEventScheduleOpt)} + + _{bool MsgScheduleOptIn MsgScheduleOptOut courseEventCurrentOpt} $if is _Just mEventScheduleOpt _{MsgScheduleOptDelete}