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

fix(schedule-opt): account for course schedule opt in course event opt

Browse Source
This commit is contained in:
Sarah Vaupel 2020-11-09 18:42:26 +01:00
parent 374cb6250d
commit cd450848a4
2 changed files with 24 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -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

8
templates/course.hamlet
View File

@ -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}