From edaca1b394b2eb624f4c2bedd4fcc7ef91b5c4f6 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Mon, 16 Sep 2019 09:39:22 +0200
Subject: [PATCH] fix(course): add links between users & applications

---
 src/Foundation.hs | 49 ++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 48 insertions(+), 1 deletion(-)

diff --git a/src/Foundation.hs b/src/Foundation.hs
index e62647c90..2b5edf783 100644
--- a/src/Foundation.hs
+++ b/src/Foundation.hs
@@ -2368,7 +2368,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
@@ -2491,6 +2506,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
@@ -2799,6 +2836,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