feat(pageactions): finish restoration
This commit is contained in:
Gregor Kleen
parent
4bc48a50fa
commit
e1cac76f15
@ -2909,6 +2909,17 @@ pageActions ProfileR = return
|
||||
}
|
||||
, navChildren = []
|
||||
}
|
||||
, NavPageActionPrimary
|
||||
{ navLink = NavLink
|
||||
{ navLabel = MsgCsvOptions
|
||||
, navRoute = CsvOptionsR
|
||||
, navAccess' = return True
|
||||
, navType = NavTypeLink { navModal = True }
|
||||
, navQuick' = mempty
|
||||
, navForceActive = False
|
||||
}
|
||||
, navChildren = []
|
||||
}
|
||||
]
|
||||
pageActions TermShowR = return
|
||||
[ 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 (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
|
||||
, MonadHandler m
|
||||
|
||||
Loading…
Reference in New Issue
Block a user