feat(course-events): implement opt toggle on CShowR
This commit is contained in:
Sarah Vaupel
parent
868a4afcc6
commit
5f9aad8aa9
@ -137,10 +137,12 @@ ScheduleOffsetWeekForwardDay: 1 Tag vorwärts
|
||||
ScheduleOffsetWeekForwardWeek: 1 Woche vorwärts
|
||||
|
||||
ScheduleOptActions: Terminübersicht
|
||||
ScheduleOptOut: Opt-Out
|
||||
ScheduleOptIn: Opt-In
|
||||
ScheduleOptOut: Deabonnieren
|
||||
ScheduleOptIn: Abonnieren
|
||||
|
||||
ScheduleOptSuccess: Terminübersichts-Ausnahme gespeichert
|
||||
ScheduleOptOutSuccess: Termin erfolgreich deabonniert
|
||||
ScheduleOptInSuccess: Termin erfolgreich abonniert
|
||||
ScheduleOptDeleteSuccess: Terminabonnement erfolgreich auf Standard zurückgesetzt
|
||||
|
||||
ScheduleReset: Standard
|
||||
|
||||
|
||||
@ -138,10 +138,12 @@ ScheduleOffsetWeekForwardDay: 1 day forward
|
||||
ScheduleOffsetWeekForwardWeek: 1 week forward
|
||||
|
||||
ScheduleOptActions: Schedule
|
||||
ScheduleOptOut: Opt out
|
||||
ScheduleOptIn: Opt in
|
||||
ScheduleOptOut: Unsubscribe
|
||||
ScheduleOptIn: Subscribe
|
||||
|
||||
ScheduleOptSuccess: Schedule exception successfully saved
|
||||
ScheduleOptOutSuccess: Successfully unsubscribed from occurrence
|
||||
ScheduleOptInSuccess: Successfully subscribed to occurrence
|
||||
ScheduleOptDeleteSuccess: Successfully reset occurrence subscription to default
|
||||
|
||||
ScheduleReset: Default
|
||||
|
||||
|
||||
@ -19,5 +19,5 @@ postCEvScheduleOptR tid ssh csh ceId opt = do
|
||||
[ CourseEventScheduleOptOpt =. opt
|
||||
]
|
||||
|
||||
addMessageI Success MsgScheduleOptSuccess
|
||||
addMessageI Success $ bool MsgScheduleOptOutSuccess MsgScheduleOptInSuccess opt
|
||||
redirect $ CourseR tid ssh csh CShowR
|
||||
|
||||
@ -26,14 +26,14 @@ import Handler.Exam.List (mkExamTable)
|
||||
|
||||
getCShowR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
|
||||
getCShowR tid ssh csh = do
|
||||
mbAid <- maybeAuthId
|
||||
mbAuth <- maybeAuthPair
|
||||
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
|
||||
[(E.Entity cid course, E.Value courseVisible, E.Value schoolName, E.Value participants, fmap entityVal -> registration, E.Value hasAllocationRegistrationOpen)]
|
||||
<- lift . E.select . E.from $
|
||||
\((school `E.InnerJoin` course) `E.LeftOuterJoin` participant) -> do
|
||||
E.on $ E.just (course E.^. CourseId) E.==. participant E.?. CourseParticipantCourse
|
||||
E.&&. E.val mbAid E.==. participant E.?. CourseParticipantUser
|
||||
E.&&. E.val (fst <$> mbAuth) E.==. participant E.?. CourseParticipantUser
|
||||
E.&&. participant E.?. CourseParticipantState E.==. E.just (E.val CourseParticipantActive)
|
||||
E.on $ course E.^. CourseSchool E.==. school E.^. SchoolId
|
||||
E.where_ $ course E.^. CourseTerm E.==. E.val tid
|
||||
@ -74,7 +74,7 @@ getCShowR tid ssh csh = do
|
||||
return allocation
|
||||
hasApplicationTemplate <- lift . E.selectExists . E.from $ \courseAppInstructionFile ->
|
||||
E.where_ $ courseAppInstructionFile E.^. CourseAppInstructionFileCourse E.==. E.val cid
|
||||
mApplication <- lift . fmap (listToMaybe =<<) . for mbAid $ \uid -> selectList [CourseApplicationCourse ==. cid, CourseApplicationUser ==. uid, CourseApplicationAllocation ==. Nothing] []
|
||||
mApplication <- lift . fmap (listToMaybe =<<) . for mbAuth $ \(uid,_) -> selectList [CourseApplicationCourse ==. cid, CourseApplicationUser ==. uid, CourseApplicationAllocation ==. Nothing] []
|
||||
news' <- lift $ selectList [ CourseNewsCourse ==. cid ] [ Desc CourseNewsVisibleFrom, Desc CourseNewsTitle, Desc CourseNewsSummary, Desc CourseNewsContent ]
|
||||
cTime <- NTop . Just <$> liftIO getCurrentTime
|
||||
news <- forMaybeM news' $ \(Entity nId n@CourseNews{..}) -> do
|
||||
@ -93,12 +93,17 @@ getCShowR tid ssh csh = do
|
||||
return (cID, n, visible, files, lastEditText, mayEditNews, mayDelete)
|
||||
|
||||
events' <- fmap (sortOn $ courseEventTime . entityVal) . lift $ selectList [ CourseEventCourse ==. cid ] []
|
||||
events <- mapM (\(Entity evId ev) -> (, ev) <$> encrypt evId) events'
|
||||
events <- forM events' $ \(Entity evId ev) -> do
|
||||
evId' <- encrypt evId
|
||||
mScheduleOpt <- case mbAuth of
|
||||
Just (aid,_) -> lift $ getBy $ UniqueCourseEventScheduleOpt evId aid
|
||||
Nothing -> return Nothing
|
||||
return (evId', ev, entityVal <$> mScheduleOpt)
|
||||
|
||||
hasSubmissionGroups <- lift . E.selectExists . E.from $ \(submissionGroupUser `E.InnerJoin` submissionGroup) -> do
|
||||
E.on $ submissionGroupUser E.^. SubmissionGroupUserSubmissionGroup E.==. submissionGroup E.^. SubmissionGroupId
|
||||
E.where_ $ submissionGroup E.^. SubmissionGroupCourse E.==. E.val cid
|
||||
submissionGroup' <- lift . for mbAid $ \uid ->
|
||||
submissionGroup' <- lift . for mbAuth $ \(uid,_) ->
|
||||
fmap (listToMaybe . fmap E.unValue) . E.select . E.from $ \(submissionGroupUser `E.InnerJoin` submissionGroup) -> do
|
||||
E.on $ submissionGroupUser E.^. SubmissionGroupUserSubmissionGroup E.==. submissionGroup E.^. SubmissionGroupId
|
||||
E.where_ $ submissionGroup E.^. SubmissionGroupCourse E.==. E.val cid
|
||||
@ -117,7 +122,7 @@ getCShowR tid ssh csh = do
|
||||
mAllocation' <- for mAllocation $ \alloc@Allocation{..} -> (alloc, )
|
||||
<$> toTextUrl (AllocationR allocationTerm allocationSchool allocationShorthand AShowR :#: cID)
|
||||
regForm <- if
|
||||
| is _Just mbAid -> do
|
||||
| is _Just mbAuth -> do
|
||||
(courseRegisterForm', regButton) <- courseRegisterForm (Entity cid course)
|
||||
(regWidget, regEnctype) <- generateFormPost $ renderAForm FormStandard courseRegisterForm'
|
||||
return $ wrapForm' regButton regWidget def
|
||||
@ -170,9 +175,9 @@ getCShowR tid ssh csh = do
|
||||
return . toWidget $ tshow freeCapacity
|
||||
, sortable Nothing (mempty & cellAttrs <>~ pure ("uw-hide-columns--hider-label", mr MsgActionsHead)) $ \DBRow{ dbrOutput = Entity tutId Tutorial{..} } -> sqlCell $ do
|
||||
mayRegister <- (== Authorized) <$> evalAccessDB (CTutorialR tid ssh csh tutorialName TRegisterR) True
|
||||
isRegistered <- case mbAid of
|
||||
isRegistered <- case mbAuth of
|
||||
Nothing -> return False
|
||||
Just uid -> existsBy $ UniqueTutorialParticipant tutId uid
|
||||
Just (uid,_) -> existsBy $ UniqueTutorialParticipant tutId uid
|
||||
if
|
||||
| mayRegister -> do
|
||||
(tutRegisterForm, tutRegisterEnctype) <- liftHandler . generateFormPost . buttonForm' $ bool [BtnRegister] [BtnDeregister] isRegistered
|
||||
@ -219,7 +224,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
|
||||
|
||||
@ -260,7 +260,7 @@ $# $if NTop (Just 0) < NTop (courseCapacity course)
|
||||
_{MsgCourseEventRoom}
|
||||
<th .table__th uw-hide-column-header="note" :hiddenEventNotes:.course-event-note--hidden>
|
||||
_{MsgCourseEventNote}
|
||||
$if is _Just mbAid
|
||||
$if is _Just mbAuth
|
||||
<th .table__th uw-hide-column-header="schedule-actions">
|
||||
_{MsgScheduleOptActions}
|
||||
$if mayCreateEvents
|
||||
@ -268,7 +268,7 @@ $# $if NTop (Just 0) < NTop (courseCapacity course)
|
||||
_{MsgCourseEventActions}
|
||||
\ #{iconInvisible}
|
||||
<tbody>
|
||||
$forall (cID, CourseEvent{courseEventType, courseEventTime, courseEventRoom, courseEventNote}) <- events
|
||||
$forall (cID, CourseEvent{courseEventType, courseEventTime, courseEventRoom, courseEventNote}, mEventScheduleOpt) <- events
|
||||
<tr .table__row ##{"event-" <> toPathPiece cID}>
|
||||
<td .table__td>
|
||||
<div .table__td-content>
|
||||
@ -282,12 +282,11 @@ $# $if NTop (Just 0) < NTop (courseCapacity course)
|
||||
<td .table__td :hiddenEventNotes:.course-event-note--hidden>
|
||||
<div .table__td-content>
|
||||
#{courseEventNote}
|
||||
$if is _Just mbAid
|
||||
$maybe (_, User{userScheduleOccurrenceDisplayDefault}) <- mbAuth
|
||||
<td .table__td>
|
||||
<div .table__td-content>
|
||||
$# TODO: check for current opt-* and choose link and label accordingly
|
||||
<a href=@{CEventR tid ssh csh cID (CEvScheduleOptR False)} .btn .btn-primary>
|
||||
_{MsgScheduleOptOut}
|
||||
<a .btn .btn-primary href=@{CEventR tid ssh csh cID (CEvScheduleOptR (not (maybe userScheduleOccurrenceDisplayDefault courseEventScheduleOptOpt mEventScheduleOpt)))}>
|
||||
_{bool MsgScheduleOptIn MsgScheduleOptOut (maybe userScheduleOccurrenceDisplayDefault courseEventScheduleOptOpt mEventScheduleOpt)}
|
||||
$# TODO: add link to remove schedule opt-*
|
||||
$if mayCreateEvents
|
||||
<td .table__td>
|
||||
|
||||
Reference in New Issue
Block a user