diff --git a/src/Foundation.hs b/src/Foundation.hs index 179789442..f60ca5e3b 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -1233,6 +1233,51 @@ pageActions (CourseListR) = } ] pageActions (CourseR tid ssh csh CShowR) = + [ MenuItem + { menuItemType = PageActionPrime + , menuItemLabel = MsgMenuSheetList + , menuItemIcon = Nothing + , menuItemRoute = SomeRoute $ CourseR tid ssh csh SheetListR + , menuItemModal = False + , menuItemAccessCallback' = do --TODO always show for lecturer + let sheetRouteAccess shn = (== Authorized) <$> evalAccess (CSheetR tid ssh csh shn SShowR) False + muid <- maybeAuthId + (sheets,lecturer) <- runDB $ do + cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh + sheets <- map (sheetName.entityVal) <$> selectList [SheetCourse ==. cid] [Desc SheetActiveFrom] + lecturer <- case muid of + Nothing -> return False + (Just uid) -> existsBy $ UniqueLecturer uid cid + return (sheets,lecturer) + or2M (return lecturer) $ anyM sheets sheetRouteAccess + } + ] ++ pageActions (CourseR tid ssh csh SheetListR) ++ + [ MenuItem + { menuItemType = PageActionSecondary + , menuItemLabel = MsgMenuCourseEdit + , menuItemIcon = Nothing + , menuItemRoute = SomeRoute $ CourseR tid ssh csh CEditR + , menuItemModal = False + , menuItemAccessCallback' = return True + } + , MenuItem + { menuItemType = PageActionSecondary + , menuItemLabel = MsgMenuCourseNewTemplate + , menuItemIcon = Nothing + , menuItemRoute = SomeRoute (CourseNewR, [("tid", toPathPiece tid), ("ssh", toPathPiece ssh), ("csh", toPathPiece csh)]) + , menuItemModal = False + , menuItemAccessCallback' = return True + } + , MenuItem + { menuItemType = PageActionSecondary + , menuItemLabel = MsgMenuCourseDelete + , menuItemIcon = Nothing + , menuItemRoute = SomeRoute $ CourseR tid ssh csh CDeleteR + , menuItemModal = False + , menuItemAccessCallback' = return True + } + ] +pageActions (CourseR tid ssh csh SheetListR) = [ MenuItem { menuItemType = PageActionPrime , menuItemLabel = MsgMenuSheetCurrent @@ -1263,24 +1308,6 @@ pageActions (CourseR tid ssh csh CShowR) = , menuItemModal = False , menuItemAccessCallback' = (== Authorized) <$> evalAccessCorrector tid ssh csh } - , MenuItem - { menuItemType = PageActionPrime - , menuItemLabel = MsgMenuSheetList - , menuItemIcon = Nothing - , menuItemRoute = SomeRoute $ CourseR tid ssh csh SheetListR - , menuItemModal = False - , menuItemAccessCallback' = do --TODO always show for lecturer - let sheetRouteAccess shn = (== Authorized) <$> evalAccess (CSheetR tid ssh csh shn SShowR) False - muid <- maybeAuthId - (sheets,lecturer) <- runDB $ do - cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh - sheets <- map (sheetName.entityVal) <$> selectList [SheetCourse ==. cid] [Desc SheetActiveFrom] - lecturer <- case muid of - Nothing -> return False - (Just uid) -> existsBy $ UniqueLecturer uid cid - return (sheets,lecturer) - or2M (return lecturer) $ anyM sheets sheetRouteAccess - } , MenuItem { menuItemType = PageActionPrime , menuItemLabel = MsgMenuSubmissions @@ -1317,40 +1344,6 @@ pageActions (CourseR tid ssh csh CShowR) = , menuItemModal = False , menuItemAccessCallback' = return True } - , MenuItem - { menuItemType = PageActionSecondary - , menuItemLabel = MsgMenuCourseEdit - , menuItemIcon = Nothing - , menuItemRoute = SomeRoute $ CourseR tid ssh csh CEditR - , menuItemModal = False - , menuItemAccessCallback' = return True - } - , MenuItem - { menuItemType = PageActionSecondary - , menuItemLabel = MsgMenuCourseNewTemplate - , menuItemIcon = Nothing - , menuItemRoute = SomeRoute (CourseNewR, [("tid", toPathPiece tid), ("ssh", toPathPiece ssh), ("csh", toPathPiece csh)]) - , menuItemModal = False - , menuItemAccessCallback' = return True - } - , MenuItem - { menuItemType = PageActionSecondary - , menuItemLabel = MsgMenuCourseDelete - , menuItemIcon = Nothing - , menuItemRoute = SomeRoute $ CourseR tid ssh csh CDeleteR - , menuItemModal = False - , menuItemAccessCallback' = return True - } - ] -pageActions (CourseR tid ssh csh SheetListR) = - [ MenuItem - { menuItemType = PageActionPrime - , menuItemLabel = MsgMenuSheetNew - , menuItemIcon = Nothing - , menuItemRoute = SomeRoute $ CourseR tid ssh csh SheetNewR - , menuItemModal = False - , menuItemAccessCallback' = return True - } ] pageActions (CSheetR tid ssh csh shn SShowR) = [ MenuItem