Study-Features-Subquery extracted
This commit is contained in:
SJost
parent
729831b0bf
commit
4253390e93
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user