From 729831b0bf4e8bab2ef6d37f75bdf64b0773f05e Mon Sep 17 00:00:00 2001 From: SJost Date: Wed, 6 Mar 2019 17:50:22 +0100 Subject: [PATCH] Probably fixes the course participant list? --- messages/uniworx/de.msg | 3 ++- src/Foundation.hs | 10 ++++---- src/Handler/Course.hs | 45 +++++++++++++++++++++-------------- src/Handler/Utils/Database.hs | 6 ++--- src/Handler/Utils/Form.hs | 11 +++++---- 5 files changed, 44 insertions(+), 31 deletions(-) diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 38c834069..8d51a6547 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -53,7 +53,7 @@ CourseNoCapacity: In diesem Kurs sind keine Plätze mehr frei. CourseNotEmpty: In diesem Kurs sind momentan Teilnehmer angemeldet. CourseRegisterOk: Sie wurden angemeldet CourseDeregisterOk: Sie wurden abgemeldet -CourseStudyFeature: Asoziiertes Hauptfach +CourseStudyFeature: Assoziiertes Hauptfach CourseStudyFeatureTooltip: Korrekte Angabe kann Notenweiterleitungen beschleunigen CourseSecretWrong: Falsches Kennwort CourseSecret: Zugangspasswort @@ -409,6 +409,7 @@ StudyFeatureAge: Fachsemester StudyFeatureDegree: Abschluss FieldPrimary: Hauptfach FieldSecondary: Nebenfach +NoPrimaryStudyField: (kein Hauptfach registriert) MailTestFormEmail: Email-Addresse MailTestFormLanguages: Spracheinstellungen diff --git a/src/Foundation.hs b/src/Foundation.hs index fde6cf714..e688b03bb 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -1102,10 +1102,12 @@ instance YesodBreadcrumbs UniWorX where breadcrumb CourseNewR = return ("Neu" , Just CourseListR) breadcrumb (CourseR tid ssh csh CShowR) = return (CI.original csh, Just $ TermSchoolCourseListR tid ssh) -- (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 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 (CourseR tid ssh csh CEditR) = return ("Editieren" , 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 (CUserR _)) = return ("Teilnehmer" , 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 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 SEditR) = return ("Edit", Just $ CSheetR tid ssh csh shn SShowR) diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs index 953d349d3..f7f281c92 100644 --- a/src/Handler/Course.hs +++ b/src/Handler/Course.hs @@ -274,6 +274,7 @@ getCShowR tid ssh csh = do E.where_ $ course E.^. CourseTerm E.==. E.val tid E.&&. course E.^. CourseSchool E.==. E.val ssh 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 E.where_ $ part E.^. CourseParticipantCourse E.==. course E.^. CourseId return ( E.countRows :: E.SqlExpr (E.Value Int64)) @@ -646,11 +647,10 @@ validateCourse CourseForm{..} = ] ] + -------------------- -- CourseUserTable - - 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))) @@ -659,25 +659,34 @@ type UserTableData = DBRow (Entity User, UTCTime, Maybe CourseUserNoteId, (May 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 -> 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 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 + -- 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 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 diff --git a/src/Handler/Utils/Database.hs b/src/Handler/Utils/Database.hs index d558e2c7d..05d44c8ad 100644 --- a/src/Handler/Utils/Database.hs +++ b/src/Handler/Utils/Database.hs @@ -34,18 +34,18 @@ getSchoolsOf uid uschool uuser = fmap (Import.map E.unValue) $ E.select $ E.from 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)) + -> 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 + 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)))) + -> (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 diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs index 1736f844f..6571849fb 100644 --- a/src/Handler/Utils/Form.hs +++ b/src/Handler/Utils/Form.hs @@ -225,7 +225,8 @@ studyFeaturesPrimaryFieldFor oldFeatures mbuid = selectField $ do E.where_ $ ((feature E.^. StudyFeaturesId) `E.in_` E.valList oldFeatures) E.||. isPrimaryActiveUserStudyFeature feature return (feature E.^. StudyFeaturesId, degree, field) - mkOptionList . nonEmptyOptions <$> mapM procOptions rawOptions + mr <- getMessageRender + mkOptionList . nonEmptyOptions (mr MsgNoPrimaryStudyField) <$> mapM procOptions rawOptions where isPrimaryActiveUserStudyFeature feature = case mbuid of Nothing -> E.val False @@ -244,12 +245,12 @@ studyFeaturesPrimaryFieldFor oldFeatures mbuid = selectField $ do , optionExternalValue = toPathPiece (cfid :: CryptoID UUID StudyFeaturesId) } - nonEmptyOptions :: [Option (Maybe StudyFeaturesId)] -> [Option (Maybe StudyFeaturesId)] - nonEmptyOptions opts + nonEmptyOptions :: Text -> [Option (Maybe StudyFeaturesId)] -> [Option (Maybe StudyFeaturesId)] + nonEmptyOptions emptyOpt opts | null opts = [ Option - { optionDisplay = "-----" + { optionDisplay = emptyOpt , optionInternalValue = Nothing - , optionExternalValue = "-----" + , optionExternalValue = "NoPrimaryStudyField" } ] | otherwise = opts