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

Probably fixes the course participant list?

Browse Source
This commit is contained in:
SJost 2019-03-06 17:50:22 +01:00
parent 484d99305d
commit 729831b0bf
5 changed files with 44 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
messages/uniworx/de.msg
View File

@ -53,7 +53,7 @@ CourseNoCapacity: In diesem Kurs sind keine Plätze mehr frei.
CourseNotEmpty: In diesem Kurs sind momentan Teilnehmer angemeldet. CourseNotEmpty: In diesem Kurs sind momentan Teilnehmer angemeldet.
CourseRegisterOk: Sie wurden angemeldet CourseRegisterOk: Sie wurden angemeldet
CourseDeregisterOk: Sie wurden abgemeldet CourseDeregisterOk: Sie wurden abgemeldet
CourseStudyFeature: Asoziiertes Hauptfach CourseStudyFeature: Assoziiertes Hauptfach
CourseStudyFeatureTooltip: Korrekte Angabe kann Notenweiterleitungen beschleunigen CourseStudyFeatureTooltip: Korrekte Angabe kann Notenweiterleitungen beschleunigen
CourseSecretWrong: Falsches Kennwort CourseSecretWrong: Falsches Kennwort
CourseSecret: Zugangspasswort CourseSecret: Zugangspasswort
@ -409,6 +409,7 @@ StudyFeatureAge: Fachsemester
StudyFeatureDegree: Abschluss StudyFeatureDegree: Abschluss
FieldPrimary: Hauptfach FieldPrimary: Hauptfach
FieldSecondary: Nebenfach FieldSecondary: Nebenfach
NoPrimaryStudyField: (kein Hauptfach registriert)
MailTestFormEmail: Email-Addresse MailTestFormEmail: Email-Addresse
MailTestFormLanguages: Spracheinstellungen MailTestFormLanguages: Spracheinstellungen

10
src/Foundation.hs
View File

@ -1102,10 +1102,12 @@ instance YesodBreadcrumbs UniWorX where
breadcrumb CourseNewR = return ("Neu" , Just CourseListR) breadcrumb CourseNewR = return ("Neu" , Just CourseListR)
breadcrumb (CourseR tid ssh csh CShowR) = return (CI.original csh, Just $ TermSchoolCourseListR tid ssh) breadcrumb (CourseR tid ssh csh CShowR) = return (CI.original csh, Just $ TermSchoolCourseListR tid ssh)
-- (CourseR tid ssh csh CRegisterR) -- is POST only -- (CourseR tid ssh csh CRegisterR) -- is POST only
breadcrumb (CourseR tid ssh csh CEditR) = return ("Editieren", Just $ CourseR tid ssh csh CShowR) breadcrumb (CourseR tid ssh csh CEditR) = return ("Editieren" , Just $ CourseR tid ssh csh CShowR)
breadcrumb (CourseR tid ssh csh CCorrectionsR) = return ("Abgaben",Just $ CourseR tid ssh csh CShowR) breadcrumb (CourseR tid ssh csh CUsersR) = return ("Anmeldungen", Just $ CourseR tid ssh csh CShowR)
breadcrumb (CourseR tid ssh csh SheetListR) = return ("Übungen" , Just $ CourseR tid ssh csh CShowR) breadcrumb (CourseR tid ssh csh (CUserR _)) = return ("Teilnehmer" , Just $ CourseR tid ssh csh CShowR)
breadcrumb (CourseR tid ssh csh SheetNewR ) = return ("Neu", Just $ CourseR tid ssh csh SheetListR) breadcrumb (CourseR tid ssh csh CCorrectionsR) = return ("Abgaben" , Just $ CourseR tid ssh csh CShowR)
breadcrumb (CourseR tid ssh csh SheetListR) = return ("Übungen" , Just $ CourseR tid ssh csh CShowR)
breadcrumb (CourseR tid ssh csh SheetNewR ) = return ("Neu", Just $ CourseR tid ssh csh SheetListR)
breadcrumb (CSheetR tid ssh csh shn SShowR) = return (CI.original shn, Just $ CourseR tid ssh csh SheetListR) breadcrumb (CSheetR tid ssh csh shn SShowR) = return (CI.original shn, Just $ CourseR tid ssh csh SheetListR)
breadcrumb (CSheetR tid ssh csh shn SEditR) = return ("Edit", Just $ CSheetR tid ssh csh shn SShowR) breadcrumb (CSheetR tid ssh csh shn SEditR) = return ("Edit", Just $ CSheetR tid ssh csh shn SShowR)

45
src/Handler/Course.hs
View File

@ -274,6 +274,7 @@ getCShowR tid ssh csh = do
E.where_ $ course E.^. CourseTerm E.==. E.val tid E.where_ $ course E.^. CourseTerm E.==. E.val tid
E.&&. course E.^. CourseSchool E.==. E.val ssh E.&&. course E.^. CourseSchool E.==. E.val ssh
E.&&. course E.^. CourseShorthand E.==. E.val csh E.&&. course E.^. CourseShorthand E.==. E.val csh
E.limit 1 -- we know that there is at most one match, but we tell the DB this info too
let numParticipants = E.sub_select . E.from $ \part -> do let numParticipants = E.sub_select . E.from $ \part -> do
E.where_ $ part E.^. CourseParticipantCourse E.==. course E.^. CourseId E.where_ $ part E.^. CourseParticipantCourse E.==. course E.^. CourseId
return ( E.countRows :: E.SqlExpr (E.Value Int64)) return ( E.countRows :: E.SqlExpr (E.Value Int64))
@ -646,11 +647,10 @@ validateCourse CourseForm{..} =
] ] ] ]
-------------------- --------------------
-- CourseUserTable -- CourseUserTable
type UserTableExpr = (E.SqlExpr (Entity User) `E.InnerJoin` E.SqlExpr (Entity CourseParticipant)) 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 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)))
@ -659,25 +659,34 @@ type UserTableData = DBRow (Entity User, UTCTime, Maybe CourseUserNoteId, (May
forceUserTableType :: (UserTableExpr -> a) -> (UserTableExpr -> a) forceUserTableType :: (UserTableExpr -> a) -> (UserTableExpr -> a)
forceUserTableType = id forceUserTableType = id
userTableQuery :: CourseId -> E.Esqueleto query expr backend => -- userTableQuery :: CourseId -> E.Esqueleto query expr backend =>
E.LeftOuterJoin -- E.LeftOuterJoin
(E.LeftOuterJoin -- (E.LeftOuterJoin
(E.InnerJoin -- (E.InnerJoin
(expr (Entity User)) (expr (Entity CourseParticipant))) -- (expr (Entity User)) (expr (Entity CourseParticipant)))
(expr (Maybe (Entity CourseUserNote)))) -- (expr (Maybe (Entity CourseUserNote))))
(E.InnerJoin -- (E.InnerJoin
(E.InnerJoin -- (E.InnerJoin
(expr (Maybe (Entity StudyFeatures))) -- (expr (Maybe (Entity StudyFeatures)))
(expr (Maybe (Entity StudyDegree)))) -- (expr (Maybe (Entity StudyDegree))))
(expr (Maybe (Entity StudyTerms)))) -- (expr (Maybe (Entity StudyTerms))))
-> query (expr (Entity User), expr (E.Value UTCTime), -- -> query (expr (Entity User), expr (E.Value UTCTime),
expr (E.Value (Maybe (Key CourseUserNote))), -- expr (E.Value (Maybe (Key CourseUserNote))),
(expr (Maybe (Entity StudyFeatures)), expr (Maybe (Entity StudyDegree)), expr (Maybe (Entity StudyTerms)))) -- (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@(features `E.InnerJoin` degree `E.InnerJoin` terms)) = do
E.on $ participant E.^. CourseParticipantField E.==. features E.?. StudyFeaturesId -- Order of nested joins unclear, but this one works somehow:
--(features, degree, terms) <- studyFeaturesQuery (participant E.^. CourseParticipantField) studyFeatures
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.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 $ 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_ $ participant E.^. CourseParticipantCourse E.==. E.val cid E.where_ $ participant E.^. CourseParticipantCourse E.==. E.val cid

6
src/Handler/Utils/Database.hs
View File

@ -34,18 +34,18 @@ getSchoolsOf uid uschool uuser = fmap (Import.map E.unValue) $ E.select $ E.from
studyFeaturesQuery :: E.Esqueleto query expr backend studyFeaturesQuery :: E.Esqueleto query expr backend
=> expr (E.Value (Maybe StudyFeaturesId)) -- ^ query is filtered by StudyFeatureId => expr (E.Value (Maybe StudyFeaturesId)) -- ^ query is filtered by StudyFeatureId
-> (expr (Entity StudyFeatures)) `E.InnerJoin` (expr (Entity StudyDegree)) `E.InnerJoin` (expr (Entity StudyTerms)) -> expr (Entity StudyFeatures) `E.InnerJoin` expr (Entity StudyDegree) `E.InnerJoin` expr (Entity StudyTerms)
-> query (expr (Entity StudyFeatures), expr (Entity StudyDegree), expr (Entity StudyTerms)) -> query (expr (Entity StudyFeatures), expr (Entity StudyDegree), expr (Entity StudyTerms))
studyFeaturesQuery sfId (features `E.InnerJoin` degree `E.InnerJoin` terms) = do studyFeaturesQuery sfId (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.where_ $ E.just (features E.^. StudyFeaturesId) E.==. sfId
return (features, degree, terms) return (features, degree, terms)
-- | Variant of @studyFeaturesQuery@ to be used in outer joins -- | Variant of @studyFeaturesQuery@ to be used in outer joins
studyFeaturesQuery' :: E.Esqueleto query expr backend studyFeaturesQuery' :: E.Esqueleto query expr backend
=> expr (E.Value (Maybe StudyFeaturesId)) -- ^ query is filtered by StudyFeatureId => 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)))) -> (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))) -> query (expr (Maybe (Entity StudyFeatures)), expr (Maybe (Entity StudyDegree)), expr (Maybe (Entity StudyTerms)))
studyFeaturesQuery' sfId (features `E.InnerJoin` degree `E.InnerJoin` terms) = do studyFeaturesQuery' sfId (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

11
src/Handler/Utils/Form.hs
View File

@ -225,7 +225,8 @@ studyFeaturesPrimaryFieldFor oldFeatures mbuid = selectField $ do
E.where_ $ ((feature E.^. StudyFeaturesId) `E.in_` E.valList oldFeatures) E.where_ $ ((feature E.^. StudyFeaturesId) `E.in_` E.valList oldFeatures)
E.||. isPrimaryActiveUserStudyFeature feature E.||. isPrimaryActiveUserStudyFeature feature
return (feature E.^. StudyFeaturesId, degree, field) return (feature E.^. StudyFeaturesId, degree, field)
mkOptionList . nonEmptyOptions <$> mapM procOptions rawOptions mr <- getMessageRender
mkOptionList . nonEmptyOptions (mr MsgNoPrimaryStudyField) <$> mapM procOptions rawOptions
where where
isPrimaryActiveUserStudyFeature feature = case mbuid of isPrimaryActiveUserStudyFeature feature = case mbuid of
Nothing -> E.val False Nothing -> E.val False
@ -244,12 +245,12 @@ studyFeaturesPrimaryFieldFor oldFeatures mbuid = selectField $ do
, optionExternalValue = toPathPiece (cfid :: CryptoID UUID StudyFeaturesId) , optionExternalValue = toPathPiece (cfid :: CryptoID UUID StudyFeaturesId)
} }
nonEmptyOptions :: [Option (Maybe StudyFeaturesId)] -> [Option (Maybe StudyFeaturesId)] nonEmptyOptions :: Text -> [Option (Maybe StudyFeaturesId)] -> [Option (Maybe StudyFeaturesId)]
nonEmptyOptions opts nonEmptyOptions emptyOpt opts
| null opts = [ Option | null opts = [ Option
{ optionDisplay = "-----" { optionDisplay = emptyOpt
, optionInternalValue = Nothing , optionInternalValue = Nothing
, optionExternalValue = "-----" , optionExternalValue = "NoPrimaryStudyField"
} ] } ]
| otherwise = opts | otherwise = opts