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): query eo-labels

Browse Source
This commit is contained in:
Sarah Vaupel 2021-12-07 20:11:26 +01:00
parent ad39c2755f
commit 3ae9d5274b
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,28 +34,45 @@ 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))
type ExamsTableExpr = ( E.SqlExpr (Maybe (Entity Exam ))
`E.InnerJoin` E.SqlExpr (Maybe (Entity ExamOfficeExamLabel))
`E.InnerJoin` E.SqlExpr (Maybe (Entity Course ))
`E.InnerJoin` E.SqlExpr (Maybe (Entity School ))
)
`E.FullOuterJoin` ( E.SqlExpr (Maybe (Entity ExternalExam ))
`E.InnerJoin` E.SqlExpr (Maybe (Entity ExamOfficeExternalExamLabel))
)
`E.FullOuterJoin` E.SqlExpr (Maybe (Entity ExternalExam))
type ExamsTableData = DBRow ( Either (Entity ExternalExam) (Entity Exam, Entity Course, Entity School)
, Maybe Natural, Maybe Natural
type ExamsTableData = DBRow ( Either
( Entity ExternalExam
, Maybe (Entity ExamOfficeExternalExamLabel)
)
( Entity Exam
, Entity Course
, Entity School
, Maybe (Entity ExamOfficeExamLabel)
)
, Maybe Natural
, Maybe Natural
)
queryExam :: Getter ExamsTableExpr (E.SqlExpr (Maybe (Entity Exam)))
queryExam = to $ $(E.sqlIJproj 3 1) . $(E.sqlFOJproj 2 1)
queryExam = to $ $(E.sqlIJproj 4 1) . $(E.sqlFOJproj 2 1)
queryExamLabel :: Getter ExamsTableExpr (E.SqlExpr (Maybe (Entity ExamOfficeExamLabel)))
queryExamLabel = to $ $(E.sqlIJproj 4 2) . $(E.sqlFOJproj 2 1)
queryCourse :: Getter ExamsTableExpr (E.SqlExpr (Maybe (Entity Course)))
queryCourse = to $ $(E.sqlIJproj 3 2) . $(E.sqlFOJproj 2 1)
queryCourse = to $ $(E.sqlIJproj 4 3) . $(E.sqlFOJproj 2 1)
querySchool :: Getter ExamsTableExpr (E.SqlExpr (Maybe (Entity School)))
querySchool = to $ $(E.sqlIJproj 3 3) . $(E.sqlFOJproj 2 1)
querySchool = to $ $(E.sqlIJproj 4 4) . $(E.sqlFOJproj 2 1)
queryExternalExam :: Getter ExamsTableExpr (E.SqlExpr (Maybe (Entity ExternalExam)))
queryExternalExam = to $(E.sqlFOJproj 2 2)
queryExternalExam = to $ $(E.sqlIJproj 2 1) . $(E.sqlFOJproj 2 2)
queryExternalExamLabel :: Getter ExamsTableExpr (E.SqlExpr (Maybe (Entity ExamOfficeExternalExamLabel)))
queryExternalExamLabel = to $ $(E.sqlIJproj 2 2) . $(E.sqlFOJproj 2 2)
resultExam :: Traversal' ExamsTableData (Entity Exam)
resultExam = _dbrOutput . _1 . _Right . _1
@ -67,7 +84,7 @@ resultSchool :: Traversal' ExamsTableData (Entity School)
resultSchool = _dbrOutput . _1 . _Right . _3
resultExternalExam :: Traversal' ExamsTableData (Entity ExternalExam)
resultExternalExam = _dbrOutput . _1 . _Left
resultExternalExam = _dbrOutput . _1 . _Left . _1
resultSynchronised, resultResults :: Lens' ExamsTableData (Maybe Natural)
resultSynchronised = _dbrOutput . _2
@ -89,7 +106,7 @@ getEOExamsR = do
Just "no" -> False
_ -> userExamOfficeGetSynced
getLabels <- lookupGetParam "labels" >>= return . \case
_getLabels <- lookupGetParam "labels" >>= return . \case
Just "yes" -> True
Just "no" -> False
_ -> userExamOfficeGetLabels
@ -112,9 +129,11 @@ getEOExamsR = do
where
dbtSQLQuery = runReaderT $ do
exam <- view queryExam
mExamLabel <- view queryExamLabel
course <- view queryCourse
school <- view querySchool
externalExam <- view queryExternalExam
mExternalExamLabel <- view queryExternalExamLabel
lift $ do
E.on E.false
@ -124,7 +143,7 @@ getEOExamsR = do
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))
return (exam, course, school, externalExam)
return (exam, mExamLabel, course, school, externalExam, mExternalExamLabel)
dbtRowKey = views ($(multifocusG 2) queryExam queryExternalExam) (bimap (E.?. ExamId) (E.?. ExternalExamId))
-- [ singletonMap "may-access" . FilterProjected $ \(Any b) r -> (== b) <$> if
@ -142,9 +161,11 @@ getEOExamsR = do
dbtProj :: _ ExamsTableData
dbtProj = (views _dbtProjRow . set _dbrOutput) =<< do -- dbtProjSimple . runReaderT $ do
exam <- view $ _dbtProjRow . _dbrOutput . _1
course <- view $ _dbtProjRow . _dbrOutput . _2
school <- view $ _dbtProjRow . _dbrOutput . _3
externalExam <- view $ _dbtProjRow . _dbrOutput . _4
mExamLabel <- view $ _dbtProjRow . _dbrOutput . _2
course <- view $ _dbtProjRow . _dbrOutput . _3
school <- view $ _dbtProjRow . _dbrOutput . _4
externalExam <- view $ _dbtProjRow . _dbrOutput . _5
mExternalExamLabel <- view $ _dbtProjRow . _dbrOutput . _6
forMM_ (view $ _dbtProjFilter . _etProjFilterMayAccess) $ \b -> if
| Just (Entity _ exam') <- exam
@ -179,11 +200,11 @@ getEOExamsR = do
forMM_ (view $ _dbtProjFilter . _etProjFilterHasResults) guard
return Nothing
case (exam, course, school, externalExam) of
(Just exam', Just course', Just school', Nothing) -> return
(Right (exam', course', school'), snd <$> mCounts, fst <$> mCounts)
(Nothing, Nothing, Nothing, Just externalExam') -> return
(Left externalExam', snd <$> mCounts, fst <$> mCounts)
case (exam, mExamLabel, course, school, externalExam, mExternalExamLabel) of
(Just exam', mExamLabel', Just course', Just school', Nothing, Nothing) -> return
(Right (exam', course', school', mExamLabel'), snd <$> mCounts, fst <$> mCounts)
(Nothing, Nothing, Nothing, Nothing, Just externalExam', mExternalExamLabel') -> return
(Left (externalExam', mExternalExamLabel'), snd <$> mCounts, fst <$> mCounts)
_other -> return $ error "Got exam & externalExam in same result"