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

fix(course): add links between users & applications

Browse Source
This commit is contained in:
Gregor Kleen 2019-09-16 09:39:22 +02:00
parent 070c9282d6
commit edaca1b394
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

@ -2368,7 +2368,22 @@ pageActions (CourseR tid ssh csh CShowR) =
, menuItemIcon = Just "user-graduate" , menuItemIcon = Just "user-graduate"
, menuItemRoute = SomeRoute $ CourseR tid ssh csh CUsersR , menuItemRoute = SomeRoute $ CourseR tid ssh csh CUsersR
, menuItemModal = False , 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 , MenuItem
{ menuItemType = PageActionSecondary { menuItemType = PageActionSecondary
@ -2491,6 +2506,28 @@ pageActions (CourseR tid ssh csh CUsersR) =
, menuItemModal = True , menuItemModal = True
, menuItemAccessCallback' = return 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) = pageActions (CourseR tid ssh csh MaterialListR) =
[ MenuItem [ MenuItem
@ -2799,6 +2836,16 @@ pageActions (CourseR tid ssh csh CApplicationsR) =
return $ courseApplication E.^. CourseApplicationId return $ courseApplication E.^. CourseApplicationId
in runDB . runConduit $ appSource .| anyMC appAccess 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) = pageActions (CorrectionsR) =
[ MenuItem [ MenuItem