From 4bc48a50faf4fbecff14fd7e38a31503097d74d8 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Fri, 7 Feb 2020 00:22:28 +0100 Subject: [PATCH] feat(pageactions): restore pageactions --- src/Foundation.hs | 1510 ++++++++++++++++++++++++--------------------- 1 file changed, 809 insertions(+), 701 deletions(-) diff --git a/src/Foundation.hs b/src/Foundation.hs index 366529f27..b252668c9 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -2516,30 +2516,6 @@ pageActions (CourseR tid ssh csh CShowR) = do let showExamList = length examListExams <= examListBound let - navMembersChildren = - [ NavLink - { navLabel = MsgMenuCourseApplications - , navRoute = CourseR tid ssh csh CApplicationsR - , navAccess' = - 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 - , navType = NavTypeLink { navModal = False } - , navQuick' = navQuick NavQuickViewFavourite - , navForceActive = False - } - ] navMembers = NavPageActionPrimary { navLink = NavLink { navLabel = MsgMenuCourseMembers @@ -2558,7 +2534,7 @@ pageActions (CourseR tid ssh csh CShowR) = do , navQuick' = navQuick NavQuickViewFavourite , navForceActive = False } - , navChildren = navMembersChildren ++ membersSecondary + , navChildren = membersSecondary } showMembers <- maybeT (return False) $ True <$ navAccess navMembers @@ -2641,7 +2617,7 @@ pageActions (CourseR tid ssh csh CShowR) = do , navChildren = examListSecondary ++ guardOnM showExamList examListExams } , navMembers - ] ++ guardOnM (not showMembers) [ NavPageActionPrimary{ navLink, navChildren = [] } | navLink <- navMembersChildren] ++ + ] ++ guardOnM (not showMembers) [ NavPageActionPrimary{ navLink, navChildren = [] } | navLink <- membersSecondary ] ++ [ NavPageActionPrimary { navLink = NavLink { navLabel = MsgMenuCourseCommunication @@ -2651,7 +2627,7 @@ pageActions (CourseR tid ssh csh CShowR) = do , navQuick' = navQuick NavQuickViewFavourite , navForceActive = False } - , navChildren = tutorialListSecondary + , navChildren = [] } , NavPageActionSecondary { navLink = NavLink @@ -2702,687 +2678,819 @@ pageActions (CourseR tid ssh csh CShowR) = do } } ] -pageActions (CourseR tid ssh csh SheetListR) = return +pageActions (ExamOfficeR EOExamsR) = return [ NavPageActionPrimary { navLink = NavLink - { navLabel = MsgMenuSheetCurrent - , navRoute = CourseR tid ssh csh SheetCurrentR - , navAccess' = runDB . maybeT (return False) $ - True <$ MaybeT (sheetCurrent tid ssh csh) - , navType = NavTypeLink { navModal = False } - , navQuick' = navQuick NavQuickViewFavourite <> navQuick NavQuickViewPageActionSecondary + { navLabel = MsgMenuExamOfficeFields + , navRoute = ExamOfficeR EOFieldsR + , navAccess' = return True + , navType = NavTypeLink { navModal = True } + , navQuick' = mempty , navForceActive = False } , navChildren = [] - } -- TODO + } + , NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuExamOfficeUsers + , navRoute = ExamOfficeR EOUsersR + , navAccess' = return True + , navType = NavTypeLink { navModal = True } + , navQuick' = mempty + , navForceActive = False + } + , navChildren = [] + } ] +pageActions SchoolListR = return + [ NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuSchoolNew + , navRoute = SchoolNewR + , navAccess' = return True + , navType = NavTypeLink { navModal = False } + , navQuick' = mempty + , navForceActive = False + } + , navChildren = [] + } + ] +pageActions UsersR = return + [ NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuLecturerInvite + , navRoute = AdminNewFunctionaryInviteR + , navAccess' = return True + , navType = NavTypeLink { navModal = True } + , navQuick' = mempty + , navForceActive = False + } + , navChildren = [] + } + , NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuUserAdd + , navRoute = AdminUserAddR + , navAccess' = return True + , navType = NavTypeLink { navModal = True } + , navQuick' = mempty + , navForceActive = False + } + , navChildren = [] + } + ] +pageActions (AdminUserR cID) = return + [ NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuUserNotifications + , navRoute = UserNotificationR cID + , navAccess' = return True + , navType = NavTypeLink { navModal = True } + , navQuick' = mempty + , navForceActive = False + } + , navChildren = [] + } + , NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuUserPassword + , navRoute = UserPasswordR cID + , navAccess' = do + uid <- decrypt cID + User{userAuthentication} <- runDB $ get404 uid + return $ is _AuthPWHash userAuthentication + , navType = NavTypeLink { navModal = True } + , navQuick' = mempty + , navForceActive = False + } + , navChildren = [] + } + ] +pageActions InfoR = return + [ NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgInfoLecturerTitle + , navRoute = InfoLecturerR + , navAccess' = return True + , navType = NavTypeLink { navModal = False } + , navQuick' = mempty + , navForceActive = False + } + , navChildren = [] + } + , NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuLegal + , navRoute = LegalR + , navAccess' = return True + , navType = NavTypeLink { navModal = False } + , navQuick' = mempty + , navForceActive = False + } + , navChildren = [] + } + , NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuGlossary + , navRoute = GlossaryR + , navAccess' = return True + , navType = NavTypeLink { navModal = False } + , navQuick' = mempty + , navForceActive = False + } + , navChildren = [] + } + ] +pageActions VersionR = return + [ NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgInfoLecturerTitle + , navRoute = InfoLecturerR + , navAccess' = return True + , navType = NavTypeLink { navModal = False } + , navQuick' = mempty + , navForceActive = False + } + , navChildren = [] + } + , NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuLegal + , navRoute = LegalR + , navAccess' = return True + , navType = NavTypeLink { navModal = False } + , navQuick' = mempty + , navForceActive = False + } + , navChildren = [] + } + , NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuGlossary + , navRoute = GlossaryR + , navAccess' = return True + , navType = NavTypeLink { navModal = False } + , navQuick' = mempty + , navForceActive = False + } + , navChildren = [] + } + ] +pageActions HealthR = return + [ NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuInstance + , navRoute = InstanceR + , navAccess' = return True + , navType = NavTypeLink { navModal = False } + , navQuick' = mempty + , navForceActive = False + } + , navChildren = [] + } + ] +pageActions InstanceR = return + [ NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuHealth + , navRoute = HealthR + , navAccess' = return True + , navType = NavTypeLink { navModal = False } + , navQuick' = mempty + , navForceActive = False + } + , navChildren = [] + } + ] +pageActions HelpR = return + [ NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgInfoLecturerTitle + , navRoute = InfoLecturerR + , navAccess' = return True + , navType = NavTypeLink { navModal = False } + , navQuick' = mempty + , navForceActive = False + } + , navChildren = [] + } + , NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuGlossary + , navRoute = GlossaryR + , navAccess' = return True + , navType = NavTypeLink { navModal = False } + , navQuick' = mempty + , navForceActive = False + } + , navChildren = [] + } + ] +pageActions ProfileR = return + [ NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuProfileData + , navRoute = ProfileDataR + , navAccess' = return True + , navType = NavTypeLink { navModal = False } + , navQuick' = mempty + , navForceActive = False + } + , navChildren = [] + } + , NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuAuthPreds + , navRoute = AuthPredsR + , navAccess' = return True + , navType = NavTypeLink { navModal = True } + , navQuick' = mempty + , navForceActive = False + } + , navChildren = [] + } + ] +pageActions TermShowR = return + [ NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuTermCreate + , navRoute = TermEditR + , navAccess' = return True + , navType = NavTypeLink { navModal = False } + , navQuick' = mempty + , navForceActive = False + } + , navChildren = [] + } + , NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuParticipantsList + , navRoute = ParticipantsListR + , navAccess' = return True + , navType = NavTypeLink { navModal = False } + , navQuick' = mempty + , navForceActive = False + } + , navChildren = [] + } + ] +pageActions (AllocationR _tid _ssh _ash AShowR) = return + [ NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuAllocationInfo + , navRoute = InfoAllocationR + , navAccess' = return True + , navType = NavTypeLink { navModal = True } + , navQuick' = mempty + , navForceActive = False + } + , navChildren = [] + } + ] +pageActions CourseListR = return + [ NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuCourseNew + , navRoute = CourseNewR + , navAccess' = return True + , navType = NavTypeLink { navModal = False } + , navQuick' = mempty + , navForceActive = False + } + , navChildren = [] + } + , NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuAllocationList + , navRoute = AllocationListR + , navAccess' = return True + , navType = NavTypeLink { navModal = False } + , navQuick' = mempty + , navForceActive = False + } + , navChildren = [] + } + , NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuParticipantsList + , navRoute = ParticipantsListR + , navAccess' = return True + , navType = NavTypeLink { navModal = False } + , navQuick' = mempty + , navForceActive = False + } + , navChildren = [] + } + ] +pageActions CourseNewR = return + [ NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgInfoLecturerTitle + , navRoute = InfoLecturerR + , navAccess' = return True + , navType = NavTypeLink { navModal = False } + , navQuick' = mempty + , navForceActive = False + } + , navChildren = [] + } + ] +pageActions (CourseR tid ssh csh CCorrectionsR) = return + [ NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuCorrectionsAssign + , navRoute = CourseR tid ssh csh CAssignR + , navAccess' = return True + , navType = NavTypeLink { navModal = False } + , navQuick' = navQuick NavQuickViewPageActionSecondary <> navQuick NavQuickViewFavourite + , navForceActive = False + } + , navChildren = [] + } + , NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuCorrectionsOwn + , navRoute = ( CorrectionsR + , [ ("corrections-term", toPathPiece tid) + , ("corrections-school", toPathPiece ssh) + , ("corrections-course", toPathPiece csh) + ] + ) + , navAccess' = do + muid <- maybeAuthId + case muid of + Nothing -> return False + (Just uid) -> do + ok <- runDB . E.selectExists . E.from $ \(course `E.InnerJoin` sheet `E.InnerJoin` submission) -> do + E.on $ submission E.^. SubmissionSheet E.==. sheet E.^. SheetId + E.on $ sheet E.^. SheetCourse E.==. course E.^. CourseId + E.where_ $ submission E.^. SubmissionRatingBy E.==. E.just (E.val uid) + E.&&. course E.^. CourseTerm E.==. E.val tid + E.&&. course E.^. CourseSchool E.==. E.val ssh + E.&&. course E.^. CourseShorthand E.==. E.val csh + return ok + , navType = NavTypeLink { navModal = False } + , navQuick' = navQuick NavQuickViewPageActionSecondary + , navForceActive = False + } + , navChildren = [] + } + ] +pageActions (CourseR tid ssh csh SheetListR) = do + correctionsSecondary <- pageQuickActions NavQuickViewPageActionSecondary $ CourseR tid ssh csh CCorrectionsR + + let + navCorrections = NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuSubmissions + , navRoute = CourseR tid ssh csh CCorrectionsR + , navAccess' = return True + , navType = NavTypeLink { navModal = False } + , navQuick' = navQuick NavQuickViewPageActionSecondary <> navQuick NavQuickViewFavourite + , navForceActive = False + } + , navChildren = correctionsSecondary + } + showCorrections <- maybeT (return False) $ True <$ navAccess navCorrections + + return $ + [ NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuSheetCurrent + , navRoute = CourseR tid ssh csh SheetCurrentR + , navAccess' = + runDB . maybeT (return False) $ do + void . MaybeT $ sheetCurrent tid ssh csh + return True + , navType = NavTypeLink { navModal = False } + , navQuick' = navQuick NavQuickViewPageActionSecondary <> navQuick NavQuickViewFavourite + , navForceActive = False + } + , navChildren = [] + } + , NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuSheetOldUnassigned + , navRoute = CourseR tid ssh csh SheetOldUnassignedR + , navAccess' = + runDB . maybeT (return False) $ do + void . MaybeT $ sheetOldUnassigned tid ssh csh + return True + , navType = NavTypeLink { navModal = False } + , navQuick' = navQuick NavQuickViewPageActionSecondary <> navQuick NavQuickViewFavourite + , navForceActive = False + } + , navChildren = [] + } + , navCorrections + ] ++ guardOnM (not showCorrections) [ NavPageActionPrimary{ navLink, navChildren = [] } | navLink <- correctionsSecondary ] ++ + [ NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuSheetNew + , navRoute = CourseR tid ssh csh SheetNewR + , navAccess' = return True + , navType = NavTypeLink { navModal = False } + , navQuick' = navQuick NavQuickViewPageActionSecondary <> navQuick NavQuickViewFavourite + , navForceActive = False + } + , navChildren = [] + } + ] +pageActions (CourseR tid ssh csh CUsersR) = return + [ NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuCourseAddMembers + , navRoute = CourseR tid ssh csh CAddUserR + , navAccess' = return True + , navType = NavTypeLink { navModal = True } + , navQuick' = navQuick NavQuickViewPageActionSecondary + , navForceActive = False + } + , navChildren = [] + } + , NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuCourseApplications + , navRoute = CourseR tid ssh csh CApplicationsR + , navAccess' = + 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 + , navType = NavTypeLink { navModal = False } + , navQuick' = navQuick NavQuickViewPageActionSecondary <> navQuick NavQuickViewFavourite + , navForceActive = False + } + , navChildren = [] + } + ] +pageActions (CourseR tid ssh csh MaterialListR) = return + [ NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuMaterialNew + , navRoute = CourseR tid ssh csh MaterialNewR + , navAccess' = return True + , navType = NavTypeLink { navModal = False } + , navQuick' = navQuick NavQuickViewPageActionSecondary + , navForceActive = False + } + , navChildren = [] + } + ] +pageActions (CMaterialR tid ssh csh mnm MShowR) = return + [ NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuMaterialEdit + , navRoute = CMaterialR tid ssh csh mnm MEditR + , navAccess' = return True + , navType = NavTypeLink { navModal = False } + , navQuick' = mempty + , navForceActive = False + } + , navChildren = [] + } + , NavPageActionSecondary + { navLink = NavLink + { navLabel = MsgMenuMaterialDelete + , navRoute = CMaterialR tid ssh csh mnm MDelR + , navAccess' = return True + , navType = NavTypeLink { navModal = True } + , navQuick' = mempty + , navForceActive = False + } + } + ] +pageActions (CourseR tid ssh csh CTutorialListR) = return + [ NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuTutorialNew + , navRoute = CourseR tid ssh csh CTutorialNewR + , navAccess' = return True + , navType = NavTypeLink { navModal = False } + , navQuick' = navQuick NavQuickViewPageActionSecondary + , navForceActive = False + } + , navChildren = [] + } + ] +pageActions (CTutorialR tid ssh csh tutn TEditR) = return + [ NavPageActionSecondary + { navLink = NavLink + { navLabel = MsgMenuTutorialDelete + , navRoute = CTutorialR tid ssh csh tutn TDeleteR + , navAccess' = return True + , navType = NavTypeLink { navModal = False } + , navQuick' = mempty + , navForceActive = False + } + } + ] +pageActions (CTutorialR tid ssh csh tutn TUsersR) = return + [ NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuTutorialComm + , navRoute = CTutorialR tid ssh csh tutn TCommR + , navAccess' = return True + , navType = NavTypeLink { navModal = False } + , navQuick' = mempty + , navForceActive = False + } + , navChildren = [] + } + , NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuTutorialEdit + , navRoute = CTutorialR tid ssh csh tutn TEditR + , navAccess' = return True + , navType = NavTypeLink { navModal = False } + , navQuick' = mempty + , navForceActive = False + } + , navChildren = [] + } + , NavPageActionSecondary + { navLink = NavLink + { navLabel = MsgMenuTutorialDelete + , navRoute = CTutorialR tid ssh csh tutn TDeleteR + , navAccess' = return True + , navType = NavTypeLink { navModal = False } + , navQuick' = mempty + , navForceActive = False + } + } + ] +pageActions (CourseR tid ssh csh CExamListR) = return + [ NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuExamNew + , navRoute = CourseR tid ssh csh CExamNewR + , navAccess' = return True + , navType = NavTypeLink { navModal = False } + , navQuick' = navQuick NavQuickViewPageActionSecondary + , navForceActive = False + } + , navChildren = [] + } + ] +pageActions (CExamR tid ssh csh examn EShowR) = do + usersSecondary <- pageQuickActions NavQuickViewPageActionSecondary $ CExamR tid ssh csh examn EUsersR + + return + [ NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuExamEdit + , navRoute = CExamR tid ssh csh examn EEditR + , navAccess' = return True + , navType = NavTypeLink { navModal = False } + , navQuick' = mempty + , navForceActive = False + } + , navChildren = [] + } + , NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuExamUsers + , navRoute = CExamR tid ssh csh examn EUsersR + , navAccess' = return True + , navType = NavTypeLink { navModal = False } + , navQuick' = mempty + , navForceActive = False + } + , navChildren = usersSecondary + } + , NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuExamGrades + , navRoute = CExamR tid ssh csh examn EGradesR + , navAccess' = return True + , navType = NavTypeLink { navModal = False } + , navQuick' = mempty + , navForceActive = False + } + , navChildren = [] + } + ] +pageActions (CExamR tid ssh csh examn EUsersR) = return + [ NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuExamAddMembers + , navRoute = CExamR tid ssh csh examn EAddUserR + , navAccess' = return True + , navType = NavTypeLink { navModal = True } + , navQuick' = navQuick NavQuickViewPageActionSecondary + , navForceActive = False + } + , navChildren = [] + } + , NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuExamGrades + , navRoute = CExamR tid ssh csh examn EGradesR + , navAccess' = return True + , navType = NavTypeLink { navModal = False } + , navQuick' = mempty + , navForceActive = False + } + , navChildren = [] + } + ] +pageActions (CExamR tid ssh csh examn EGradesR) = return + [ NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuExamUsers + , navRoute = CExamR tid ssh csh examn EUsersR + , navAccess' = return True + , navType = NavTypeLink { navModal = False } + , navQuick' = navQuick NavQuickViewPageActionSecondary + , navForceActive = False + } + , navChildren = [] + } + ] +pageActions (CSheetR tid ssh csh shn SShowR) = do + subsSecondary <- pageQuickActions NavQuickViewPageActionSecondary $ CSheetR tid ssh csh shn SSubsR + let + navSubmissions = NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuSubmissions + , navRoute = CSheetR tid ssh csh shn SSubsR + , navAccess' = return True + , navType = NavTypeLink { navModal = False } + , navQuick' = mempty + , navForceActive = False + } + , navChildren = subsSecondary + } + showSubmissions <- maybeT (return False) $ True <$ navAccess navSubmissions + + return $ + [ NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuSubmissionOwn + , navRoute = CSheetR tid ssh csh shn SubmissionOwnR + , navAccess' = + runDB . maybeT (return False) $ do + uid <- MaybeT $ liftHandler maybeAuthId + submissions <- lift $ submissionList tid csh shn uid + guard . not $ null submissions + return True + , navType = NavTypeLink { navModal = False } + , navQuick' = mempty + , navForceActive = False + } + , navChildren = [] + } + , navSubmissions + ] ++ guardOnM (not showSubmissions) [ NavPageActionPrimary{ navLink, navChildren = [] } | navLink <- subsSecondary ] ++ + [ NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuSheetEdit + , navRoute = CSheetR tid ssh csh shn SEditR + , navAccess' = return True + , navType = NavTypeLink { navModal = False } + , navQuick' = mempty + , navForceActive = False + } + , navChildren = [] + } + , NavPageActionSecondary + { navLink = NavLink + { navLabel = MsgMenuSheetClone + , navRoute = (CourseR tid ssh csh SheetNewR, [("shn", toPathPiece shn)]) + , navAccess' = return True + , navType = NavTypeLink { navModal = False } + , navQuick' = mempty + , navForceActive = False + } + } + , NavPageActionSecondary + { navLink = NavLink + { navLabel = MsgMenuSheetDelete + , navRoute = CSheetR tid ssh csh shn SDelR + , navAccess' = return True + , navType = NavTypeLink { navModal = False } + , navQuick' = mempty + , navForceActive = False + } + } + ] +pageActions (CSheetR tid ssh csh shn SSubsR) = return + [ NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuSubmissionNew + , navRoute = CSheetR tid ssh csh shn SubmissionNewR + , navAccess' = + let submissionAccess = hasWriteAccessTo $ CSheetR tid ssh csh shn SSubsR + hasNoSubmission = maybeT (return False) $ do + uid <- MaybeT $ liftHandler maybeAuthId + submissions <- lift $ submissionList tid csh shn uid + guard $ null submissions + return True + in runDB $ hasNoSubmission `or2M` submissionAccess + , navType = NavTypeLink { navModal = True } + , navQuick' = navQuick NavQuickViewPageActionSecondary + , navForceActive = False + } + , navChildren = [] + } + , NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuCorrectionsOwn + , navRoute = ( CorrectionsR + , [ ("corrections-term", toPathPiece tid) + , ("corrections-school", toPathPiece ssh) + , ("corrections-course", toPathPiece csh) + , ("corrections-sheet", toPathPiece shn) + ] + ) + , navAccess' = (== Authorized) <$> evalAccessCorrector tid ssh csh + , navType = NavTypeLink { navModal = False } + , navQuick' = navQuick NavQuickViewPageActionSecondary + , navForceActive = False + } + , navChildren = [] + } + , NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuCorrectionsAssign + , navRoute = CSheetR tid ssh csh shn SAssignR + , navAccess' = return True + , navType = NavTypeLink { navModal = False } + , navQuick' = navQuick NavQuickViewPageActionSecondary + , navForceActive = False + } + , navChildren = [] + } + ] +pageActions (CSubmissionR tid ssh csh shn cid SubShowR) = return + [ NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuCorrection + , navRoute = CSubmissionR tid ssh csh shn cid CorrectionR + , navAccess' = return True + , navType = NavTypeLink { navModal = False } + , navQuick' = mempty + , navForceActive = False + } + , navChildren = [] + } + , NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgCorrectorAssignTitle + , navRoute = CSubmissionR tid ssh csh shn cid SubAssignR + , navAccess' = return True + , navType = NavTypeLink { navModal = True } + , navQuick' = mempty + , navForceActive = False + } + , navChildren = [] + } + , NavPageActionSecondary + { navLink = NavLink + { navLabel = MsgMenuSubmissionDelete + , navRoute = CSubmissionR tid ssh csh shn cid SubDelR + , navAccess' = return True + , navType = NavTypeLink { navModal = False } + , navQuick' = mempty + , navForceActive = False + } + } + ] +pageActions (CSubmissionR tid ssh csh shn cid CorrectionR) = return + [ NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgCorrectorAssignTitle + , navRoute = CSubmissionR tid ssh csh shn cid SubAssignR + , navAccess' = return True + , navType = NavTypeLink { navModal = True } + , navQuick' = mempty + , navForceActive = False + } + , navChildren = [] + } + , NavPageActionSecondary + { navLink = NavLink + { navLabel = MsgMenuSubmissionDelete + , navRoute = CSubmissionR tid ssh csh shn cid SubDelR + , navAccess' = return True + , navType = NavTypeLink { navModal = False } + , navQuick' = mempty + , navForceActive = False + } + } + ] + pageActions _ = return [] --- pageActions (AdminR) = --- [ MenuItem --- { menuItemType = PageActionPrime --- , menuItemLabel = MsgMenuSchoolList --- , menuItemIcon = Nothing --- , menuItemRoute = SomeRoute SchoolListR --- , menuItemModal = False --- , menuItemAccessCallback' = return True --- } --- , MenuItem --- { menuItemType = PageActionPrime --- , menuItemLabel = MsgAdminFeaturesHeading --- , menuItemIcon = Nothing --- , menuItemRoute = SomeRoute AdminFeaturesR --- , menuItemModal = False --- , menuItemAccessCallback' = return True --- } --- , MenuItem --- { menuItemType = PageActionPrime --- , menuItemLabel = MsgMenuMessageList --- , menuItemIcon = Nothing --- , menuItemRoute = SomeRoute MessageListR --- , menuItemModal = False --- , menuItemAccessCallback' = return True --- } --- , MenuItem --- { menuItemType = PageActionPrime --- , menuItemLabel = MsgMenuAdminErrMsg --- , menuItemIcon = Nothing --- , menuItemRoute = SomeRoute AdminErrMsgR --- , menuItemModal = False --- , menuItemAccessCallback' = return True --- } --- , MenuItem --- { menuItemType = PageActionSecondary --- , menuItemLabel = MsgMenuAdminTest --- , menuItemIcon = Nothing --- , menuItemRoute = SomeRoute AdminTestR --- , menuItemModal = False --- , menuItemAccessCallback' = return True --- } --- ] --- pageActions (ExamOfficeR EOExamsR) = --- [ MenuItem --- { menuItemType = PageActionPrime --- , menuItemLabel = MsgMenuExamOfficeFields --- , menuItemIcon = Nothing --- , menuItemRoute = SomeRoute $ ExamOfficeR EOFieldsR --- , menuItemModal = True --- , menuItemAccessCallback' = return True --- } --- , MenuItem --- { menuItemType = PageActionPrime --- , menuItemLabel = MsgMenuExamOfficeUsers --- , menuItemIcon = Nothing --- , menuItemRoute = SomeRoute $ ExamOfficeR EOUsersR --- , menuItemModal = True --- , menuItemAccessCallback' = return True --- } --- ] --- pageActions (SchoolListR) = --- [ MenuItem --- { menuItemType = PageActionPrime --- , menuItemLabel = MsgMenuSchoolNew --- , menuItemIcon = Nothing --- , menuItemRoute = SomeRoute SchoolNewR --- , menuItemModal = False --- , menuItemAccessCallback' = return True --- } --- ] --- pageActions (UsersR) = --- [ MenuItem --- { menuItemType = PageActionPrime --- , menuItemLabel = MsgMenuLecturerInvite --- , menuItemIcon = Nothing --- , menuItemRoute = SomeRoute AdminNewFunctionaryInviteR --- , menuItemModal = True --- , menuItemAccessCallback' = return True --- } --- , MenuItem --- { menuItemType = PageActionPrime --- , menuItemLabel = MsgMenuUserAdd --- , menuItemIcon = Nothing --- , menuItemRoute = SomeRoute AdminUserAddR --- , menuItemModal = True --- , menuItemAccessCallback' = return True --- } --- ] --- pageActions (AdminUserR cID) = --- [ MenuItem --- { menuItemType = PageActionPrime --- , menuItemLabel = MsgMenuUserNotifications --- , menuItemIcon = Nothing --- , menuItemRoute = SomeRoute $ UserNotificationR cID --- , menuItemModal = True --- , menuItemAccessCallback' = return True --- } --- , MenuItem --- { menuItemType = PageActionPrime --- , menuItemLabel = MsgMenuUserPassword --- , menuItemIcon = Nothing --- , menuItemRoute = SomeRoute $ UserPasswordR cID --- , menuItemModal = True --- , menuItemAccessCallback' = do --- uid <- decrypt cID --- User{userAuthentication} <- runDB $ get404 uid --- return $ is _AuthPWHash userAuthentication --- } --- ] --- pageActions (InfoR) = [ --- MenuItem --- { menuItemType = PageActionPrime --- , menuItemLabel = MsgInfoLecturerTitle --- , menuItemIcon = Nothing --- , menuItemRoute = SomeRoute InfoLecturerR --- , menuItemModal = False --- , menuItemAccessCallback' = return True --- } --- , MenuItem --- { menuItemType = PageActionPrime --- , menuItemLabel = MsgMenuLegal --- , menuItemIcon = Nothing --- , menuItemRoute = SomeRoute LegalR --- , menuItemModal = False --- , menuItemAccessCallback' = return True --- } --- , MenuItem --- { menuItemType = PageActionPrime --- , menuItemLabel = MsgMenuGlossary --- , menuItemIcon = Nothing --- , menuItemRoute = SomeRoute GlossaryR --- , menuItemModal = False --- , menuItemAccessCallback' = return True --- } --- ] --- pageActions (VersionR) = [ --- MenuItem --- { menuItemType = PageActionPrime --- , menuItemLabel = MsgInfoLecturerTitle --- , menuItemIcon = Nothing --- , menuItemRoute = SomeRoute InfoLecturerR --- , menuItemModal = False --- , menuItemAccessCallback' = return True --- } --- ] --- pageActions HealthR = [ --- MenuItem --- { menuItemType = PageActionPrime --- , menuItemLabel = MsgMenuInstance --- , menuItemIcon = Nothing --- , menuItemRoute = SomeRoute InstanceR --- , menuItemModal = False --- , menuItemAccessCallback' = return True --- } --- ] --- pageActions InstanceR = [ --- MenuItem --- { menuItemType = PageActionPrime --- , menuItemLabel = MsgMenuHealth --- , menuItemIcon = Nothing --- , menuItemRoute = SomeRoute HealthR --- , menuItemModal = False --- , menuItemAccessCallback' = return True --- } --- ] --- pageActions (HelpR) = [ --- -- MenuItem --- -- { menuItemType = PageActionPrime --- -- , menuItemLabel = MsgInfoLecturerTitle --- -- , menuItemIcon = Nothing --- -- , menuItemRoute = SomeRoute InfoLecturerR --- -- , menuItemModal = False --- -- , menuItemAccessCallback' = return True --- -- } --- ] --- pageActions (ProfileR) = --- [ MenuItem --- { menuItemType = PageActionPrime --- , menuItemLabel = MsgMenuProfileData --- , menuItemIcon = Just "book" --- , menuItemRoute = SomeRoute ProfileDataR --- , menuItemModal = False --- , menuItemAccessCallback' = return True --- } --- , MenuItem --- { menuItemType = PageActionSecondary --- , menuItemLabel = MsgMenuAuthPreds --- , menuItemIcon = Nothing --- , menuItemRoute = SomeRoute AuthPredsR --- , menuItemModal = True --- , menuItemAccessCallback' = return True --- } --- ] --- pageActions TermShowR = --- [ MenuItem --- { menuItemType = PageActionPrime --- , menuItemLabel = MsgMenuTermCreate --- , menuItemIcon = Nothing --- , menuItemRoute = SomeRoute TermEditR --- , menuItemModal = False --- , menuItemAccessCallback' = return True --- } --- , MenuItem --- { menuItemType = PageActionPrime --- , menuItemLabel = MsgMenuParticipantsList --- , menuItemIcon = Nothing --- , menuItemRoute = SomeRoute ParticipantsListR --- , menuItemModal = False --- , menuItemAccessCallback' = return True --- } --- ] --- pageActions (TermCourseListR tid) = --- [ MenuItem --- { menuItemType = PageActionPrime --- , menuItemLabel = MsgMenuCourseNew --- , menuItemIcon = Just "book" --- , menuItemRoute = SomeRoute CourseNewR --- , menuItemModal = False --- , menuItemAccessCallback' = return True --- } --- , MenuItem --- { menuItemType = PageActionPrime --- , menuItemLabel = MsgMenuTermEdit --- , menuItemIcon = Nothing --- , menuItemRoute = SomeRoute $ TermEditExistR tid --- , menuItemModal = False --- , menuItemAccessCallback' = return True --- } --- ] --- pageActions (TermSchoolCourseListR _tid _ssh) = --- [ MenuItem --- { menuItemType = PageActionPrime --- , menuItemLabel = MsgMenuCourseNew --- , menuItemIcon = Just "book" --- , menuItemRoute = SomeRoute CourseNewR --- , menuItemModal = False --- , menuItemAccessCallback' = return True --- } --- ] --- pageActions (AllocationR _tid _ssh _ash AShowR) = --- [ MenuItem --- { menuItemType = PageActionPrime --- , menuItemLabel = MsgMenuAllocationInfo --- , menuItemIcon = Nothing --- , menuItemRoute = SomeRoute InfoAllocationR --- , menuItemModal = True --- , menuItemAccessCallback' = return True --- } --- ] --- pageActions (CourseListR) = --- [ MenuItem --- { menuItemType = PageActionPrime --- , menuItemLabel = MsgMenuCourseNew --- , menuItemIcon = Just "book" --- , menuItemRoute = SomeRoute CourseNewR --- , menuItemModal = False --- , menuItemAccessCallback' = return True --- } --- , MenuItem --- { menuItemType = PageActionPrime --- , menuItemLabel = MsgMenuAllocationList --- , menuItemIcon = Nothing --- , menuItemRoute = SomeRoute AllocationListR --- , menuItemModal = False --- , menuItemAccessCallback' = return True --- } --- , MenuItem --- { menuItemType = PageActionPrime --- , menuItemLabel = MsgMenuParticipantsList --- , menuItemIcon = Nothing --- , menuItemRoute = SomeRoute ParticipantsListR --- , menuItemModal = False --- , menuItemAccessCallback' = return True --- } --- ] --- pageActions (CourseNewR) = [ --- MenuItem --- { menuItemType = PageActionPrime --- , menuItemLabel = MsgInfoLecturerTitle --- , menuItemIcon = Nothing --- , menuItemRoute = SomeRoute InfoLecturerR --- , menuItemModal = False --- , menuItemAccessCallback' = return True --- } --- ] --- pageActions (CourseR tid ssh csh CCorrectionsR) = --- [ MenuItem --- { menuItemType = PageActionPrime --- , menuItemLabel = MsgMenuCorrectionsAssign --- , menuItemIcon = Nothing --- , menuItemRoute = SomeRoute $ CourseR tid ssh csh CAssignR --- , menuItemModal = False --- , menuItemAccessCallback' = return True --- } --- ] --- pageActions (CourseR tid ssh csh SheetListR) = --- [ MenuItem --- { menuItemType = PageActionPrime --- , menuItemLabel = MsgMenuSheetCurrent --- , menuItemIcon = Nothing --- , menuItemRoute = SomeRoute $ CourseR tid ssh csh SheetCurrentR --- , menuItemModal = False --- , menuItemAccessCallback' = runDB . maybeT (return False) $ do --- void . MaybeT $ sheetCurrent tid ssh csh --- return True --- } --- , MenuItem --- { menuItemType = PageActionPrime --- , menuItemLabel = MsgMenuSheetOldUnassigned --- , menuItemIcon = Nothing --- , menuItemRoute = SomeRoute $ CourseR tid ssh csh SheetOldUnassignedR --- , menuItemModal = False --- , menuItemAccessCallback' = runDB . maybeT (return False) $ do --- void . MaybeT $ sheetOldUnassigned tid ssh csh --- return True --- } --- , MenuItem --- { menuItemType = PageActionPrime --- , menuItemLabel = MsgMenuSubmissions --- , menuItemIcon = Nothing --- , menuItemRoute = SomeRoute $ CourseR tid ssh csh CCorrectionsR --- , menuItemModal = False --- , menuItemAccessCallback' = return True --- } --- , MenuItem --- { menuItemType = PageActionPrime --- , menuItemLabel = MsgMenuCorrectionsAssign --- , menuItemIcon = Nothing --- , menuItemRoute = SomeRoute $ CourseR tid ssh csh CAssignR --- , menuItemModal = False --- , menuItemAccessCallback' = return True --- } --- , MenuItem --- { menuItemType = PageActionPrime --- , menuItemLabel = MsgMenuCorrectionsOwn --- , menuItemIcon = Nothing --- , menuItemRoute = SomeRoute (CorrectionsR, [ ("corrections-term" , termToText $ unTermKey tid) --- , ("corrections-school", CI.original $ unSchoolKey ssh) --- , ("corrections-course", CI.original csh) --- ]) --- , menuItemModal = False --- , menuItemAccessCallback' = do --- muid <- maybeAuthId --- case muid of --- Nothing -> return False --- (Just uid) -> do --- ok <- runDB . E.selectExists . E.from $ \(course `E.InnerJoin` sheet `E.InnerJoin` submission) -> do --- E.on $ submission E.^. SubmissionSheet E.==. sheet E.^. SheetId --- E.on $ sheet E.^. SheetCourse E.==. course E.^. CourseId --- E.where_ $ submission E.^. SubmissionRatingBy E.==. E.just (E.val uid) --- E.&&. course E.^. CourseTerm E.==. E.val tid --- E.&&. course E.^. CourseSchool E.==. E.val ssh --- E.&&. course E.^. CourseShorthand E.==. E.val csh --- return ok --- } --- , MenuItem --- { menuItemType = PageActionPrime --- , menuItemLabel = MsgMenuSheetNew --- , menuItemIcon = Nothing --- , menuItemRoute = SomeRoute $ CourseR tid ssh csh SheetNewR --- , menuItemModal = False --- , menuItemAccessCallback' = return True --- } --- ] --- pageActions (CourseR tid ssh csh CUsersR) = --- [ MenuItem --- { menuItemType = PageActionPrime --- , menuItemLabel = MsgMenuCourseAddMembers --- , menuItemIcon = Nothing --- , menuItemRoute = SomeRoute $ CourseR tid ssh csh CAddUserR --- , 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 --- { menuItemType = PageActionPrime --- , menuItemLabel = MsgMenuMaterialNew --- , menuItemIcon = Nothing --- , menuItemRoute = SomeRoute $ CourseR tid ssh csh MaterialNewR --- , menuItemModal = False --- , menuItemAccessCallback' = return True --- } --- ] --- pageActions (CMaterialR tid ssh csh mnm MShowR) = --- [ MenuItem --- { menuItemType = PageActionPrime --- , menuItemLabel = MsgMenuMaterialEdit --- , menuItemIcon = Nothing --- , menuItemRoute = SomeRoute $ CMaterialR tid ssh csh mnm MEditR --- , menuItemModal = False --- , menuItemAccessCallback' = return True --- } --- , MenuItem --- { menuItemType = PageActionPrime --- , menuItemLabel = MsgMenuMaterialDelete --- , menuItemIcon = Nothing --- , menuItemRoute = SomeRoute $ CMaterialR tid ssh csh mnm MDelR --- , menuItemModal = False --- , menuItemAccessCallback' = return True --- } --- ] --- pageActions (CourseR tid ssh csh CTutorialListR) = --- [ MenuItem --- { menuItemType = PageActionPrime --- , menuItemLabel = MsgMenuTutorialNew --- , menuItemIcon = Nothing --- , menuItemRoute = SomeRoute $ CourseR tid ssh csh CTutorialNewR --- , menuItemModal = False --- , menuItemAccessCallback' = return True --- } --- ] --- pageActions (CTutorialR tid ssh csh tutn TEditR) = --- [ MenuItem --- { menuItemType = PageActionSecondary --- , menuItemLabel = MsgMenuTutorialDelete --- , menuItemIcon = Nothing --- , menuItemRoute = SomeRoute $ CTutorialR tid ssh csh tutn TDeleteR --- , menuItemModal = False --- , menuItemAccessCallback' = return True --- } --- ] --- pageActions (CTutorialR tid ssh csh tutn TUsersR) = --- [ MenuItem --- { menuItemType = PageActionPrime --- , menuItemLabel = MsgMenuTutorialComm --- , menuItemIcon = Nothing --- , menuItemRoute = SomeRoute $ CTutorialR tid ssh csh tutn TCommR --- , menuItemModal = False --- , menuItemAccessCallback' = return True --- } --- , MenuItem --- { menuItemType = PageActionPrime --- , menuItemLabel = MsgMenuTutorialEdit --- , menuItemIcon = Nothing --- , menuItemRoute = SomeRoute $ CTutorialR tid ssh csh tutn TEditR --- , menuItemModal = False --- , menuItemAccessCallback' = return True --- } --- , MenuItem --- { menuItemType = PageActionSecondary --- , menuItemLabel = MsgMenuTutorialDelete --- , menuItemIcon = Nothing --- , menuItemRoute = SomeRoute $ CTutorialR tid ssh csh tutn TDeleteR --- , menuItemModal = False --- , menuItemAccessCallback' = return True --- } --- ] --- pageActions (CourseR tid ssh csh CExamListR) = --- [ MenuItem --- { menuItemType = PageActionPrime --- , menuItemLabel = MsgMenuExamNew --- , menuItemIcon = Nothing --- , menuItemRoute = SomeRoute $ CourseR tid ssh csh CExamNewR --- , menuItemModal = False --- , menuItemAccessCallback' = return True --- } --- ] --- pageActions (CExamR tid ssh csh examn EShowR) = --- [ MenuItem --- { menuItemType = PageActionPrime --- , menuItemLabel = MsgMenuExamEdit --- , menuItemIcon = Nothing --- , menuItemRoute = SomeRoute $ CExamR tid ssh csh examn EEditR --- , menuItemModal = False --- , menuItemAccessCallback' = return True --- } --- , MenuItem --- { menuItemType = PageActionPrime --- , menuItemLabel = MsgMenuExamUsers --- , menuItemIcon = Nothing --- , menuItemRoute = SomeRoute $ CExamR tid ssh csh examn EUsersR --- , menuItemModal = False --- , menuItemAccessCallback' = return True --- } --- , MenuItem --- { menuItemType = PageActionPrime --- , menuItemLabel = MsgMenuExamGrades --- , menuItemIcon = Nothing --- , menuItemRoute = SomeRoute $ CExamR tid ssh csh examn EGradesR --- , menuItemModal = False --- , menuItemAccessCallback' = return True --- } --- ] --- pageActions (CExamR tid ssh csh examn EUsersR) = --- [ MenuItem --- { menuItemType = PageActionPrime --- , menuItemLabel = MsgMenuExamAddMembers --- , menuItemIcon = Nothing --- , menuItemRoute = SomeRoute $ CExamR tid ssh csh examn EAddUserR --- , menuItemModal = True --- , menuItemAccessCallback' = return True --- } --- , MenuItem --- { menuItemType = PageActionPrime --- , menuItemLabel = MsgMenuExamGrades --- , menuItemIcon = Nothing --- , menuItemRoute = SomeRoute $ CExamR tid ssh csh examn EGradesR --- , menuItemModal = False --- , menuItemAccessCallback' = return True --- } --- ] --- pageActions (CExamR tid ssh csh examn EGradesR) = --- [ MenuItem --- { menuItemType = PageActionPrime --- , menuItemLabel = MsgMenuExamUsers --- , menuItemIcon = Nothing --- , menuItemRoute = SomeRoute $ CExamR tid ssh csh examn EUsersR --- , menuItemModal = False --- , menuItemAccessCallback' = return True --- } --- ] --- pageActions (CSheetR tid ssh csh shn SShowR) = --- [ MenuItem --- { menuItemType = PageActionPrime --- , menuItemLabel = MsgMenuSubmissionNew --- , menuItemIcon = Nothing --- , menuItemRoute = SomeRoute $ CSheetR tid ssh csh shn SubmissionNewR --- , menuItemModal = True --- , menuItemAccessCallback' = runDB . maybeT (return False) $ do --- uid <- MaybeT $ liftHandler maybeAuthId --- submissions <- lift $ submissionList tid csh shn uid --- guard $ null submissions --- return True --- } --- , MenuItem --- { menuItemType = PageActionPrime --- , menuItemLabel = MsgMenuSubmissionOwn --- , menuItemIcon = Nothing --- , menuItemRoute = SomeRoute $ CSheetR tid ssh csh shn SubmissionOwnR --- , menuItemModal = False --- , menuItemAccessCallback' = runDB . maybeT (return False) $ do --- uid <- MaybeT $ liftHandler maybeAuthId --- submissions <- lift $ submissionList tid csh shn uid --- guard . not $ null submissions --- return True --- } --- , MenuItem --- { menuItemType = PageActionPrime --- , menuItemLabel = MsgMenuCorrectionsOwn --- , menuItemIcon = Nothing --- , menuItemRoute = SomeRoute (CorrectionsR, [ ("corrections-term" , termToText $ unTermKey tid) --- , ("corrections-school", CI.original $ unSchoolKey ssh) --- , ("corrections-course", CI.original csh) --- , ("corrections-sheet" , CI.original shn) --- ]) --- , menuItemModal = False --- , menuItemAccessCallback' = (== Authorized) <$> evalAccessCorrector tid ssh csh --- } --- , MenuItem --- { menuItemType = PageActionPrime --- , menuItemLabel = MsgMenuSubmissions --- , menuItemIcon = Nothing --- , menuItemRoute = SomeRoute $ CSheetR tid ssh csh shn SSubsR --- , menuItemModal = False --- , menuItemAccessCallback' = return True --- } --- , MenuItem --- { menuItemType = PageActionPrime --- , menuItemLabel = MsgMenuCorrectionsAssign --- , menuItemIcon = Nothing --- , menuItemRoute = SomeRoute $ CSheetR tid ssh csh shn SAssignR --- , menuItemModal = False --- , menuItemAccessCallback' = return True --- } --- , MenuItem --- { menuItemType = PageActionPrime --- , menuItemLabel = MsgMenuSheetEdit --- , menuItemIcon = Nothing --- , menuItemRoute = SomeRoute $ CSheetR tid ssh csh shn SEditR --- , menuItemModal = False --- , menuItemAccessCallback' = return True --- } --- , MenuItem --- { menuItemType = PageActionSecondary --- , menuItemLabel = MsgMenuSheetClone --- , menuItemIcon = Just "copy" --- , menuItemRoute = SomeRoute (CourseR tid ssh csh SheetNewR, [("shn", toPathPiece shn)]) --- , menuItemModal = False --- , menuItemAccessCallback' = return True --- } --- , MenuItem --- { menuItemType = PageActionSecondary --- , menuItemLabel = MsgMenuSheetDelete --- , menuItemIcon = Just "trash" --- , menuItemRoute = SomeRoute $ CSheetR tid ssh csh shn SDelR --- , menuItemModal = False --- , menuItemAccessCallback' = return True --- } --- ] --- pageActions (CSheetR tid ssh csh shn SSubsR) = --- [ MenuItem --- { menuItemType = PageActionPrime --- , menuItemLabel = MsgMenuSubmissionNew --- , menuItemIcon = Nothing --- , menuItemRoute = SomeRoute $ CSheetR tid ssh csh shn SubmissionNewR --- , menuItemModal = True --- , menuItemAccessCallback' = return True --- } --- , MenuItem --- { menuItemType = PageActionPrime --- , menuItemLabel = MsgMenuCorrectionsAssign --- , menuItemIcon = Nothing --- , menuItemRoute = SomeRoute $ CSheetR tid ssh csh shn SAssignR --- , menuItemModal = False --- , menuItemAccessCallback' = return True --- } --- ] --- pageActions (CSubmissionR tid ssh csh shn cid SubShowR) = --- [ MenuItem --- { menuItemType = PageActionPrime --- , menuItemLabel = MsgMenuCorrection --- , menuItemIcon = Nothing --- , menuItemRoute = SomeRoute $ CSubmissionR tid ssh csh shn cid CorrectionR --- , menuItemModal = False --- , menuItemAccessCallback' = return True --- } --- , MenuItem --- { menuItemType = PageActionPrime --- , menuItemLabel = MsgCorrectorAssignTitle --- , menuItemIcon = Nothing --- , menuItemRoute = SomeRoute $ CSubmissionR tid ssh csh shn cid SubAssignR --- , menuItemModal = True --- , menuItemAccessCallback' = return True --- } --- , MenuItem --- { menuItemType = PageActionSecondary --- , menuItemLabel = MsgMenuSubmissionDelete --- , menuItemIcon = Just "trash" --- , menuItemRoute = SomeRoute $ CSubmissionR tid ssh csh shn cid SubDelR --- , menuItemModal = False --- , menuItemAccessCallback' = return True --- } --- ] --- pageActions (CSubmissionR tid ssh csh shn cid CorrectionR) = --- [ MenuItem --- { menuItemType = PageActionSecondary --- , menuItemLabel = MsgMenuSubmissionDelete --- , menuItemIcon = Nothing --- , menuItemRoute = SomeRoute $ CSubmissionR tid ssh csh shn cid SubDelR --- , menuItemModal = False --- , menuItemAccessCallback' = return True --- } --- ] -- pageActions (CourseR tid ssh csh CApplicationsR) = -- [ MenuItem -- { menuItemType = PageActionPrime