feat(pageactions): finish restoration
This commit is contained in:
Gregor Kleen
parent
4bc48a50fa
commit
e1cac76f15
@ -2909,6 +2909,17 @@ pageActions ProfileR = return
|
|||||||
}
|
}
|
||||||
, navChildren = []
|
, navChildren = []
|
||||||
}
|
}
|
||||||
|
, NavPageActionPrimary
|
||||||
|
{ navLink = NavLink
|
||||||
|
{ navLabel = MsgCsvOptions
|
||||||
|
, navRoute = CsvOptionsR
|
||||||
|
, navAccess' = return True
|
||||||
|
, navType = NavTypeLink { navModal = True }
|
||||||
|
, navQuick' = mempty
|
||||||
|
, navForceActive = False
|
||||||
|
}
|
||||||
|
, navChildren = []
|
||||||
|
}
|
||||||
]
|
]
|
||||||
pageActions TermShowR = return
|
pageActions TermShowR = return
|
||||||
[ NavPageActionPrimary
|
[ NavPageActionPrimary
|
||||||
@ -3489,185 +3500,207 @@ pageActions (CSubmissionR tid ssh csh shn cid CorrectionR) = return
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
]
|
]
|
||||||
|
pageActions (CourseR tid ssh csh CApplicationsR) = return
|
||||||
|
[ NavPageActionPrimary
|
||||||
|
{ navLink = NavLink
|
||||||
|
{ navLabel = MsgMenuCourseApplicationsFiles
|
||||||
|
, navRoute = CourseR tid ssh csh CAppsFilesR
|
||||||
|
, navAccess' =
|
||||||
|
let appAccess (E.Value appId) = do
|
||||||
|
cID <- encrypt appId
|
||||||
|
hasReadAccessTo $ CApplicationR tid ssh csh cID CAFilesR
|
||||||
|
appSource = E.selectSource . E.from $ \(course `E.InnerJoin` courseApplication) -> do
|
||||||
|
E.on $ course E.^. CourseId E.==. courseApplication E.^. CourseApplicationCourse
|
||||||
|
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
|
||||||
|
E.where_ . E.exists . E.from $ \courseApplicationFile ->
|
||||||
|
E.where_ $ courseApplicationFile E.^. CourseApplicationFileApplication E.==. courseApplication E.^. CourseApplicationId
|
||||||
|
return $ courseApplication E.^. CourseApplicationId
|
||||||
|
in runDB . runConduit $ appSource .| anyMC appAccess
|
||||||
|
, navType = NavTypeLink { navModal = False }
|
||||||
|
, navQuick' = mempty
|
||||||
|
, navForceActive = False
|
||||||
|
}
|
||||||
|
, navChildren = []
|
||||||
|
}
|
||||||
|
, NavPageActionPrimary
|
||||||
|
{ navLink = NavLink
|
||||||
|
{ navLabel = MsgMenuCourseMembers
|
||||||
|
, navRoute = CourseR tid ssh csh CUsersR
|
||||||
|
, navAccess' =
|
||||||
|
runDB $ do
|
||||||
|
cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
|
||||||
|
exists [ CourseParticipantCourse ==. cid ]
|
||||||
|
, navType = NavTypeLink { navModal = False }
|
||||||
|
, navQuick' = mempty
|
||||||
|
, navForceActive = False
|
||||||
|
}
|
||||||
|
, navChildren = []
|
||||||
|
}
|
||||||
|
]
|
||||||
|
pageActions CorrectionsR = return
|
||||||
|
[ NavPageActionPrimary
|
||||||
|
{ navLink = NavLink
|
||||||
|
{ navLabel = MsgMenuCorrectionsDownload
|
||||||
|
, navRoute = CorrectionsDownloadR
|
||||||
|
, navAccess' = return True
|
||||||
|
, navType = NavTypeLink { navModal = False }
|
||||||
|
, navQuick' = navQuick NavQuickViewPageActionSecondary
|
||||||
|
, navForceActive = False
|
||||||
|
}
|
||||||
|
, navChildren = []
|
||||||
|
}
|
||||||
|
, NavPageActionPrimary
|
||||||
|
{ navLink = NavLink
|
||||||
|
{ navLabel = MsgMenuCorrectionsUpload
|
||||||
|
, navRoute = CorrectionsUploadR
|
||||||
|
, navAccess' = return True
|
||||||
|
, navType = NavTypeLink { navModal = True }
|
||||||
|
, navQuick' = navQuick NavQuickViewPageActionSecondary
|
||||||
|
, navForceActive = False
|
||||||
|
}
|
||||||
|
, navChildren = []
|
||||||
|
}
|
||||||
|
, NavPageActionPrimary
|
||||||
|
{ navLink = NavLink
|
||||||
|
{ navLabel = MsgMenuCorrectionsCreate
|
||||||
|
, navRoute = CorrectionsCreateR
|
||||||
|
, navAccess' = runDB . maybeT (return False) $ do
|
||||||
|
uid <- MaybeT $ liftHandler maybeAuthId
|
||||||
|
sheets <- lift . E.select . E.from $ \(course `E.InnerJoin` sheet) -> do
|
||||||
|
E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse
|
||||||
|
let
|
||||||
|
isCorrector' = E.exists . E.from $ \sheetCorrector -> E.where_
|
||||||
|
$ sheetCorrector E.^. SheetCorrectorUser E.==. E.val uid
|
||||||
|
E.&&. sheetCorrector E.^. SheetCorrectorSheet E.==. sheet E.^. SheetId
|
||||||
|
isLecturer = E.exists . E.from $ \lecturer -> E.where_
|
||||||
|
$ lecturer E.^. LecturerUser E.==. E.val uid
|
||||||
|
E.&&. lecturer E.^. LecturerCourse E.==. course E.^. CourseId
|
||||||
|
E.where_ $ isCorrector' E.||. isLecturer
|
||||||
|
return $ sheet E.^. SheetSubmissionMode
|
||||||
|
return $ orOf (traverse . _Value . _submissionModeCorrector) sheets
|
||||||
|
, navType = NavTypeLink { navModal = False }
|
||||||
|
, navQuick' = navQuick NavQuickViewPageActionSecondary
|
||||||
|
, navForceActive = False
|
||||||
|
}
|
||||||
|
, navChildren = []
|
||||||
|
}
|
||||||
|
, NavPageActionPrimary
|
||||||
|
{ navLink = NavLink
|
||||||
|
{ navLabel = MsgMenuCorrectionsGrade
|
||||||
|
, navRoute = CorrectionsGradeR
|
||||||
|
, navAccess' = return True
|
||||||
|
, navType = NavTypeLink { navModal = False }
|
||||||
|
, navQuick' = mempty
|
||||||
|
, navForceActive = False
|
||||||
|
}
|
||||||
|
, navChildren = []
|
||||||
|
}
|
||||||
|
]
|
||||||
|
pageActions CorrectionsGradeR = do
|
||||||
|
correctionsSecondary <- pageQuickActions NavQuickViewPageActionSecondary CorrectionsR
|
||||||
|
return
|
||||||
|
[ NavPageActionPrimary
|
||||||
|
{ navLink = NavLink
|
||||||
|
{ navLabel = MsgMenuCorrections
|
||||||
|
, navRoute = CorrectionsR
|
||||||
|
, navAccess' = return True
|
||||||
|
, navType = NavTypeLink { navModal = False }
|
||||||
|
, navQuick' = mempty
|
||||||
|
, navForceActive = False
|
||||||
|
}
|
||||||
|
, navChildren = correctionsSecondary
|
||||||
|
}
|
||||||
|
]
|
||||||
|
pageActions EExamListR = return
|
||||||
|
[ NavPageActionPrimary
|
||||||
|
{ navLink = NavLink
|
||||||
|
{ navLabel = MsgMenuExternalExamNew
|
||||||
|
, navRoute = EExamNewR
|
||||||
|
, navAccess' = return True
|
||||||
|
, navType = NavTypeLink { navModal = False }
|
||||||
|
, navQuick' = mempty
|
||||||
|
, navForceActive = False
|
||||||
|
}
|
||||||
|
, navChildren = []
|
||||||
|
}
|
||||||
|
]
|
||||||
|
pageActions (EExamR tid ssh coursen examn EEShowR) = return
|
||||||
|
[ NavPageActionPrimary
|
||||||
|
{ navLink = NavLink
|
||||||
|
{ navLabel = MsgMenuExternalExamEdit
|
||||||
|
, navRoute = EExamR tid ssh coursen examn EEEditR
|
||||||
|
, navAccess' = return True
|
||||||
|
, navType = NavTypeLink { navModal = False }
|
||||||
|
, navQuick' = mempty
|
||||||
|
, navForceActive = False
|
||||||
|
}
|
||||||
|
, navChildren = []
|
||||||
|
}
|
||||||
|
, NavPageActionPrimary
|
||||||
|
{ navLink = NavLink
|
||||||
|
{ navLabel = MsgMenuExternalExamUsers
|
||||||
|
, navRoute = EExamR tid ssh coursen examn EEUsersR
|
||||||
|
, navAccess' = return True
|
||||||
|
, navType = NavTypeLink { navModal = False }
|
||||||
|
, navQuick' = mempty
|
||||||
|
, navForceActive = False
|
||||||
|
}
|
||||||
|
, navChildren = []
|
||||||
|
}
|
||||||
|
, NavPageActionPrimary
|
||||||
|
{ navLink = NavLink
|
||||||
|
{ navLabel = MsgMenuExternalExamGrades
|
||||||
|
, navRoute = EExamR tid ssh coursen examn EEGradesR
|
||||||
|
, navAccess' = return True
|
||||||
|
, navType = NavTypeLink { navModal = False }
|
||||||
|
, navQuick' = mempty
|
||||||
|
, navForceActive = False
|
||||||
|
}
|
||||||
|
, navChildren = []
|
||||||
|
}
|
||||||
|
]
|
||||||
|
pageActions (EExamR tid ssh coursen examn EEGradesR) = return
|
||||||
|
[ NavPageActionPrimary
|
||||||
|
{ navLink = NavLink
|
||||||
|
{ navLabel = MsgMenuExternalExamUsers
|
||||||
|
, navRoute = EExamR tid ssh coursen examn EEUsersR
|
||||||
|
, navAccess' = return True
|
||||||
|
, navType = NavTypeLink { navModal = False }
|
||||||
|
, navQuick' = mempty
|
||||||
|
, navForceActive = False
|
||||||
|
}
|
||||||
|
, navChildren = []
|
||||||
|
}
|
||||||
|
]
|
||||||
|
pageActions (EExamR tid ssh coursen examn EEUsersR) = return
|
||||||
|
[ NavPageActionPrimary
|
||||||
|
{ navLink = NavLink
|
||||||
|
{ navLabel = MsgMenuExternalExamGrades
|
||||||
|
, navRoute = EExamR tid ssh coursen examn EEGradesR
|
||||||
|
, navAccess' = return True
|
||||||
|
, navType = NavTypeLink { navModal = False }
|
||||||
|
, navQuick' = mempty
|
||||||
|
, navForceActive = False
|
||||||
|
}
|
||||||
|
, navChildren = []
|
||||||
|
}
|
||||||
|
]
|
||||||
|
pageActions ParticipantsListR = return
|
||||||
|
[ NavPageActionPrimary
|
||||||
|
{ navLink = NavLink
|
||||||
|
{ navLabel = MsgCsvOptions
|
||||||
|
, navRoute = CsvOptionsR
|
||||||
|
, navAccess' = return True
|
||||||
|
, navType = NavTypeLink { navModal = True }
|
||||||
|
, navQuick' = mempty
|
||||||
|
, navForceActive = False
|
||||||
|
}
|
||||||
|
, navChildren = []
|
||||||
|
}
|
||||||
|
]
|
||||||
pageActions _ = return []
|
pageActions _ = return []
|
||||||
-- pageActions (CourseR tid ssh csh CApplicationsR) =
|
|
||||||
-- [ MenuItem
|
|
||||||
-- { menuItemType = PageActionPrime
|
|
||||||
-- , menuItemLabel = MsgMenuCourseApplicationsFiles
|
|
||||||
-- , menuItemIcon = Nothing
|
|
||||||
-- , menuItemRoute = SomeRoute $ CourseR tid ssh csh CAppsFilesR
|
|
||||||
-- , menuItemModal = False
|
|
||||||
-- , menuItemAccessCallback'
|
|
||||||
-- = let appAccess (E.Value appId) = do
|
|
||||||
-- cID <- encrypt appId
|
|
||||||
-- hasReadAccessTo $ CApplicationR tid ssh csh cID CAFilesR
|
|
||||||
-- appSource = E.selectSource . E.from $ \(course `E.InnerJoin` courseApplication) -> do
|
|
||||||
-- E.on $ course E.^. CourseId E.==. courseApplication E.^. CourseApplicationCourse
|
|
||||||
-- 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
|
|
||||||
-- E.where_ . E.exists . E.from $ \courseApplicationFile ->
|
|
||||||
-- E.where_ $ courseApplicationFile E.^. CourseApplicationFileApplication E.==. courseApplication E.^. CourseApplicationId
|
|
||||||
-- 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
|
|
||||||
-- { menuItemType = PageActionPrime
|
|
||||||
-- , menuItemLabel = MsgMenuCorrectionsDownload
|
|
||||||
-- , menuItemIcon = Nothing
|
|
||||||
-- , menuItemRoute = SomeRoute CorrectionsDownloadR
|
|
||||||
-- , menuItemModal = False
|
|
||||||
-- , menuItemAccessCallback' = return True
|
|
||||||
-- }
|
|
||||||
-- , MenuItem
|
|
||||||
-- { menuItemType = PageActionPrime
|
|
||||||
-- , menuItemLabel = MsgMenuCorrectionsUpload
|
|
||||||
-- , menuItemIcon = Nothing
|
|
||||||
-- , menuItemRoute = SomeRoute CorrectionsUploadR
|
|
||||||
-- , menuItemModal = True
|
|
||||||
-- , menuItemAccessCallback' = return True
|
|
||||||
-- }
|
|
||||||
-- , MenuItem
|
|
||||||
-- { menuItemType = PageActionPrime
|
|
||||||
-- , menuItemLabel = MsgMenuCorrectionsCreate
|
|
||||||
-- , menuItemIcon = Nothing
|
|
||||||
-- , menuItemRoute = SomeRoute CorrectionsCreateR
|
|
||||||
-- , menuItemModal = False
|
|
||||||
-- , menuItemAccessCallback' = runDB . maybeT (return False) $ do
|
|
||||||
-- uid <- MaybeT $ liftHandler maybeAuthId
|
|
||||||
-- sheets <- lift . E.select . E.from $ \(course `E.InnerJoin` sheet) -> do
|
|
||||||
-- E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse
|
|
||||||
-- let
|
|
||||||
-- isCorrector' = E.exists . E.from $ \sheetCorrector -> E.where_
|
|
||||||
-- $ sheetCorrector E.^. SheetCorrectorUser E.==. E.val uid
|
|
||||||
-- E.&&. sheetCorrector E.^. SheetCorrectorSheet E.==. sheet E.^. SheetId
|
|
||||||
-- isLecturer = E.exists . E.from $ \lecturer -> E.where_
|
|
||||||
-- $ lecturer E.^. LecturerUser E.==. E.val uid
|
|
||||||
-- E.&&. lecturer E.^. LecturerCourse E.==. course E.^. CourseId
|
|
||||||
-- E.where_ $ isCorrector' E.||. isLecturer
|
|
||||||
-- return $ sheet E.^. SheetSubmissionMode
|
|
||||||
-- return $ orOf (traverse . _Value . _submissionModeCorrector) sheets
|
|
||||||
-- }
|
|
||||||
-- , MenuItem
|
|
||||||
-- { menuItemType = PageActionPrime
|
|
||||||
-- , menuItemLabel = MsgMenuCorrectionsGrade
|
|
||||||
-- , menuItemIcon = Nothing
|
|
||||||
-- , menuItemRoute = SomeRoute CorrectionsGradeR
|
|
||||||
-- , menuItemModal = False
|
|
||||||
-- , menuItemAccessCallback' = return True
|
|
||||||
-- }
|
|
||||||
-- ]
|
|
||||||
-- pageActions (CorrectionsGradeR) =
|
|
||||||
-- [ MenuItem
|
|
||||||
-- { menuItemType = PageActionPrime
|
|
||||||
-- , menuItemLabel = MsgMenuCorrectionsUpload
|
|
||||||
-- , menuItemIcon = Nothing
|
|
||||||
-- , menuItemRoute = SomeRoute CorrectionsUploadR
|
|
||||||
-- , menuItemModal = True
|
|
||||||
-- , menuItemAccessCallback' = return True
|
|
||||||
-- }
|
|
||||||
-- , MenuItem
|
|
||||||
-- { menuItemType = PageActionPrime
|
|
||||||
-- , menuItemLabel = MsgMenuCorrectionsCreate
|
|
||||||
-- , menuItemIcon = Nothing
|
|
||||||
-- , menuItemRoute = SomeRoute CorrectionsCreateR
|
|
||||||
-- , menuItemModal = False
|
|
||||||
-- , menuItemAccessCallback' = runDB . maybeT (return False) $ do
|
|
||||||
-- uid <- MaybeT $ liftHandler maybeAuthId
|
|
||||||
-- sheets <- lift . E.select . E.from $ \(course `E.InnerJoin` sheet) -> do
|
|
||||||
-- E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse
|
|
||||||
-- let
|
|
||||||
-- isCorrector' = E.exists . E.from $ \sheetCorrector -> E.where_
|
|
||||||
-- $ sheetCorrector E.^. SheetCorrectorUser E.==. E.val uid
|
|
||||||
-- E.&&. sheetCorrector E.^. SheetCorrectorSheet E.==. sheet E.^. SheetId
|
|
||||||
-- isLecturer = E.exists . E.from $ \lecturer -> E.where_
|
|
||||||
-- $ lecturer E.^. LecturerUser E.==. E.val uid
|
|
||||||
-- E.&&. lecturer E.^. LecturerCourse E.==. course E.^. CourseId
|
|
||||||
-- E.where_ $ isCorrector' E.||. isLecturer
|
|
||||||
-- return $ sheet E.^. SheetSubmissionMode
|
|
||||||
-- return $ orOf (traverse . _Value . _submissionModeCorrector) sheets
|
|
||||||
-- }
|
|
||||||
-- ]
|
|
||||||
-- pageActions EExamListR =
|
|
||||||
-- [ MenuItem
|
|
||||||
-- { menuItemType = PageActionPrime
|
|
||||||
-- , menuItemLabel = MsgMenuExternalExamNew
|
|
||||||
-- , menuItemIcon = Nothing
|
|
||||||
-- , menuItemRoute = SomeRoute EExamNewR
|
|
||||||
-- , menuItemModal = False
|
|
||||||
-- , menuItemAccessCallback' = return True
|
|
||||||
-- }
|
|
||||||
-- ]
|
|
||||||
-- pageActions (EExamR tid ssh coursen examn EEShowR) =
|
|
||||||
-- [ MenuItem
|
|
||||||
-- { menuItemType = PageActionPrime
|
|
||||||
-- , menuItemLabel = MsgMenuExternalExamEdit
|
|
||||||
-- , menuItemIcon = Nothing
|
|
||||||
-- , menuItemRoute = SomeRoute $ EExamR tid ssh coursen examn EEEditR
|
|
||||||
-- , menuItemModal = False
|
|
||||||
-- , menuItemAccessCallback' = return True
|
|
||||||
-- }
|
|
||||||
-- , MenuItem
|
|
||||||
-- { menuItemType = PageActionPrime
|
|
||||||
-- , menuItemLabel = MsgMenuExternalExamUsers
|
|
||||||
-- , menuItemIcon = Nothing
|
|
||||||
-- , menuItemRoute = SomeRoute $ EExamR tid ssh coursen examn EEUsersR
|
|
||||||
-- , menuItemModal = False
|
|
||||||
-- , menuItemAccessCallback' = return True
|
|
||||||
-- }
|
|
||||||
-- , MenuItem
|
|
||||||
-- { menuItemType = PageActionPrime
|
|
||||||
-- , menuItemLabel = MsgMenuExternalExamGrades
|
|
||||||
-- , menuItemIcon = Nothing
|
|
||||||
-- , menuItemRoute = SomeRoute $ EExamR tid ssh coursen examn EEGradesR
|
|
||||||
-- , menuItemModal = False
|
|
||||||
-- , menuItemAccessCallback' = return True
|
|
||||||
-- }
|
|
||||||
-- ]
|
|
||||||
-- pageActions (EExamR tid ssh coursen examn EEGradesR) =
|
|
||||||
-- [ MenuItem
|
|
||||||
-- { menuItemType = PageActionPrime
|
|
||||||
-- , menuItemLabel = MsgMenuExternalExamUsers
|
|
||||||
-- , menuItemIcon = Nothing
|
|
||||||
-- , menuItemRoute = SomeRoute $ EExamR tid ssh coursen examn EEUsersR
|
|
||||||
-- , menuItemModal = False
|
|
||||||
-- , menuItemAccessCallback' = return True
|
|
||||||
-- }
|
|
||||||
-- ]
|
|
||||||
-- pageActions (EExamR tid ssh coursen examn EEUsersR) =
|
|
||||||
-- [ MenuItem
|
|
||||||
-- { menuItemType = PageActionPrime
|
|
||||||
-- , menuItemLabel = MsgMenuExternalExamGrades
|
|
||||||
-- , menuItemIcon = Nothing
|
|
||||||
-- , menuItemRoute = SomeRoute $ EExamR tid ssh coursen examn EEGradesR
|
|
||||||
-- , menuItemModal = False
|
|
||||||
-- , menuItemAccessCallback' = return True
|
|
||||||
-- }
|
|
||||||
-- ]
|
|
||||||
-- pageActions ParticipantsListR =
|
|
||||||
-- [ MenuItem
|
|
||||||
-- { menuItemType = PageActionPrime
|
|
||||||
-- , menuItemLabel = MsgCsvOptions
|
|
||||||
-- , menuItemIcon = Nothing
|
|
||||||
-- , menuItemRoute = SomeRoute CsvOptionsR
|
|
||||||
-- , menuItemModal = True
|
|
||||||
-- , menuItemAccessCallback' = return True
|
|
||||||
-- }
|
|
||||||
-- ]
|
|
||||||
-- pageActions _ = []
|
|
||||||
|
|
||||||
pageQuickActions :: ( MonadCatch m
|
pageQuickActions :: ( MonadCatch m
|
||||||
, MonadHandler m
|
, MonadHandler m
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user