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

Merge branch 'master' into exam-office

Browse Source
This commit is contained in:
Gregor Kleen 2019-09-16 09:40:03 +02:00
commit 174c8c2bff
1 changed files with 48 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
src/Foundation.hs
View File

@ -2422,7 +2422,22 @@ pageActions (CourseR tid ssh csh CShowR) =
, menuItemIcon = Just "user-graduate"
, menuItemRoute = SomeRoute $ CourseR tid ssh csh CUsersR
, menuItemModal = False
, menuItemAccessCallback' = return True
, menuItemAccessCallback' = do
now <- liftIO getCurrentTime
let courseWhere course = course <$ do
E.where_ $ course E.^. CourseTerm E.==. E.val tid
E.&&. course E.^. CourseSchool E.==. E.val ssh
E.&&. course E.^. CourseShorthand E.==. E.val csh
hasActiveAllocation = E.selectExists . E.from $ \(course `E.InnerJoin` allocationCourse `E.InnerJoin` allocation) -> do
E.on $ allocation E.^. AllocationId E.==. allocationCourse E.^. AllocationCourseAllocation
E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
void $ courseWhere course
E.where_ $ E.maybe E.false (E.<=. E.val now) (allocation E.^. AllocationRegisterByStaffFrom)
E.||. E.maybe E.false (E.<=. E.val now) (allocation E.^. AllocationRegisterByCourse)
hasParticipants = E.selectExists . E.from $ \(course `E.InnerJoin` courseParticipant) -> do
E.on $ course E.^. CourseId E.==. courseParticipant E.^. CourseParticipantCourse
void $ courseWhere course
runDB $ (not <$> hasActiveAllocation) `or2M` hasParticipants
}
, MenuItem
{ menuItemType = PageActionSecondary
@ -2559,6 +2574,28 @@ pageActions (CourseR tid ssh csh CUsersR) =
, menuItemModal = True
, menuItemAccessCallback' = return True
}
, MenuItem
{ menuItemType = PageActionPrime
, menuItemLabel = MsgMenuCourseApplications
, menuItemIcon = Nothing
, menuItemRoute = SomeRoute $ CourseR tid ssh csh CApplicationsR
, menuItemModal = False
, menuItemAccessCallback' =
let courseWhere course = course <$ do
E.where_ $ course E.^. CourseTerm E.==. E.val tid
E.&&. course E.^. CourseSchool E.==. E.val ssh
E.&&. course E.^. CourseShorthand E.==. E.val csh
existsApplications = E.selectExists . E.from $ \(course `E.InnerJoin` courseApplication) -> do
E.on $ course E.^. CourseId E.==. courseApplication E.^. CourseApplicationCourse
void $ courseWhere course
courseApplications = fmap (any E.unValue) . E.select . E.from $ \course -> do
void $ courseWhere course
return $ course E.^. CourseApplicationsRequired
courseAllocation = E.selectExists . E.from $ \(course `E.InnerJoin` allocationCourse) -> do
E.on $ course E.^. CourseId E.==. allocationCourse E.^. AllocationCourseCourse
void $ courseWhere course
in runDB $ courseAllocation `or2M` courseApplications `or2M` existsApplications
}
]
pageActions (CourseR tid ssh csh MaterialListR) =
[ MenuItem
@ -2875,6 +2912,16 @@ pageActions (CourseR tid ssh csh CApplicationsR) =
return $ courseApplication E.^. CourseApplicationId
in runDB . runConduit $ appSource .| anyMC appAccess
}
, MenuItem
{ menuItemType = PageActionPrime
, menuItemLabel = MsgMenuCourseMembers
, menuItemIcon = Nothing
, menuItemRoute = SomeRoute $ CourseR tid ssh csh CUsersR
, menuItemModal = False
, menuItemAccessCallback' = runDB $ do
cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
exists [ CourseParticipantCourse ==. cid ]
}
]
pageActions (CorrectionsR) =
[ MenuItem