From 4253390e930f4073af09b19080b6a9573d35f884 Mon Sep 17 00:00:00 2001 From: SJost Date: Fri, 8 Mar 2019 10:46:47 +0100 Subject: [PATCH] Study-Features-Subquery extracted --- src/Handler/Course.hs | 40 ++++++++++------------------------- src/Handler/Utils/Database.hs | 35 ++++++++++++++++++------------ start.sh | 2 +- 3 files changed, 34 insertions(+), 43 deletions(-) diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs index f7f281c92..0da847ef6 100644 --- a/src/Handler/Course.hs +++ b/src/Handler/Course.hs @@ -11,6 +11,7 @@ import Handler.Utils import Handler.Utils.Table.Cells import Handler.Utils.Course import Handler.Utils.Delete +import Handler.Utils.Database -- import Data.Time -- import qualified Data.Text as T @@ -653,44 +654,25 @@ validateCourse CourseForm{..} = type UserTableExpr = (E.SqlExpr (Entity User) `E.InnerJoin` E.SqlExpr (Entity CourseParticipant)) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity CourseUserNote)) - `E.LeftOuterJoin` (E.SqlExpr (Maybe (Entity StudyFeatures)) `E.InnerJoin` E.SqlExpr (Maybe (Entity StudyDegree)) `E.InnerJoin`E.SqlExpr (Maybe (Entity StudyTerms))) + `E.LeftOuterJoin` + (E.SqlExpr (Maybe (Entity StudyFeatures)) `E.InnerJoin` E.SqlExpr (Maybe (Entity StudyDegree)) `E.InnerJoin`E.SqlExpr (Maybe (Entity StudyTerms))) type UserTableData = DBRow (Entity User, UTCTime, Maybe CourseUserNoteId, (Maybe StudyFeatures, Maybe StudyDegree, Maybe StudyTerms)) forceUserTableType :: (UserTableExpr -> a) -> (UserTableExpr -> a) forceUserTableType = id --- userTableQuery :: CourseId -> E.Esqueleto query expr backend => --- E.LeftOuterJoin --- (E.LeftOuterJoin --- (E.InnerJoin --- (expr (Entity User)) (expr (Entity CourseParticipant))) --- (expr (Maybe (Entity CourseUserNote)))) --- (E.InnerJoin --- (E.InnerJoin --- (expr (Maybe (Entity StudyFeatures))) --- (expr (Maybe (Entity StudyDegree)))) --- (expr (Maybe (Entity StudyTerms)))) --- -> query (expr (Entity User), expr (E.Value UTCTime), --- expr (E.Value (Maybe (Key CourseUserNote))), --- (expr (Maybe (Entity StudyFeatures)), expr (Maybe (Entity StudyDegree)), expr (Maybe (Entity StudyTerms)))) -userTableQuery :: CourseId -> UserTableExpr -> E.SqlQuery (E.SqlExpr (Entity User) - ,E.SqlExpr (E.Value UTCTime) - ,E.SqlExpr (E.Value (Maybe (Key CourseUserNote))) - ,(E.SqlExpr (Maybe (Entity StudyFeatures)) - , E.SqlExpr (Maybe (Entity StudyDegree)) - , E.SqlExpr (Maybe (Entity StudyTerms)) - )) +userTableQuery :: CourseId -> UserTableExpr -> E.SqlQuery ( E.SqlExpr (Entity User) + , E.SqlExpr (E.Value UTCTime) + , E.SqlExpr (E.Value (Maybe (Key CourseUserNote))) + , StudyFeaturesDescription') -userTableQuery cid ((user `E.InnerJoin` participant) `E.LeftOuterJoin` note `E.LeftOuterJoin` _studyFeatures@(features `E.InnerJoin` degree `E.InnerJoin` terms)) = do - -- Order of nested joins unclear, but this one works somehow: - E.on $ terms E.?. StudyTermsId E.==. features E.?. StudyFeaturesField - E.on $ degree E.?. StudyDegreeId E.==. features E.?. StudyFeaturesDegree - E.on $ participant E.^. CourseParticipantField E.==. features E.?. StudyFeaturesId - --(features, degree, terms) <- studyFeaturesQuery (participant E.^. CourseParticipantField) studyFeatures +userTableQuery cid ((user `E.InnerJoin` participant) `E.LeftOuterJoin` note `E.LeftOuterJoin` studyFeatures) = do + -- Note that order of E.on for nested joins is seemingly right-to-left, ignoring nesting paranthesis + features <- studyFeaturesQuery' (participant E.^. CourseParticipantField) studyFeatures E.on $ E.just (participant E.^. CourseParticipantUser) E.==. note E.?. CourseUserNoteUser E.on $ participant E.^. CourseParticipantUser E.==. user E.^. UserId E.where_ $ participant E.^. CourseParticipantCourse E.==. E.val cid - return (user, participant E.^. CourseParticipantRegistration, note E.?. CourseUserNoteId, (features,degree,terms)) + return (user, participant E.^. CourseParticipantRegistration, note E.?. CourseUserNoteId, features) instance HasEntity UserTableData User where diff --git a/src/Handler/Utils/Database.hs b/src/Handler/Utils/Database.hs index 05d44c8ad..83b299a94 100644 --- a/src/Handler/Utils/Database.hs +++ b/src/Handler/Utils/Database.hs @@ -1,6 +1,7 @@ module Handler.Utils.Database ( getSchoolsOf , makeSchoolDictionaryDB, makeSchoolDictionary + , StudyFeaturesDescription' , studyFeaturesQuery, studyFeaturesQuery' ) where @@ -32,23 +33,31 @@ getSchoolsOf uid uschool uuser = fmap (Import.map E.unValue) $ E.select $ E.from return $ school E.^. SchoolName +-- | Sub-Query to retrieve StudyFeatures with their human-readable names studyFeaturesQuery :: E.Esqueleto query expr backend - => expr (E.Value (Maybe StudyFeaturesId)) -- ^ query is filtered by StudyFeatureId + => expr (E.Value StudyFeaturesId) -- ^ query is joined on this @StudyFeaturesId@ -> expr (Entity StudyFeatures) `E.InnerJoin` expr (Entity StudyDegree) `E.InnerJoin` expr (Entity StudyTerms) -> query (expr (Entity StudyFeatures), expr (Entity StudyDegree), expr (Entity StudyTerms)) -studyFeaturesQuery sfId (features `E.InnerJoin` degree `E.InnerJoin` terms) = do - E.on $ terms E.^. StudyTermsId E.==. features E.^. StudyFeaturesField - E.on $ degree E.^. StudyDegreeId E.==. features E.^. StudyFeaturesDegree - E.where_ $ E.just (features E.^. StudyFeaturesId) E.==. sfId +studyFeaturesQuery studyFeaturesId (features `E.InnerJoin` degree `E.InnerJoin` terms) = do + E.on $ terms E.^. StudyTermsId E.==. features E.^. StudyFeaturesField + E.on $ degree E.^. StudyDegreeId E.==. features E.^. StudyFeaturesDegree + E.on $ features E.^. StudyFeaturesId E.==. studyFeaturesId return (features, degree, terms) +type StudyFeaturesDescription' = + ( E.SqlExpr (Maybe (Entity StudyFeatures)) + , E.SqlExpr (Maybe (Entity StudyDegree)) + , E.SqlExpr (Maybe (Entity StudyTerms)) + ) + -- | Variant of @studyFeaturesQuery@ to be used in outer joins -studyFeaturesQuery' :: E.Esqueleto query expr backend - => expr (E.Value (Maybe StudyFeaturesId)) -- ^ query is filtered by StudyFeatureId - -> (expr (Maybe (Entity StudyFeatures)) `E.InnerJoin` expr (Maybe (Entity StudyDegree)) `E.InnerJoin` expr (Maybe (Entity StudyTerms))) - -> query (expr (Maybe (Entity StudyFeatures)), expr (Maybe (Entity StudyDegree)), expr (Maybe (Entity StudyTerms))) -studyFeaturesQuery' sfId (features `E.InnerJoin` degree `E.InnerJoin` terms) = do - E.on $ terms E.?. StudyTermsId E.==. features E.?. StudyFeaturesField - E.on $ degree E.?. StudyDegreeId E.==. features E.?. StudyFeaturesDegree - E.where_ $ features E.?. StudyFeaturesId E.==. sfId +-- Sub-Query to retrieve StudyFeatures with their human-readable names +studyFeaturesQuery' + :: E.SqlExpr (E.Value (Maybe StudyFeaturesId)) -- ^ query is joined on this @Maybe StudyFeaturesId@ + -> (E.SqlExpr (Maybe (Entity StudyFeatures)) `E.InnerJoin` E.SqlExpr (Maybe (Entity StudyDegree)) `E.InnerJoin` E.SqlExpr (Maybe (Entity StudyTerms))) + -> E.SqlQuery StudyFeaturesDescription' +studyFeaturesQuery' studyFeatureId (features `E.InnerJoin` degree `E.InnerJoin` terms) = do + E.on $ terms E.?. StudyTermsId E.==. features E.?. StudyFeaturesField + E.on $ degree E.?. StudyDegreeId E.==. features E.?. StudyFeaturesDegree + E.on $ features E.?. StudyFeaturesId E.==. studyFeatureId return (features, degree, terms) diff --git a/start.sh b/start.sh index 24abcd36c..b72d043c2 100755 --- a/start.sh +++ b/start.sh @@ -2,7 +2,7 @@ unset HOST export DETAILED_LOGGING=true -export LOG_ALL=true +export LOG_ALL=false export LOGLEVEL=info export DUMMY_LOGIN=true export ALLOW_DEPRECATED=true