refactor(course-visibility): make course utils require less
This commit is contained in:
Sarah Vaupel
parent
1b86d61998
commit
0c3f2011dd
@ -43,7 +43,7 @@ getAShowR tid ssh ash = do
|
||||
E.&&. courseApplication E.?. CourseApplicationAllocation E.==. E.just (E.just $ E.val aId)
|
||||
E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
|
||||
E.where_ $ allocationCourse E.^. AllocationCourseAllocation E.==. E.val aId
|
||||
E.&&. mayViewCourse muid ata now course
|
||||
E.&&. mayViewCourse' muid ata now course
|
||||
E.orderBy [E.asc $ course E.^. CourseName]
|
||||
let hasTemplate = E.exists . E.from $ \courseAppInstructionFile ->
|
||||
E.where_ $ courseAppInstructionFile E.^. CourseAppInstructionFileCourse E.==. course E.^. CourseId
|
||||
|
||||
@ -60,10 +60,10 @@ colRegistered = sortable (Just "registered") (i18nCell MsgRegistered)
|
||||
type CourseTableExpr = E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity School)
|
||||
|
||||
course2Participants :: CourseTableExpr -> E.SqlExpr (E.Value Int)
|
||||
course2Participants (course `E.InnerJoin` _school) = numCourseParticipants course
|
||||
course2Participants (course `E.InnerJoin` _school) = numCourseParticipants $ course E.^. CourseId
|
||||
|
||||
course2Registered :: Maybe UserId -> AuthTagActive -> CourseTableExpr -> E.SqlExpr (E.Value Bool)
|
||||
course2Registered muid ata (course `E.InnerJoin` _school) = isCourseParticipant muid ata course
|
||||
course2Registered muid ata (course `E.InnerJoin` _school) = isCourseParticipant muid ata $ course E.^. CourseId
|
||||
|
||||
makeCourseTable :: ( IsDBTable m x, ToSortable h, Functor h, DBResult m x ~ ((), Widget) )
|
||||
=> _ -> Colonnade h CourseTableData (DBCell m x) -> PSValidator m x -> DB Widget
|
||||
@ -76,14 +76,14 @@ makeCourseTable whereClause colChoices psValidator = do
|
||||
E.on $ course E.^. CourseSchool E.==. school E.^. SchoolId
|
||||
let participants = course2Participants qin
|
||||
let registered = course2Registered muid ata qin
|
||||
let mayView = mayViewCourse muid ata now course
|
||||
let mayView = mayViewCourse' muid ata now course
|
||||
E.where_ $ whereClause (course, participants, registered, mayView)
|
||||
return (course, participants, registered, school)
|
||||
lecturerQuery cid (user `E.InnerJoin` lecturer) = do
|
||||
E.on $ user E.^. UserId E.==. lecturer E.^. LecturerUser
|
||||
E.where_ $ cid E.==. lecturer E.^. LecturerCourse E.&&. lecturer E.^. LecturerType E.==. E.val CourseLecturer
|
||||
return user
|
||||
isEditorQuery course user = E.where_ $ mayEditCourse' muid ata course
|
||||
isEditorQuery course user = E.where_ $ mayEditCourse muid ata course
|
||||
E.&&. E.just (user E.^. UserId) E.==. E.val muid
|
||||
dbtProj :: DBRow _ -> DB CourseTableData
|
||||
dbtProj = traverse $ \(course, E.Value participants, E.Value registered, school) -> do
|
||||
|
||||
@ -6,7 +6,7 @@ module Handler.Term
|
||||
|
||||
import Import
|
||||
|
||||
import Utils.Course (mayViewCourse)
|
||||
import Utils.Course (mayViewCourse')
|
||||
|
||||
import Handler.Utils
|
||||
|
||||
@ -74,7 +74,7 @@ getTermShowR = do
|
||||
where dbtSQLQuery term = return (term, courseCount)
|
||||
where courseCount = E.subSelectCount . E.from $ \course ->
|
||||
E.where_ $ term E.^. TermId E.==. course E.^. CourseTerm
|
||||
E.&&. mayViewCourse muid ata now course
|
||||
E.&&. mayViewCourse' muid ata now course
|
||||
dbtRowKey = (E.^. TermId)
|
||||
dbtProj = return . dbrOutput
|
||||
dbtColonnade = widgetColonnade $ mconcat
|
||||
|
||||
@ -1,10 +1,7 @@
|
||||
module Utils.Course
|
||||
( mayViewCourse, mayEditCourse
|
||||
, mayEditCourse'
|
||||
( mayViewCourse, mayViewCourse', mayEditCourse, mayEditCourse'
|
||||
, isCourseLecturer, isCourseTutor, isCourseCorrector, isCourseParticipant, isCourseAssociated
|
||||
, isCourseLecturer'
|
||||
, courseIsVisible
|
||||
, courseIsVisible'
|
||||
, courseIsVisible, courseIsVisible'
|
||||
, numCourseParticipants
|
||||
) where
|
||||
|
||||
@ -14,74 +11,70 @@ import qualified Database.Esqueleto as E
|
||||
import qualified Database.Esqueleto.Utils as E
|
||||
|
||||
|
||||
-- TODO switch from E.SqlExpr (Entity Course) to CourseId wherever possible
|
||||
mayViewCourse :: Maybe UserId -> AuthTagActive -> UTCTime -> Entity Course -> E.SqlExpr (E.Value Bool)
|
||||
mayViewCourse muid ata now c@(Entity cid course) =
|
||||
mayEditCourse muid ata c
|
||||
E.||. isCourseAssociated muid ata (E.val cid)
|
||||
E.||. E.val (courseIsVisible' now course)
|
||||
|
||||
mayViewCourse' :: Maybe UserId -> AuthTagActive -> UTCTime -> E.SqlExpr (Entity Course) -> E.SqlExpr (E.Value Bool)
|
||||
mayViewCourse' muid ata now course =
|
||||
mayEditCourse' muid ata course
|
||||
E.||. isCourseAssociated muid ata (course E.^. CourseId)
|
||||
E.||. courseIsVisible now course
|
||||
|
||||
mayViewCourse :: Maybe UserId -> AuthTagActive -> UTCTime -> E.SqlExpr (Entity Course) -> E.SqlExpr (E.Value Bool)
|
||||
mayViewCourse muid ata now course =
|
||||
mayEditCourse muid ata course
|
||||
E.||. isCourseAssociated muid ata course
|
||||
E.||. courseIsVisible now course
|
||||
|
||||
mayEditCourse :: Maybe UserId -> AuthTagActive -> E.SqlExpr (Entity Course) -> E.SqlExpr (E.Value Bool)
|
||||
mayEditCourse muid ata@AuthTagActive{..} course = (E.exists . E.from $ \(user `E.InnerJoin` userFunction) -> do
|
||||
E.on $ user E.^. UserId E.==. userFunction E.^. UserFunctionUser
|
||||
E.where_ $ E.just (user E.^. UserId) E.==. E.val muid
|
||||
E.&&. userFunction E.^. UserFunctionFunction E.==. E.val SchoolAdmin
|
||||
E.&&. userFunction E.^. UserFunctionSchool E.==. course E.^. CourseSchool
|
||||
E.&&. E.val (authTagIsActive AuthAdmin)
|
||||
) E.||. isCourseLecturer muid ata course
|
||||
|
||||
mayEditCourse' :: Maybe UserId -> AuthTagActive -> Entity Course -> E.SqlExpr (E.Value Bool)
|
||||
mayEditCourse' muid ata@AuthTagActive{..} (Entity cid Course{..}) = (E.exists . E.from $ \(user `E.InnerJoin` userFunction) -> do
|
||||
mayEditCourse :: Maybe UserId -> AuthTagActive -> Entity Course -> E.SqlExpr (E.Value Bool)
|
||||
mayEditCourse muid ata@AuthTagActive{..} (Entity cid Course{..}) = (E.exists . E.from $ \(user `E.InnerJoin` userFunction) -> do
|
||||
E.on $ user E.^. UserId E.==. userFunction E.^. UserFunctionUser
|
||||
E.where_ $ E.just (user E.^. UserId) E.==. E.val muid
|
||||
E.&&. userFunction E.^. UserFunctionFunction E.==. E.val SchoolAdmin
|
||||
E.&&. userFunction E.^. UserFunctionSchool E.==. E.val courseSchool
|
||||
E.&&. E.val (authTagIsActive AuthAdmin)
|
||||
) E.||. isCourseLecturer' muid ata cid
|
||||
) E.||. isCourseLecturer muid ata (E.val cid)
|
||||
|
||||
isCourseLecturer :: Maybe UserId -> AuthTagActive -> E.SqlExpr (Entity Course) -> E.SqlExpr (E.Value Bool)
|
||||
isCourseLecturer muid AuthTagActive{..} course = E.exists . E.from $ \(user `E.InnerJoin` lecturer) -> do
|
||||
mayEditCourse' :: Maybe UserId -> AuthTagActive -> E.SqlExpr (Entity Course) -> E.SqlExpr (E.Value Bool)
|
||||
mayEditCourse' muid ata@AuthTagActive{..} course = (E.exists . E.from $ \(user `E.InnerJoin` userFunction) -> do
|
||||
E.on $ user E.^. UserId E.==. userFunction E.^. UserFunctionUser
|
||||
E.where_ $ E.just (user E.^. UserId) E.==. E.val muid
|
||||
E.&&. userFunction E.^. UserFunctionFunction E.==. E.val SchoolAdmin
|
||||
E.&&. userFunction E.^. UserFunctionSchool E.==. course E.^. CourseSchool
|
||||
E.&&. E.val (authTagIsActive AuthAdmin)
|
||||
) E.||. isCourseLecturer muid ata (course E.^. CourseId)
|
||||
|
||||
isCourseLecturer :: Maybe UserId -> AuthTagActive -> E.SqlExpr (E.Value CourseId) -> E.SqlExpr (E.Value Bool)
|
||||
isCourseLecturer muid AuthTagActive{..} cid = E.exists . E.from $ \(user `E.InnerJoin` lecturer) -> do
|
||||
E.on $ user E.^. UserId E.==. lecturer E.^. LecturerUser
|
||||
E.where_ $ E.just (user E.^. UserId) E.==. E.val muid
|
||||
E.&&. lecturer E.^. LecturerCourse E.==. course E.^. CourseId
|
||||
E.&&. lecturer E.^. LecturerCourse E.==. cid
|
||||
E.&&. E.val (authTagIsActive AuthLecturer)
|
||||
|
||||
isCourseLecturer' :: Maybe UserId -> AuthTagActive -> CourseId -> E.SqlExpr (E.Value Bool)
|
||||
isCourseLecturer' muid AuthTagActive{..} cid = E.exists . E.from $ \(user `E.InnerJoin` lecturer) -> do
|
||||
E.on $ user E.^. UserId E.==. lecturer E.^. LecturerUser
|
||||
E.where_ $ E.just (user E.^. UserId) E.==. E.val muid
|
||||
E.&&. lecturer E.^. LecturerCourse E.==. E.val cid
|
||||
E.&&. E.val (authTagIsActive AuthLecturer)
|
||||
|
||||
isCourseTutor :: Maybe UserId -> AuthTagActive -> E.SqlExpr (Entity Course) -> E.SqlExpr (E.Value Bool)
|
||||
isCourseTutor muid AuthTagActive{..} course = E.exists . E.from $ \(tutor `E.InnerJoin` tutorial) -> do
|
||||
isCourseTutor :: Maybe UserId -> AuthTagActive -> E.SqlExpr (E.Value CourseId) -> E.SqlExpr (E.Value Bool)
|
||||
isCourseTutor muid AuthTagActive{..} cid = E.exists . E.from $ \(tutor `E.InnerJoin` tutorial) -> do
|
||||
E.on $ tutor E.^. TutorTutorial E.==. tutorial E.^. TutorialId
|
||||
E.where_ $ E.just (tutor E.^. TutorUser) E.==. E.val muid
|
||||
E.&&. tutorial E.^. TutorialCourse E.==. course E.^. CourseId
|
||||
E.&&. tutorial E.^. TutorialCourse E.==. cid
|
||||
E.&&. E.val (authTagIsActive AuthTutor)
|
||||
|
||||
isCourseCorrector :: Maybe UserId -> AuthTagActive -> E.SqlExpr (Entity Course) -> E.SqlExpr (E.Value Bool)
|
||||
isCourseCorrector muid AuthTagActive{..} course = E.exists . E.from $ \(sheetCorrector `E.InnerJoin` sheet) -> do
|
||||
isCourseCorrector :: Maybe UserId -> AuthTagActive -> E.SqlExpr (E.Value CourseId) -> E.SqlExpr (E.Value Bool)
|
||||
isCourseCorrector muid AuthTagActive{..} cid = E.exists . E.from $ \(sheetCorrector `E.InnerJoin` sheet) -> do
|
||||
E.on $ sheetCorrector E.^. SheetCorrectorSheet E.==. sheet E.^. SheetId
|
||||
E.where_ $ E.just (sheetCorrector E.^. SheetCorrectorUser) E.==. E.val muid
|
||||
E.&&. sheet E.^. SheetCourse E.==. course E.^. CourseId
|
||||
E.&&. sheet E.^. SheetCourse E.==. cid
|
||||
E.&&. E.val (authTagIsActive AuthCorrector)
|
||||
|
||||
isCourseParticipant :: Maybe UserId -> AuthTagActive -> E.SqlExpr (Entity Course) -> E.SqlExpr (E.Value Bool)
|
||||
isCourseParticipant muid AuthTagActive{..} course = E.exists . E.from $ \courseParticipant -> do
|
||||
isCourseParticipant :: Maybe UserId -> AuthTagActive -> E.SqlExpr (E.Value CourseId) -> E.SqlExpr (E.Value Bool)
|
||||
isCourseParticipant muid AuthTagActive{..} cid = E.exists . E.from $ \courseParticipant -> do
|
||||
E.where_ $ E.just (courseParticipant E.^. CourseParticipantUser) E.==. E.val muid
|
||||
E.&&. courseParticipant E.^. CourseParticipantCourse E.==. course E.^. CourseId
|
||||
E.&&. courseParticipant E.^. CourseParticipantCourse E.==. cid
|
||||
E.&&. courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
|
||||
E.&&. E.val (authTagIsActive AuthCourseRegistered) -- TODO is this the auth tag I want here?
|
||||
|
||||
isCourseAssociated :: Maybe UserId -> AuthTagActive -> E.SqlExpr (Entity Course) -> E.SqlExpr (E.Value Bool)
|
||||
isCourseAssociated muid ata course =
|
||||
isCourseLecturer muid ata course
|
||||
E.||. isCourseTutor muid ata course
|
||||
E.||. isCourseCorrector muid ata course
|
||||
E.||. isCourseParticipant muid ata course
|
||||
isCourseAssociated :: Maybe UserId -> AuthTagActive -> E.SqlExpr (E.Value CourseId) -> E.SqlExpr (E.Value Bool)
|
||||
isCourseAssociated muid ata cid =
|
||||
isCourseLecturer muid ata cid
|
||||
E.||. isCourseTutor muid ata cid
|
||||
E.||. isCourseCorrector muid ata cid
|
||||
E.||. isCourseParticipant muid ata cid
|
||||
|
||||
courseIsVisible :: UTCTime -> E.SqlExpr (Entity Course) -> E.SqlExpr (E.Value Bool)
|
||||
courseIsVisible now course =
|
||||
@ -96,7 +89,7 @@ courseIsVisible' :: UTCTime -> Course -> Bool
|
||||
courseIsVisible' now Course{..} = NTop courseVisibleFrom <= now' && now' <= NTop courseVisibleTo
|
||||
where now' = NTop $ Just now
|
||||
|
||||
numCourseParticipants :: E.SqlExpr (Entity Course) -> E.SqlExpr (E.Value Int)
|
||||
numCourseParticipants course = E.subSelectCount . E.from $ \courseParticipant ->
|
||||
E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. course E.^. CourseId
|
||||
numCourseParticipants :: E.SqlExpr (E.Value CourseId) -> E.SqlExpr (E.Value Int)
|
||||
numCourseParticipants cid = E.subSelectCount . E.from $ \courseParticipant ->
|
||||
E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. cid
|
||||
E.&&. courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
|
||||
|
||||
Loading…
Reference in New Issue
Block a user