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): fix should-be-displayed result

Browse Source
This commit is contained in:
Sarah Vaupel 2020-11-10 20:43:48 +01:00
parent ec04fe161e
commit 601cb3179f
1 changed files with 8 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -7,6 +7,7 @@ import Import
import Utils.Course
import Utils.Form
import Utils.Schedule
import Handler.Utils
import qualified Database.Esqueleto.Utils as E
import Database.Esqueleto.Utils.TH
@ -28,6 +29,8 @@ getCShowR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
getCShowR tid ssh csh = do
mbAuth <- maybeAuthPair
now <- liftIO getCurrentTime
ata <- getSessionActiveAuthTags
(cid,course,courseVisible,schoolName,participants,registration,lecturers,assistants,correctors,tutors,mAllocation,hasApplicationTemplate,mApplication,news,events,submissionGroup,hasAllocationRegistrationOpen, mCourseScheduleOpt, mayReRegister, (mayViewSheets, mayViewAnySheet), (mayViewMaterials, mayViewAnyMaterial)) <- 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 $
@ -100,11 +103,14 @@ getCShowR tid ssh csh = do
events' <- fmap (sortOn $ courseEventTime . entityVal) . lift $ selectList [ CourseEventCourse ==. cid ] []
events <- forM events' $ \(Entity evId ev) -> do
evId' <- encrypt evId
courseEventShouldBeDisplayedInSchedule <- lift $ E.select . E.from $ \(course `E.InnerJoin` courseEvent) -> courseEventShouldBeDisplayedInSchedule (view _1 <$> mbAuth) ata course courseEvent
shouldBeDisplayedInSchedule <- lift $ E.selectExists . E.from $ \(c `E.InnerJoin` cEv) -> do
E.on $ c E.^. CourseId E.==. cEv E.^. CourseEventCourse
E.where_ $ cEv E.^. CourseEventId E.==. E.val evId
E.&&. courseEventShouldBeDisplayedInSchedule (view _1 <$> mbAuth) ata c cEv
mCourseEventScheduleOpt <- case mbAuth of
Just (aid,_) -> lift $ getBy $ UniqueCourseEventScheduleOpt evId aid
Nothing -> return Nothing
return (evId', ev, courseEventShouldBeDisplayedInSchedule, mCourseEventScheduleOpt)
return (evId', ev, shouldBeDisplayedInSchedule, mCourseEventScheduleOpt)
hasSubmissionGroups <- lift . E.selectExists . E.from $ \(submissionGroupUser `E.InnerJoin` submissionGroup) -> do
E.on $ submissionGroupUser E.^. SubmissionGroupUserSubmissionGroup E.==. submissionGroup E.^. SubmissionGroupId