Alternative Query Attempt
This commit is contained in:
parent
382a34f970
commit
56c25c133a
@ -649,6 +649,31 @@ validateCourse CourseForm{..} =
|
|||||||
--------------------
|
--------------------
|
||||||
-- CourseUserTable
|
-- 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 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 UserTableWhere = UserTableExpr -> E.SqlExpr (E.Value Bool)
|
||||||
type UserTableData = DBRow (Entity User, UTCTime, Maybe CourseUserNoteId)
|
type UserTableData = DBRow (Entity User, UTCTime, Maybe CourseUserNoteId)
|
||||||
|
|||||||
@ -1,6 +1,7 @@
|
|||||||
module Handler.Utils.Database
|
module Handler.Utils.Database
|
||||||
( getSchoolsOf
|
( getSchoolsOf
|
||||||
, makeSchoolDictionaryDB, makeSchoolDictionary
|
, makeSchoolDictionaryDB, makeSchoolDictionary
|
||||||
|
, studyFeaturesQuery, studyFeaturesQuery'
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Import
|
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.where_ $ urights E.^. uuser E.==. E.val uid
|
||||||
E.orderBy [E.asc $ school E.^.SchoolName]
|
E.orderBy [E.asc $ school E.^.SchoolName]
|
||||||
return $ 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
|
-- Icon cells
|
||||||
|
|
||||||
|
-- | Maybe display a tickmark/checkmark icon
|
||||||
tickmarkCell :: (IsDBTable m a) => Bool -> DBCell m a
|
tickmarkCell :: (IsDBTable m a) => Bool -> DBCell m a
|
||||||
tickmarkCell = cell . toWidget . hasTickmark
|
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 :: IsDBTable m a => Maybe (Route UniWorX) -> DBCell m a
|
||||||
commentCell Nothing = mempty
|
commentCell Nothing = mempty
|
||||||
commentCell (Just link) = anchorCell link icon
|
commentCell (Just link) = anchorCell link icon
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user