From cd450848a42094ec67a75ac8bb01f11a6f240942 Mon Sep 17 00:00:00 2001
From: Sarah Vaupel <>
Date: Mon, 9 Nov 2020 18:42:26 +0100
Subject: [PATCH] fix(schedule-opt): account for course schedule opt in course
 event opt

---
 src/Handler/Course/Show.hs | 27 ++++++++++++++++++++-------
 templates/course.hamlet    |  8 ++++----
 2 files changed, 24 insertions(+), 11 deletions(-)

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}
             <tbody>
-              $forall (cID, CourseEvent{courseEventType, courseEventTime, courseEventRoom, courseEventNote}, mEventScheduleOpt) <- events
+              $forall (cID, CourseEvent{courseEventType, courseEventTime, courseEventRoom, courseEventNote}, courseEventCurrentOpt, mEventScheduleOpt) <- events
                 <tr .table__row ##{"event-" <> toPathPiece cID}>
                   <td .table__td>
                     <div .table__td-content>
@@ -284,11 +284,11 @@ $#    $if NTop (Just 0) < NTop (courseCapacity course)
                     <div .table__td-content>
                       #{courseEventNote}
                   $# TODO: merge with actions column
-                  $maybe (_, User{userScheduleOccurrenceDisplayDefault}) <- mbAuth
+                  $if is _Just mbAuth
                     <td .table__td>
                       <div .table__td-content>
-                        <a .btn .btn-primary href=@{CEventR tid ssh csh cID (CEvScheduleOptSetR (not (maybe userScheduleOccurrenceDisplayDefault courseEventScheduleOptOpt mEventScheduleOpt)))}>
-                          _{bool MsgScheduleOptIn MsgScheduleOptOut (maybe userScheduleOccurrenceDisplayDefault courseEventScheduleOptOpt mEventScheduleOpt)}
+                        <a .btn .btn-primary href=@{CEventR tid ssh csh cID (CEvScheduleOptSetR (not courseEventCurrentOpt))}>
+                          _{bool MsgScheduleOptIn MsgScheduleOptOut courseEventCurrentOpt}
                         $if is _Just mEventScheduleOpt
                           <a .btn .btn-primary href=@{CEventR tid ssh csh cID CEvScheduleOptDelR}>
                             _{MsgScheduleOptDelete}