fraport/fradrive-old
fraport/fradrive-old
Archived
3
1
Fork 0
Code Issues 65 Pull Requests 5 Actions Packages Projects Releases 197 Wiki Activity

chore(eo-exams): extend label query with label data

Browse Source
This commit is contained in:
Sarah Vaupel 2021-12-08 22:19:42 +01:00
parent eba56e4d62
commit 12c79612b7
1 changed files with 42 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

63
src/Handler/ExamOffice/Exams.hs
View File

@ -34,23 +34,30 @@ instance Default ExamsTableFilterProj where
makeLenses_ ''ExamsTableFilterProj
type ExamsTableExpr = ( ( E.SqlExpr (Maybe (Entity Exam ))
`E.InnerJoin` E.SqlExpr (Maybe (Entity Course ))
`E.InnerJoin` E.SqlExpr (Maybe (Entity School ))
) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity ExamOfficeExamLabel))
type ExamsTableExpr = ( ( E.SqlExpr (Maybe (Entity Exam ))
`E.InnerJoin` E.SqlExpr (Maybe (Entity Course))
`E.InnerJoin` E.SqlExpr (Maybe (Entity School))
)
`E.LeftOuterJoin`
( E.SqlExpr (Maybe (Entity ExamOfficeExamLabel))
`E.InnerJoin` E.SqlExpr (Maybe (Entity ExamOfficeLabel))
)
)
`E.FullOuterJoin` ( E.SqlExpr (Maybe (Entity ExternalExam ))
`E.LeftOuterJoin` E.SqlExpr (Maybe (Entity ExamOfficeExternalExamLabel))
`E.FullOuterJoin` ( E.SqlExpr (Maybe (Entity ExternalExam))
`E.LeftOuterJoin`
( E.SqlExpr (Maybe (Entity ExamOfficeExternalExamLabel))
`E.InnerJoin` E.SqlExpr (Maybe (Entity ExamOfficeLabel))
)
)
type ExamsTableData = DBRow ( Either
( Entity ExternalExam
, Maybe (Entity ExamOfficeExternalExamLabel)
, Maybe (Entity ExamOfficeLabel)
)
( Entity Exam
, Entity Course
, Entity School
, Maybe (Entity ExamOfficeExamLabel)
, Maybe (Entity ExamOfficeLabel)
)
, Maybe Natural
, Maybe Natural
@ -66,13 +73,19 @@ querySchool :: Getter ExamsTableExpr (E.SqlExpr (Maybe (Entity School)))
querySchool = to $ $(E.sqlIJproj 3 3) . $(E.sqlLOJproj 2 1) . $(E.sqlFOJproj 2 1)
queryExamLabel :: Getter ExamsTableExpr (E.SqlExpr (Maybe (Entity ExamOfficeExamLabel)))
queryExamLabel = to $ $(E.sqlLOJproj 2 2) . $(E.sqlFOJproj 2 1)
queryExamLabel = to $ $(E.sqlIJproj 2 1) . $(E.sqlLOJproj 2 2) . $(E.sqlFOJproj 2 1)
queryLabelExam :: Getter ExamsTableExpr (E.SqlExpr (Maybe (Entity ExamOfficeLabel)))
queryLabelExam = to $ $(E.sqlIJproj 2 2) . $(E.sqlLOJproj 2 2) . $(E.sqlFOJproj 2 1)
queryExternalExam :: Getter ExamsTableExpr (E.SqlExpr (Maybe (Entity ExternalExam)))
queryExternalExam = to $ $(E.sqlLOJproj 2 1) . $(E.sqlFOJproj 2 2)
queryExternalExamLabel :: Getter ExamsTableExpr (E.SqlExpr (Maybe (Entity ExamOfficeExternalExamLabel)))
queryExternalExamLabel = to $ $(E.sqlLOJproj 2 2) . $(E.sqlFOJproj 2 2)
queryExternalExamLabel = to $ $(E.sqlIJproj 2 1) . $(E.sqlLOJproj 2 2) . $(E.sqlFOJproj 2 2)
queryLabelExternalExam :: Getter ExamsTableExpr (E.SqlExpr (Maybe (Entity ExamOfficeLabel)))
queryLabelExternalExam = to $ $(E.sqlIJproj 2 2) . $(E.sqlLOJproj 2 2) . $(E.sqlFOJproj 2 2)
resultExam :: Traversal' ExamsTableData (Entity Exam)
resultExam = _dbrOutput . _1 . _Right . _1
@ -106,7 +119,7 @@ getEOExamsR = do
Just "no" -> False
_ -> userExamOfficeGetSynced
_getLabels <- lookupGetParam "labels" >>= return . \case
getLabels <- lookupGetParam "labels" >>= return . \case
Just "yes" -> True
Just "no" -> False
_ -> userExamOfficeGetLabels
@ -128,24 +141,32 @@ getEOExamsR = do
examsDBTable = DBTable{..}
where
dbtSQLQuery = runReaderT $ do
exam <- view queryExam
course <- view queryCourse
school <- view querySchool
mExamLabel <- view queryExamLabel
externalExam <- view queryExternalExam
exam <- view queryExam
course <- view queryCourse
school <- view querySchool
mExamLabel <- view queryExamLabel
mLabelExam <- view queryLabelExam
externalExam <- view queryExternalExam
mExternalExamLabel <- view queryExternalExamLabel
mLabelExternalExam <- view queryLabelExternalExam
lift $ do
E.on $ externalExam E.?. ExternalExamId E.==. mExternalExamLabel E.?. ExamOfficeExternalExamLabelExternalExam
E.on $ externalExam E.?. ExternalExamId E.==. mExternalExamLabel E.?. ExamOfficeExternalExamLabelExternalExam
E.on $ mExternalExamLabel E.?. ExamOfficeExternalExamLabelLabel E.==. mLabelExternalExam E.?. ExamOfficeLabelId
E.on E.false
E.on $ exam E.?. ExamId E.==. mExamLabel E.?. ExamOfficeExamLabelExam
E.on $ school E.?. SchoolId E.==. course E.?. CourseSchool
E.on $ exam E.?. ExamCourse E.==. course E.?. CourseId
E.on $ exam E.?. ExamId E.==. mExamLabel E.?. ExamOfficeExamLabelExam
E.on $ mExamLabel E.?. ExamOfficeExamLabelLabel E.==. mLabelExam E.?. ExamOfficeLabelId
E.on $ course E.?. CourseSchool E.==. school E.?. SchoolId
E.on $ exam E.?. ExamCourse E.==. course E.?. CourseId
E.where_ $ (E.not_ (E.isNothing $ exam E.?. ExamId) E.&&. E.not_ (E.isNothing $ course E.?. CourseId) E.&&. E.isNothing (externalExam E.?. ExternalExamId))
E.||. ( E.isNothing (exam E.?. ExamId) E.&&. E.isNothing (course E.?. CourseId) E.&&. E.not_ (E.isNothing $ externalExam E.?. ExternalExamId))
E.where_ $ E.val (not getLabels) E.||. (
E.val getLabels
E.&&. mLabelExam E.?. ExamOfficeLabelUser E.==. E.just (E.val uid)
E.&&. mLabelExternalExam E.?. ExamOfficeLabelUser E.==. E.just (E.val uid))
return (exam, course, school, mExamLabel, externalExam, mExternalExamLabel)
return (exam, course, school, mLabelExam, externalExam, mLabelExternalExam)
dbtRowKey = views ($(multifocusG 2) queryExam queryExternalExam) (bimap (E.?. ExamId) (E.?. ExternalExamId))
-- [ singletonMap "may-access" . FilterProjected $ \(Any b) r -> (== b) <$> if