Probably fixes the course participant list?
This commit is contained in:
SJost
parent
484d99305d
commit
729831b0bf
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user