fraport/fradrive-old
Archived
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Cannot Return a ValueList from a select. :(

Browse Source
This commit is contained in:
SJost 2019-03-01 11:36:13 +01:00
parent cf3a0b3d35
commit fa0ce033ee
3 changed files with 16 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
models/users
View File

@ -35,7 +35,7 @@ StudyFeatures -- Abschluss, Studiengang, Haupt/Nebenfachh und Fachsemester
updated UTCTime default='NOW()' -- zuletzt als gültig gesehen updated UTCTime default='NOW()' -- zuletzt als gültig gesehen
valid Bool default=true valid Bool default=true
UniqueStudyFeatures user degree field type semester UniqueStudyFeatures user degree field type semester
-- UniqueUserSubject user degree field -- There exists a counterexample -- UniqueUserSubject ubuser degree field -- There exists a counterexample
StudyDegree -- Studienabschluss StudyDegree -- Studienabschluss
key Int key Int
shorthand Text Maybe shorthand Text Maybe

18
src/Handler/Course.hs
View File

@ -659,12 +659,24 @@ forceUserTableType = id
userTableQuery :: UserTableWhere -> UserTableExpr userTableQuery :: UserTableWhere -> UserTableExpr
-> E.SqlQuery ( E.SqlExpr (Entity User) -> E.SqlQuery ( E.SqlExpr (Entity User)
, E.SqlExpr (E.Value UTCTime) , E.SqlExpr (E.Value UTCTime)
, E.SqlExpr (E.Value (Maybe CourseUserNoteId))) , E.SqlExpr (E.Value (Maybe CourseUserNoteId))
, E.SqlExpr (E.ValueList (Entity StudyFeatures), E.SqlExpr (Entity StudyDegree), E.SqlExpr (Entity StudyTerms))
)
userTableQuery whereClause t@((user `E.InnerJoin` participant) `E.LeftOuterJoin` note) = do userTableQuery whereClause t@((user `E.InnerJoin` participant) `E.LeftOuterJoin` note) = do
E.on $ E.just (participant E.^. CourseParticipantUser) E.==. note E.?. CourseUserNoteUser E.on $ E.just (participant E.^. CourseParticipantUser) E.==. note E.?. CourseUserNoteUser
E.on $ participant E.^. CourseParticipantUser E.==. user E.^. UserId E.on $ participant E.^. CourseParticipantUser E.==. user E.^. UserId
E.where_ $ whereClause t E.where_ $ whereClause t
return (user, participant E.^. CourseParticipantRegistration, note E.?. CourseUserNoteId) -- let feature = E.case_ [E.when_ (E.isNothing $ participant E.^. CourseParticipantField) E.then_ E.nothing]
-- (E.else_ features )
let dfeat :: _hole -- E.SqlQuery (E.ValueList (E.SqlExpr (Entity StudyFeatures), E.SqlExpr (Entity StudyDegree), E.SqlExpr (Entity StudyTerms)))
dfeat = E.subList_select $ E.from $ \(feature `E.InnerJoin` degree `E.InnerJoin` terms) -> do
E.on $ feature E.^. StudyFeaturesField E.==. terms E.^. StudyTermsId
E.on $ feature E.^. StudyFeaturesDegree E.==. degree E.^. StudyDegreeId
E.where_ $ (E.just (feature E.^. StudyFeaturesId)) E.==. (participant E.^. CourseParticipantField)
E.limit 1
return (feature,degree,terms)
-- tr <- dfeat
return (user, participant E.^. CourseParticipantRegistration, note E.?. CourseUserNoteId, dfeat)
instance HasEntity UserTableData User where instance HasEntity UserTableData User where
hasEntity = _dbrOutput . _1 hasEntity = _dbrOutput . _1
@ -712,7 +724,7 @@ makeCourseUserTable whereClause colChoices psValidator =
dbtStyle = def dbtStyle = def
dbtSQLQuery = userTableQuery whereClause dbtSQLQuery = userTableQuery whereClause
dbtRowKey ((user `E.InnerJoin` _participant) `E.LeftOuterJoin` _note) = user E.^. UserId dbtRowKey ((user `E.InnerJoin` _participant) `E.LeftOuterJoin` _note) = user E.^. UserId
dbtProj = traverse $ \(user, E.Value registrationTime , E.Value userNoteId) -> return (user, registrationTime, userNoteId) dbtProj = traverse $ \(user, E.Value registrationTime , E.Value userNoteId,_) -> return (user, registrationTime, userNoteId) -- TODO continue here
dbtColonnade = colChoices dbtColonnade = colChoices
dbtSorting = Map.fromList [] -- TODO dbtSorting = Map.fromList [] -- TODO
dbtFilter = Map.fromList [] -- TODO dbtFilter = Map.fromList [] -- TODO

1
src/Model.hs
View File

@ -53,7 +53,6 @@ shortStudyDegree :: StudyDegree -> Markup
shortStudyDegree StudyDegree{..} = toMarkup $ shortStudyDegree StudyDegree{..} = toMarkup $
fromMaybe (tshow studyDegreeKey) studyDegreeShorthand fromMaybe (tshow studyDegreeKey) studyDegreeShorthand
instance ToMarkup StudyTerms where instance ToMarkup StudyTerms where
toMarkup StudyTerms{..} = toMarkup $ toMarkup StudyTerms{..} = toMarkup $
fromMaybe (tshow studyTermsKey) (studyTermsName <|> studyTermsShorthand) fromMaybe (tshow studyTermsKey) (studyTermsName <|> studyTermsShorthand)