Alternative Query Attempt
This commit is contained in:
parent
382a34f970
commit
56c25c133a
@ -649,6 +649,31 @@ validateCourse CourseForm{..} =
|
||||
--------------------
|
||||
-- CourseUserTable
|
||||
|
||||
|
||||
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' cid ((user `E.InnerJoin` participant) `E.LeftOuterJoin` note `E.LeftOuterJoin` _studyFeatures@(features `E.InnerJoin` degree `E.InnerJoin` terms)) = do
|
||||
E.on $ participant E.^. CourseParticipantField E.==. features E.?. StudyFeaturesId
|
||||
--(features, degree, terms) <- studyFeaturesQuery (participant E.^. CourseParticipantField) studyFeatures
|
||||
E.on $ terms E.?. StudyTermsId E.==. features E.?. StudyFeaturesField
|
||||
E.on $ degree E.?. StudyDegreeId E.==. features E.?. StudyFeaturesDegree
|
||||
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))
|
||||
|
||||
type UserTableExpr = (E.SqlExpr (Entity User) `E.InnerJoin` E.SqlExpr (Entity CourseParticipant)) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity CourseUserNote))
|
||||
type UserTableWhere = UserTableExpr -> E.SqlExpr (E.Value Bool)
|
||||
type UserTableData = DBRow (Entity User, UTCTime, Maybe CourseUserNoteId)
|
||||
|
||||
@ -1,6 +1,7 @@
|
||||
module Handler.Utils.Database
|
||||
( getSchoolsOf
|
||||
, makeSchoolDictionaryDB, makeSchoolDictionary
|
||||
, studyFeaturesQuery, studyFeaturesQuery'
|
||||
) where
|
||||
|
||||
import Import
|
||||
@ -29,3 +30,25 @@ getSchoolsOf uid uschool uuser = fmap (Import.map E.unValue) $ E.select $ E.from
|
||||
E.where_ $ urights E.^. uuser E.==. E.val uid
|
||||
E.orderBy [E.asc $ school E.^.SchoolName]
|
||||
return $ school E.^. SchoolName
|
||||
|
||||
|
||||
studyFeaturesQuery :: E.Esqueleto query expr backend
|
||||
=> expr (E.Value (Maybe StudyFeaturesId)) -- ^ query is filtered by StudyFeatureId
|
||||
-> (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
|
||||
return (features, degree, terms)
|
||||
|
||||
-- | 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
|
||||
return (features, degree, terms)
|
||||
|
||||
@ -41,9 +41,11 @@ maybeCell =flip foldMap
|
||||
---------------------
|
||||
-- Icon cells
|
||||
|
||||
-- | Maybe display a tickmark/checkmark icon
|
||||
tickmarkCell :: (IsDBTable m a) => Bool -> DBCell m a
|
||||
tickmarkCell = cell . toWidget . hasTickmark
|
||||
|
||||
-- | Maybe display comment icon linking a given URL or show nothing at all
|
||||
commentCell :: IsDBTable m a => Maybe (Route UniWorX) -> DBCell m a
|
||||
commentCell Nothing = mempty
|
||||
commentCell (Just link) = anchorCell link icon
|
||||
|
||||
Loading…
Reference in New Issue
Block a user