feat(exams): implement schedule-opt actions
This commit is contained in:
Sarah Vaupel
parent
551f64a842
commit
a6308544c8
@ -24,7 +24,7 @@ import Handler.Utils.Exam
|
||||
getEShowR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Handler Html
|
||||
getEShowR tid ssh csh examn = do
|
||||
cTime <- liftIO getCurrentTime
|
||||
mUid <- maybeAuthId
|
||||
mAuth <- maybeAuth
|
||||
|
||||
(Entity eId Exam{..}, School{..}, examParts, examVisible, (gradingVisible, gradingShown), (occurrenceAssignmentsVisible, occurrenceAssignmentsShown), results, result, bonus, occurrences, (registered, mayRegister), registeredCount, lecturerInfoShown, staffInfoShown, extraSchools) <- runDB $ do
|
||||
exam@(Entity eId Exam{..}) <- fetchExam tid ssh csh examn
|
||||
@ -40,21 +40,24 @@ getEShowR tid ssh csh examn = do
|
||||
|
||||
examParts <- sortOn (view $ _entityVal . _examPartNumber) <$> selectList [ ExamPartExam ==. eId ] [ Asc ExamPartName ]
|
||||
|
||||
resultsRaw <- for mUid $ \uid ->
|
||||
E.select . E.from $ \examPartResult -> do
|
||||
resultsRaw <- for mAuth $ \(Entity uid _) -> E.select . E.from $ \examPartResult -> do
|
||||
E.where_ $ examPartResult E.^. ExamPartResultUser E.==. E.val uid
|
||||
E.&&. examPartResult E.^. ExamPartResultExamPart `E.in_` E.valList (map entityKey examParts)
|
||||
return examPartResult
|
||||
let results = maybe Map.empty (\rs -> Map.fromList [ (examPartResultExamPart, res) | res@(Entity _ ExamPartResult{..}) <- rs ]) resultsRaw
|
||||
|
||||
result <- fmap join . for mUid $ getBy . UniqueExamResult eId
|
||||
bonus <- fmap join . for mUid $ getBy . UniqueExamBonus eId
|
||||
result <- fmap join . for mAuth $ getBy . UniqueExamResult eId . entityKey
|
||||
bonus <- fmap join . for mAuth $ getBy . UniqueExamBonus eId . entityKey
|
||||
|
||||
occurrencesRaw <- E.select . E.from $ \examOccurrence -> do
|
||||
occurrencesRaw <- E.select . E.from $ \(examOccurrence `E.LeftOuterJoin` examOccurrenceScheduleOpt) -> do
|
||||
E.on $ E.just (examOccurrence E.^. ExamOccurrenceId) E.==. examOccurrenceScheduleOpt E.?. ExamOccurrenceScheduleOptExamOccurrence
|
||||
E.where_ $ examOccurrence E.^. ExamOccurrenceExam E.==. E.val eId
|
||||
-- TODO: works for now, but can possibly be simplified
|
||||
E.&&. maybe E.true (\(Entity uid _) -> E.isNothing (examOccurrenceScheduleOpt E.?. ExamOccurrenceScheduleOptUser) E.||. examOccurrenceScheduleOpt E.?. ExamOccurrenceScheduleOptUser E.==. E.just (E.val uid)) mAuth
|
||||
|
||||
let
|
||||
registered
|
||||
| Just uid <- mUid
|
||||
| Just (Entity uid _) <- mAuth
|
||||
= E.exists . E.from $ \examRegistration ->
|
||||
E.where_ $ examRegistration E.^. ExamRegistrationExam E.==. E.val eId
|
||||
E.&&. examRegistration E.^. ExamRegistrationUser E.==. E.val uid
|
||||
@ -66,19 +69,19 @@ getEShowR tid ssh csh examn = do
|
||||
E.where_ $ examRegistration E.^. ExamRegistrationExam E.==. E.val eId
|
||||
E.&&. examRegistration E.^. ExamRegistrationOccurrence E.==. E.just (examOccurrence E.^. ExamOccurrenceId)
|
||||
E.orderBy [E.desc registered, E.asc $ examOccurrence E.^. ExamOccurrenceStart, E.asc $ examOccurrence E.^. ExamOccurrenceRoom]
|
||||
return (examOccurrence, registered, registeredCount)
|
||||
return (examOccurrence, registered, registeredCount, examOccurrenceScheduleOpt)
|
||||
|
||||
registeredCount <- fromIntegral <$> count [ ExamRegistrationExam ==. eId ]
|
||||
|
||||
registered <- for mUid $ getBy . UniqueExamRegistration eId
|
||||
registered <- for mAuth $ getBy . UniqueExamRegistration eId . entityKey
|
||||
mayRegister <- if
|
||||
| examOccurrenceRule == ExamRoomFifo -> anyM occurrencesRaw $ \(Entity _ ExamOccurrence{..}, _, _) ->
|
||||
| examOccurrenceRule == ExamRoomFifo -> anyM occurrencesRaw $ \(Entity _ ExamOccurrence{..}, _, _, _) ->
|
||||
hasWriteAccessTo . CExamR tid ssh csh examName $ ERegisterOccR examOccurrenceName
|
||||
| otherwise -> hasWriteAccessTo $ CExamR tid ssh csh examName ERegisterR
|
||||
|
||||
let occurrences = sortOn sortPred $ map (over _3 E.unValue . over _2 E.unValue) occurrencesRaw
|
||||
let occurrences = sortOn sortPred $ map (over _4 (fmap entityVal) . over _3 E.unValue . over _2 E.unValue) occurrencesRaw
|
||||
where
|
||||
sortPred (Entity _ ExamOccurrence{..}, registered', _)
|
||||
sortPred (Entity _ ExamOccurrence{..}, registered', _, _)
|
||||
= (Down $ registered' && not mayRegister, examOccurrenceStart, examOccurrenceRoom)
|
||||
|
||||
lecturerInfoShown <- hasReadAccessTo $ CExamR tid ssh csh examn EEditR
|
||||
@ -118,13 +121,13 @@ getEShowR tid ssh csh examn = do
|
||||
mayRegister' <- fmap ((Map.!) . Map.fromList) . for (Nothing : map Just occurrences) $ \case
|
||||
Nothing ->
|
||||
fmap (Nothing, ) . hasWriteAccessTo $ CExamR tid ssh csh examName ERegisterR
|
||||
Just (Entity occId ExamOccurrence{..}, _, _) ->
|
||||
Just (Entity occId ExamOccurrence{..}, _, _, _) ->
|
||||
fmap (Just occId, ) . hasWriteAccessTo . CExamR tid ssh csh examName $ ERegisterOccR examOccurrenceName
|
||||
|
||||
let examTimes = all (\(Entity _ ExamOccurrence{..}, _, _) -> Just examOccurrenceStart == examStart && examOccurrenceEnd == examEnd) occurrences
|
||||
let examTimes = all (\(Entity _ ExamOccurrence{..}, _, _, _) -> Just examOccurrenceStart == examStart && examOccurrenceEnd == examEnd) occurrences
|
||||
examRoom = do
|
||||
Entity _ primeOcc <- occurrences ^? _head . _1
|
||||
guard $ all (\(Entity _ occ, _, _) -> examOccurrenceRoom occ == examOccurrenceRoom primeOcc) occurrences
|
||||
guard $ all (\(Entity _ occ, _, _, _) -> examOccurrenceRoom occ == examOccurrenceRoom primeOcc) occurrences
|
||||
return $ examOccurrenceRoom primeOcc
|
||||
registerWidget mOcc
|
||||
| isRegistered <- is _Just $ join registered
|
||||
|
||||
@ -195,7 +195,7 @@ $if not (null occurrences)
|
||||
$if not occurrenceAssignmentsVisible
|
||||
\ ^{isVisible False}
|
||||
$of _
|
||||
<th .table__td>
|
||||
<th .table__th>
|
||||
$if not occurrenceAssignmentsVisible
|
||||
^{isVisible False}
|
||||
$if showRegisteredCount
|
||||
@ -203,8 +203,11 @@ $if not (null occurrences)
|
||||
_{MsgExamRegisteredCount}
|
||||
\ ^{isVisible False}
|
||||
<th .table__th>_{MsgExamRoomDescription}
|
||||
$if is _Just mAuth
|
||||
<th .table__th>
|
||||
_{MsgSchedule}
|
||||
<tbody>
|
||||
$forall (occurrence, registered, rCount) <- occurrences
|
||||
$forall (occurrence, registered, rCount, mEOScheduleOpt) <- occurrences
|
||||
$with Entity _occId ExamOccurrence{examOccurrenceName, examOccurrenceRoom, examOccurrenceStart, examOccurrenceEnd, examOccurrenceDescription} <- occurrence
|
||||
$with registerWdgt <- registerWidget (Just occurrence)
|
||||
<tr .table__row :markUnregisteredOccurrences (Just occurrence) && not registered:.occurrence--not-registered>
|
||||
@ -231,6 +234,14 @@ $if not (null occurrences)
|
||||
<td .table__td>
|
||||
$maybe desc <- examOccurrenceDescription
|
||||
#{desc}
|
||||
$maybe (Entity _ User{userScheduleOccurrenceDisplayDefault}) <- mAuth
|
||||
<td .table__td>
|
||||
<div .table__td-content>
|
||||
<a .btn .btn-primary href=@{CExamR tid ssh csh examn (EScheduleOptSetR examOccurrenceName (not (maybe userScheduleOccurrenceDisplayDefault examOccurrenceScheduleOptOpt mEOScheduleOpt)))}>
|
||||
_{bool MsgScheduleOptIn MsgScheduleOptOut (maybe userScheduleOccurrenceDisplayDefault examOccurrenceScheduleOptOpt mEOScheduleOpt)}
|
||||
$if is _Just mEOScheduleOpt
|
||||
<a .btn .btn-primary href=@{CExamR tid ssh csh examn (EScheduleOptDelR examOccurrenceName)}>
|
||||
_{MsgScheduleOptDelete}
|
||||
<tfoot>
|
||||
<tr .table__row .table__row--sum>
|
||||
$if occurrenceNamesShown
|
||||
|
||||
Reference in New Issue
Block a user