From 7f7d2c795767fd6fac1fa4a10a304e3e3d2280c3 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Sat, 10 Oct 2020 17:36:02 +0200 Subject: [PATCH] feat(allocations): include study features in users table --- messages/uniworx/de-de-formal.msg | 1 + messages/uniworx/en-eu.msg | 1 + src/Handler/Allocation/Users.hs | 24 +++++++++++++++++------- src/Handler/Utils/StudyFeatures.hs | 22 ++++++++++++++++++++++ 4 files changed, 41 insertions(+), 7 deletions(-) diff --git a/messages/uniworx/de-de-formal.msg b/messages/uniworx/de-de-formal.msg index e5965bb1d..9a9e2918d 100644 --- a/messages/uniworx/de-de-formal.msg +++ b/messages/uniworx/de-de-formal.msg @@ -2689,6 +2689,7 @@ CsvColumnAllocationUserSurname: Nachname(n) des Bewerbers CsvColumnAllocationUserFirstName: Vorname(n) des Bewerbers CsvColumnAllocationUserName: Voller Name des Bewerbers CsvColumnAllocationUserMatriculation: Matrikelnummer des Bewerber +CsvColumnAllocationUserStudyFeatures: Studiendaten CsvColumnAllocationUserRequested: Maximale Anzahl von Plätzen, die der Bewerber bereit ist, zu akzeptieren CsvColumnAllocationUserApplied: Anzahl von Bewerbungen, die der Bewerber eingereicht hat CsvColumnAllocationUserVetos: Anzahl von Bewerbungen, die von Kursverwaltern ein Veto oder eine Note erhalten haben, die äquivalent ist zu "Nicht Bestanden" (5.0) diff --git a/messages/uniworx/en-eu.msg b/messages/uniworx/en-eu.msg index c7650c428..c934e626e 100644 --- a/messages/uniworx/en-eu.msg +++ b/messages/uniworx/en-eu.msg @@ -2689,6 +2689,7 @@ CsvColumnAllocationUserSurname: Applicant's surname(s) CsvColumnAllocationUserFirstName: Applicants's first name(s) CsvColumnAllocationUserName: Applicant's full name CsvColumnAllocationUserMatriculation: Applicant's matriculation +CsvColumnAllocationUserStudyFeatures: Features of study CsvColumnAllocationUserRequested: Maximum number of placements the applicant is prepared to accept CsvColumnAllocationUserApplied: Number of applications the applicant has provided CsvColumnAllocationUserVetos: Number of applications that have received a veto from a course administrator or have been rated with a grade that is equivalent to "failed" (5.0) diff --git a/src/Handler/Allocation/Users.hs b/src/Handler/Allocation/Users.hs index e150f1d1b..af3793386 100644 --- a/src/Handler/Allocation/Users.hs +++ b/src/Handler/Allocation/Users.hs @@ -10,6 +10,7 @@ import Handler.Allocation.Accept import Handler.Utils import Handler.Utils.Allocation +import Handler.Utils.StudyFeatures import qualified Database.Esqueleto as E import qualified Database.Esqueleto.Utils as E @@ -59,6 +60,7 @@ queryVetoedCourses = queryAllocationUser . to queryVetoedCourses' type UserTableData = DBRow ( Entity User + , UserTableStudyFeatures , Entity AllocationUser , Int -- ^ Applied , Int -- ^ Assigned @@ -68,13 +70,16 @@ type UserTableData = DBRow ( Entity User resultUser :: Lens' UserTableData (Entity User) resultUser = _dbrOutput . _1 +resultStudyFeatures :: Lens' UserTableData UserTableStudyFeatures +resultStudyFeatures = _dbrOutput . _2 + resultAllocationUser :: Lens' UserTableData (Entity AllocationUser) -resultAllocationUser = _dbrOutput . _2 +resultAllocationUser = _dbrOutput . _3 resultAppliedCourses, resultAssignedCourses, resultVetoedCourses :: Lens' UserTableData Int -resultAppliedCourses = _dbrOutput . _3 -resultAssignedCourses = _dbrOutput . _4 -resultVetoedCourses = _dbrOutput . _5 +resultAppliedCourses = _dbrOutput . _4 +resultAssignedCourses = _dbrOutput . _5 +resultVetoedCourses = _dbrOutput . _6 data AllocationUserTableCsv = AllocationUserTableCsv @@ -82,6 +87,7 @@ data AllocationUserTableCsv = AllocationUserTableCsv , csvAUserFirstName :: Text , csvAUserName :: Text , csvAUserMatriculation :: Maybe Text + , csvAUserStudyFeatures :: UserTableStudyFeatures , csvAUserRequested , csvAUserApplied , csvAUserVetos @@ -105,6 +111,7 @@ instance CsvColumnsExplained AllocationUserTableCsv where , singletonMap 'csvAUserFirstName MsgCsvColumnAllocationUserFirstName , singletonMap 'csvAUserName MsgCsvColumnAllocationUserName , singletonMap 'csvAUserMatriculation MsgCsvColumnAllocationUserMatriculation + , singletonMap 'csvAUserStudyFeatures MsgCsvColumnAllocationUserStudyFeatures , singletonMap 'csvAUserRequested MsgCsvColumnAllocationUserRequested , singletonMap 'csvAUserApplied MsgCsvColumnAllocationUserApplied , singletonMap 'csvAUserVetos MsgCsvColumnAllocationUserVetos @@ -148,13 +155,15 @@ postAUsersR tid ssh ash = do , assigned , vetoed) dbtRowKey = views queryAllocationUser (E.^. AllocationUserId) - dbtProj = runReaderT $ (asks . set _dbrOutput) <=< magnify _dbrOutput $ - (,,,,) - <$> view _1 <*> view _2 <*> view (_3 . _Value) <*> view (_4 . _Value) <*> view (_5 . _Value) + dbtProj = runReaderT $ (asks . set _dbrOutput) <=< magnify _dbrOutput $ do + feats <- lift . allocationUserStudyFeatures aId =<< views _1 entityKey + (,,,,,) + <$> view _1 <*> pure feats <*> view _2 <*> view (_3 . _Value) <*> view (_4 . _Value) <*> view (_5 . _Value) dbtColonnade :: Colonnade Sortable _ _ dbtColonnade = mconcat . catMaybes $ [ pure $ colUserDisplayName (resultUser . _entityVal . $(multifocusL 2) _userDisplayName _userSurname) , pure $ colUserMatriculation (resultUser . _entityVal . _userMatrikelnummer) + , pure $ colStudyFeatures resultStudyFeatures , pure $ colAllocationRequested (resultAllocationUser . _entityVal . _allocationUserTotalCourses) , pure . coursesModalApplied $ colAllocationApplied resultAppliedCourses , pure . coursesModalVetoed $ colAllocationVetoed resultVetoedCourses @@ -258,6 +267,7 @@ postAUsersR tid ssh ash = do <*> view (resultUser . _entityVal . _userFirstName) <*> view (resultUser . _entityVal . _userDisplayName) <*> view (resultUser . _entityVal . _userMatrikelnummer) + <*> view resultStudyFeatures <*> view (resultAllocationUser . _entityVal . _allocationUserTotalCourses) <*> view (resultAppliedCourses . to fromIntegral) <*> view (resultVetoedCourses . to fromIntegral) diff --git a/src/Handler/Utils/StudyFeatures.hs b/src/Handler/Utils/StudyFeatures.hs index 7a2b1c6cc..7e3dc481a 100644 --- a/src/Handler/Utils/StudyFeatures.hs +++ b/src/Handler/Utils/StudyFeatures.hs @@ -9,6 +9,7 @@ module Handler.Utils.StudyFeatures , isCourseStudyFeature, courseUserStudyFeatures , isExternalExamStudyFeature, externalExamUserStudyFeatures , isTermStudyFeature + , isAllocationStudyFeature, allocationUserStudyFeatures ) where import Import.NoFoundation @@ -184,3 +185,24 @@ externalExamUserStudyFeatures eeId uid = do isTermStudyFeature :: E.SqlExpr (Entity Term) -> E.SqlExpr (Entity StudyFeatures) -> E.SqlExpr (E.Value Bool) isTermStudyFeature = isRelevantStudyFeatureCached TermId + + +isAllocationStudyFeature :: E.SqlExpr (Entity Allocation) -> E.SqlExpr (Entity StudyFeatures) -> E.SqlExpr (E.Value Bool) +isAllocationStudyFeature = isRelevantStudyFeatureCached AllocationTerm + +allocationUserStudyFeatures :: MonadIO m => AllocationId -> UserId -> SqlPersistT m UserTableStudyFeatures +allocationUserStudyFeatures aId uid = do + feats <- E.select . E.from $ \(allocation `E.InnerJoin` studyFeatures `E.InnerJoin` terms `E.InnerJoin` degree) -> do + E.on $ degree E.^. StudyDegreeId E.==. studyFeatures E.^. StudyFeaturesDegree + E.on $ terms E.^. StudyTermsId E.==. studyFeatures E.^. StudyFeaturesField + E.on $ isAllocationStudyFeature allocation studyFeatures + E.where_ $ allocation E.^. AllocationId E.==. E.val aId + E.where_ $ studyFeatures E.^. StudyFeaturesUser E.==. E.val uid + return (terms, degree, studyFeatures) + return . UserTableStudyFeatures . Set.fromList . flip map feats $ + \(Entity _ StudyTerms{..}, Entity _ StudyDegree{..}, Entity _ StudyFeatures{..}) -> UserTableStudyFeature + { userTableField = fromMaybe (tshow studyTermsKey) studyTermsName + , userTableDegree = fromMaybe (tshow studyDegreeKey) studyDegreeName + , userTableSemester = studyFeaturesSemester + , userTableFieldType = studyFeaturesType + }