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): use should-be-displayed result for exam occurrence actions

Browse Source
This commit is contained in:
Sarah Vaupel 2020-11-10 21:24:00 +01:00
parent 3919152ede
commit 265d5f3ddd
2 changed files with 18 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
src/Handler/Exam/Show.hs
View File

@ -20,11 +20,14 @@ import qualified Data.CaseInsensitive as CI
import Handler.Utils
import Handler.Utils.Exam
import Utils.Schedule
getEShowR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Handler Html
getEShowR tid ssh csh examn = do
cTime <- liftIO getCurrentTime
mAuth <- maybeAuth
ata <- getSessionActiveAuthTags
(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
@ -49,13 +52,16 @@ getEShowR tid ssh csh examn = do
result <- fmap join . for mAuth $ getBy . UniqueExamResult eId . entityKey
bonus <- fmap join . for mAuth $ getBy . UniqueExamBonus eId . entityKey
occurrencesRaw <- E.select . E.from $ \(examOccurrence `E.LeftOuterJoin` examOccurrenceScheduleOpt) -> do
occurrencesRaw <- E.select . E.from $ \(course `E.InnerJoin` ex `E.InnerJoin` (examOccurrence `E.LeftOuterJoin` examOccurrenceScheduleOpt)) -> do
E.on $ course E.^. CourseId E.==. ex E.^. ExamCourse
E.on $ ex E.^. ExamId E.==. examOccurrence E.^. ExamOccurrenceExam
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
shouldBeDisplayedInSchedule = examOccurrenceShouldBeDisplayedInSchedule (entityKey <$> mAuth) ata cTime course ex examOccurrence
registered
| Just (Entity uid _) <- mAuth
= E.exists . E.from $ \examRegistration ->
@ -69,19 +75,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, examOccurrenceScheduleOpt)
return (examOccurrence, registered, registeredCount, shouldBeDisplayedInSchedule, examOccurrenceScheduleOpt)
registeredCount <- fromIntegral <$> count [ ExamRegistrationExam ==. 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 _4 (fmap entityVal) . over _3 E.unValue . over _2 E.unValue) occurrencesRaw
let occurrences = sortOn sortPred $ map (over _5 (fmap entityVal) . over _4 E.unValue . 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
@ -121,13 +127,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

8
templates/exam-show.hamlet
View File

@ -207,7 +207,7 @@ $if not (null occurrences)
<th .table__th>
_{MsgSchedule}
<tbody>
$forall (occurrence, registered, rCount, mEOScheduleOpt) <- occurrences
$forall (occurrence, registered, rCount, shouldBeDisplayedInSchedule, 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>
@ -234,11 +234,11 @@ $if not (null occurrences)
<td .table__td>
$maybe desc <- examOccurrenceDescription
#{desc}
$maybe (Entity _ User{userScheduleOccurrenceDisplayDefault}) <- mAuth
$if is _Just mAuth
<td .table__td>
<div .table__td-content>
<a .btn .btn-primary href=@{CExamR tid ssh csh examn (EScheduleOptSetR examOccurrenceName (not (maybe (registered && userScheduleOccurrenceDisplayDefault) examOccurrenceScheduleOptOpt mEOScheduleOpt)))}>
_{bool MsgScheduleOptIn MsgScheduleOptOut (maybe (registered && userScheduleOccurrenceDisplayDefault) examOccurrenceScheduleOptOpt mEOScheduleOpt)}
<a .btn .btn-primary href=@{CExamR tid ssh csh examn (EScheduleOptSetR examOccurrenceName (not shouldBeDisplayedInSchedule))}>
_{bool MsgScheduleOptIn MsgScheduleOptOut shouldBeDisplayedInSchedule}
$if is _Just mEOScheduleOpt
<a .btn .btn-primary href=@{CExamR tid ssh csh examn (EScheduleOptDelR examOccurrenceName)}>
_{MsgScheduleOptDelete}