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

feat(course-visibility): rework visibility check for ZA courses

Browse Source
This commit is contained in:
Sarah Vaupel 2020-08-02 16:15:54 +02:00
parent 7ce60a36f4
commit a16eb1ab91
1 changed files with 11 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
src/Handler/Allocation/Show.hs
View File

@ -12,6 +12,7 @@ import Handler.Allocation.Register
import Handler.Allocation.Application import Handler.Allocation.Application
import qualified Database.Esqueleto as E import qualified Database.Esqueleto as E
import qualified Database.Esqueleto.Utils as E
getAShowR :: TermId -> SchoolId -> AllocationShorthand -> Handler Html getAShowR :: TermId -> SchoolId -> AllocationShorthand -> Handler Html
@ -31,7 +32,7 @@ getAShowR tid ssh ash = do
resultIsRegistered = _4 . _Value resultIsRegistered = _4 . _Value
(Entity aId Allocation{..}, School{..}, isAnyLecturer, courses, registration) <- runDB $ do (Entity aId Allocation{..}, School{..}, isAnyLecturer, courses, registration) <- runDB $ do
alloc@(Entity aId Allocation{allocationSchool}) <- getBy404 $ TermSchoolAllocationShort tid ssh ash alloc@(Entity aId Allocation{allocationSchool,allocationRegisterFrom,allocationRegisterTo}) <- getBy404 $ TermSchoolAllocationShort tid ssh ash
school <- getJust allocationSchool school <- getJust allocationSchool
courses <- E.select . E.from $ \((allocationCourse `E.InnerJoin` course) `E.LeftOuterJoin` courseApplication `E.LeftOuterJoin` registration) -> do courses <- E.select . E.from $ \((allocationCourse `E.InnerJoin` course) `E.LeftOuterJoin` courseApplication `E.LeftOuterJoin` registration) -> do
@ -43,7 +44,15 @@ getAShowR tid ssh ash = do
E.&&. courseApplication E.?. CourseApplicationAllocation E.==. E.just (E.just $ E.val aId) E.&&. courseApplication E.?. CourseApplicationAllocation E.==. E.just (E.just $ E.val aId)
E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
E.where_ $ allocationCourse E.^. AllocationCourseAllocation E.==. E.val aId E.where_ $ allocationCourse E.^. AllocationCourseAllocation E.==. E.val aId
E.&&. mayViewCourse' muid ata now course E.&&. (mayViewCourse' muid ata now course
E.||. E.isJust (courseApplication E.?. CourseApplicationId)
E.||. (E.isJust (E.val allocationRegisterFrom)
E.&&. E.val allocationRegisterFrom E.<=. E.val (Just now)
E.&&. (E.isNothing (E.val allocationRegisterTo)
E.||. E.val (Just now) E.<=. E.val allocationRegisterTo
)
)
)
E.orderBy [E.asc $ course E.^. CourseName] E.orderBy [E.asc $ course E.^. CourseName]
let hasTemplate = E.exists . E.from $ \courseAppInstructionFile -> let hasTemplate = E.exists . E.from $ \courseAppInstructionFile ->
E.where_ $ courseAppInstructionFile E.^. CourseAppInstructionFileCourse E.==. course E.^. CourseId E.where_ $ courseAppInstructionFile E.^. CourseAppInstructionFileCourse E.==. course E.^. CourseId