From 3ae9d5274be9bed64e28389dd9ec32826ef9c7d7 Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Tue, 7 Dec 2021 20:11:26 +0100 Subject: [PATCH] chore(eo-exams): query eo-labels --- src/Handler/ExamOffice/Exams.hs | 63 ++++++++++++++++++++++----------- 1 file changed, 42 insertions(+), 21 deletions(-) diff --git a/src/Handler/ExamOffice/Exams.hs b/src/Handler/ExamOffice/Exams.hs index c05859ef5..41511a43c 100644 --- a/src/Handler/ExamOffice/Exams.hs +++ b/src/Handler/ExamOffice/Exams.hs @@ -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"