Study-Features-Subquery extracted

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 =>
+userTableQuery :: CourseId -> UserTableExpr -> E.SqlQuery ( E.SqlExpr (Entity User)
---                          E.LeftOuterJoin
+                                                          , E.SqlExpr (E.Value UTCTime)
---                            (E.LeftOuterJoin
+                                                          , E.SqlExpr (E.Value (Maybe (Key CourseUserNote)))
---                               (E.InnerJoin
+                                                          , StudyFeaturesDescription')
---                                  (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 cid ((user `E.InnerJoin` participant) `E.LeftOuterJoin` note `E.LeftOuterJoin` _studyFeatures@(features `E.InnerJoin` degree `E.InnerJoin` terms)) = do
+userTableQuery cid ((user `E.InnerJoin` participant) `E.LeftOuterJoin` note `E.LeftOuterJoin` studyFeatures) = do
-  -- Order of nested joins unclear, but this one works somehow:
+  -- Note that order of E.on for nested joins is seemingly right-to-left, ignoring nesting paranthesis
-  E.on $ terms  E.?. StudyTermsId  E.==. features E.?. StudyFeaturesField
+  features <- studyFeaturesQuery' (participant E.^. CourseParticipantField) studyFeatures
-  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
   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

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
+studyFeaturesQuery studyFeaturesId (features `E.InnerJoin` degree `E.InnerJoin` terms) = do
-  E.on $ terms  E.^. StudyTermsId  E.==. features E.^. StudyFeaturesField
+  E.on $ terms    E.^. StudyTermsId    E.==. features E.^. StudyFeaturesField
-  E.on $ degree E.^. StudyDegreeId E.==. features E.^. StudyFeaturesDegree
+  E.on $ degree   E.^. StudyDegreeId   E.==. features E.^. StudyFeaturesDegree
-  E.where_ $ E.just (features E.^. StudyFeaturesId) E.==. sfId
+  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
+--   Sub-Query to retrieve StudyFeatures with their human-readable names
-  => expr (E.Value (Maybe StudyFeaturesId)) -- ^ query is filtered by StudyFeatureId
+studyFeaturesQuery'
-  -> (expr (Maybe (Entity StudyFeatures)) `E.InnerJoin` expr (Maybe (Entity StudyDegree)) `E.InnerJoin` expr (Maybe (Entity StudyTerms)))
+  :: E.SqlExpr (E.Value (Maybe StudyFeaturesId)) -- ^ query is joined on this @Maybe StudyFeaturesId@
-  -> query (expr (Maybe (Entity StudyFeatures)), expr (Maybe (Entity StudyDegree)), expr (Maybe (Entity StudyTerms)))
+  -> (E.SqlExpr (Maybe (Entity StudyFeatures)) `E.InnerJoin` E.SqlExpr (Maybe (Entity StudyDegree)) `E.InnerJoin` E.SqlExpr (Maybe (Entity StudyTerms)))
-studyFeaturesQuery' sfId (features `E.InnerJoin` degree `E.InnerJoin` terms) = do
+  -> E.SqlQuery StudyFeaturesDescription'
-  E.on $ terms  E.?. StudyTermsId  E.==. features E.?. StudyFeaturesField
+studyFeaturesQuery' studyFeatureId (features `E.InnerJoin` degree `E.InnerJoin` terms) = do
-  E.on $ degree E.?. StudyDegreeId E.==. features E.?. StudyFeaturesDegree
+  E.on $ terms    E.?. StudyTermsId    E.==. features E.?. StudyFeaturesField
-  E.where_ $ features E.?. StudyFeaturesId E.==. sfId
+  E.on $ degree   E.?. StudyDegreeId   E.==. features E.?. StudyFeaturesDegree
+  E.on $ features E.?. StudyFeaturesId E.==. studyFeatureId
   return (features, degree, terms)

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