diff --git a/CHANGELOG.md b/CHANGELOG.md index e6b2999fa..faf277ab8 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,27 @@ All notable changes to this project will be documented in this file. See [standard-version](https://github.com/conventional-changelog/standard-version) for commit guidelines. +### [20.8.1](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v20.8.0...v20.8.1) (2020-10-12) + + +### Bug Fixes + +* **authorization:** have AllocationTime consider ParticipantState ([b69481e](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/b69481e88fb20890b4ece7a0023dcfdad21604d6)) + +## [20.8.0](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v20.7.0...v20.8.0) (2020-10-10) + + +### Features + +* **allocations:** csv-export new-assigned ([a4114a7](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/a4114a79f1bfd968bb9d300f0c39400a8904ee7c)) + +## [20.7.0](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v20.6.0...v20.7.0) (2020-10-10) + + +### Features + +* **allocations:** include study features in users table ([7f7d2c7](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/7f7d2c795767fd6fac1fa4a10a304e3e3d2280c3)) + ## [20.6.0](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v20.5.1...v20.6.0) (2020-10-06) diff --git a/messages/uniworx/de-de-formal.msg b/messages/uniworx/de-de-formal.msg index 373acdc1a..1d5075175 100644 --- a/messages/uniworx/de-de-formal.msg +++ b/messages/uniworx/de-de-formal.msg @@ -2724,10 +2724,12 @@ 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) CsvColumnAllocationUserAssigned: Anzahl von Plätzen, die der Bewerber durch diese Zentralanmeldung bereits erhalten hat +CsvColumnAllocationUserNewAssigned: Anzahl von Plätzen, die der Bewerber, nach Akzeptieren der berechneten Verteilung, zusätzlich erhalten würde CsvColumnAllocationUserPriority: Zentrale Dringlichkeit des Bewerbers; entweder einzelne Zahl für Sortierungsbasierte Dringlichkeiten (höhere Dringlichkeit entspricht größerer Zahl) oder Komma-separierte Liste von numerischen Dringlichkeiten in eckigen Klammern (z.B. [1, 2, 3]) AllocationUsersCsvName tid@TermId ssh@SchoolId ash@AllocationShorthand: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase ash}-bewerber diff --git a/messages/uniworx/en-eu.msg b/messages/uniworx/en-eu.msg index 485dab0f3..1d5084277 100644 --- a/messages/uniworx/en-eu.msg +++ b/messages/uniworx/en-eu.msg @@ -2697,10 +2697,12 @@ 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) CsvColumnAllocationUserAssigned: Number of assignments the applicant has already received +CsvColumnAllocationUserNewAssigned: Number of assignments the applicant would receive, if the calculated matching is accepted CsvColumnAllocationUserPriority: Central priority of this applicant; either a number based on the applicants position in the list sorted by priority (higher numbers mean a higher priority) or a comma-separated list of numerical priorities in square brackets (e.g. [1, 2, 3]) AllocationUsersCsvName tid ssh ash: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase ash}-applicants diff --git a/package-lock.json b/package-lock.json index 3718b16ef..a5dbba225 100644 --- a/package-lock.json +++ b/package-lock.json @@ -1,6 +1,6 @@ { "name": "uni2work", - "version": "20.6.0", + "version": "20.8.1", "lockfileVersion": 1, "requires": true, "dependencies": { diff --git a/package.json b/package.json index bd6d3b4a0..51350f411 100644 --- a/package.json +++ b/package.json @@ -1,6 +1,6 @@ { "name": "uni2work", - "version": "20.6.0", + "version": "20.8.1", "description": "", "keywords": [], "author": "", diff --git a/package.yaml b/package.yaml index 8e1f89a83..bb5d49932 100644 --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: uniworx -version: 20.6.0 +version: 20.8.1 dependencies: - base diff --git a/src/Foundation/Authorization.hs b/src/Foundation/Authorization.hs index 11a683a80..515cceeff 100644 --- a/src/Foundation/Authorization.hs +++ b/src/Foundation/Authorization.hs @@ -784,7 +784,7 @@ tagAccessPredicate AuthAllocationTime = APDB $ \mAuthId route _ -> case route of Nothing -> return Authorized Just (cid, Allocation{..}) -> do registered <- case mAuthId of - Just uid -> $cachedHereBinary (uid, cid) . existsBy $ UniqueParticipant uid cid + Just uid -> $cachedHereBinary (uid, cid) $ exists [ CourseParticipantUser ==. uid, CourseParticipantCourse ==. cid, CourseParticipantState ==. CourseParticipantActive ] _ -> return False if | not registered diff --git a/src/Handler/Allocation/Users.hs b/src/Handler/Allocation/Users.hs index e150f1d1b..43ea49e9f 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 @@ -22,6 +23,8 @@ import qualified Data.Set as Set import Text.Blaze (toMarkup) +import qualified Data.Conduit.Combinators as C + type UserTableExpr = E.SqlExpr (Entity User) `E.InnerJoin` E.SqlExpr (Entity AllocationUser) @@ -59,6 +62,7 @@ queryVetoedCourses = queryAllocationUser . to queryVetoedCourses' type UserTableData = DBRow ( Entity User + , UserTableStudyFeatures , Entity AllocationUser , Int -- ^ Applied , Int -- ^ Assigned @@ -68,13 +72,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,10 +89,12 @@ data AllocationUserTableCsv = AllocationUserTableCsv , csvAUserFirstName :: Text , csvAUserName :: Text , csvAUserMatriculation :: Maybe Text + , csvAUserStudyFeatures :: UserTableStudyFeatures , csvAUserRequested , csvAUserApplied , csvAUserVetos , csvAUserAssigned :: Natural + , csvAUserNewAssigned :: Maybe Natural , csvAUserPriority :: Maybe AllocationPriority } deriving (Generic) makeLenses_ ''AllocationUserTableCsv @@ -94,10 +103,22 @@ allocationUserTableCsvOptions :: Csv.Options allocationUserTableCsvOptions = Csv.defaultOptions { Csv.fieldLabelModifier = camelToPathPiece' 3} instance Csv.ToNamedRecord AllocationUserTableCsv where - toNamedRecord = Csv.genericToNamedRecord allocationUserTableCsvOptions - -instance Csv.DefaultOrdered AllocationUserTableCsv where - headerOrder = Csv.genericHeaderOrder allocationUserTableCsvOptions + toNamedRecord AllocationUserTableCsv{..} = Csv.namedRecord $ + [ "surname" Csv..= csvAUserSurname + , "first-name" Csv..= csvAUserFirstName + , "name" Csv..= csvAUserName + , "matriculation" Csv..= csvAUserMatriculation + , "study-features" Csv..= csvAUserStudyFeatures + , "requested" Csv..= csvAUserRequested + , "applied" Csv..= csvAUserApplied + , "vetos" Csv..= csvAUserVetos + , "assigned" Csv..= csvAUserAssigned + ] ++ + [ "new-assigned" Csv..= newAssigned + | newAssigned <- hoistMaybe csvAUserNewAssigned + ] ++ + [ "priority" Csv..= csvAUserPriority + ] instance CsvColumnsExplained AllocationUserTableCsv where csvColumnsExplanations = genericCsvColumnsExplanations allocationUserTableCsvOptions $ mconcat @@ -105,13 +126,33 @@ 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 , singletonMap 'csvAUserAssigned MsgCsvColumnAllocationUserAssigned + , singletonMap 'csvAUserNewAssigned MsgCsvColumnAllocationUserNewAssigned , singletonMap 'csvAUserPriority MsgCsvColumnAllocationUserPriority ] +userTableCsvHeader :: Bool -> Csv.Header +userTableCsvHeader hasNewAssigned = Csv.header $ + [ "surname" + , "first-name" + , "name" + , "matriculation" + , "study-features" + , "requested" + , "applied" + , "vetos" + , "assigned" + ] ++ + [ "new-assigned" + | hasNewAssigned + ] ++ + [ "priority" + ] + getAUsersR, postAUsersR :: TermId -> SchoolId -> AllocationShorthand -> Handler Html getAUsersR = postAUsersR @@ -148,13 +189,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 @@ -253,16 +296,26 @@ postAUsersR tid ssh ash = do dbtParams = def dbtIdent :: Text dbtIdent = "allocation-users" - dbtCsvEncode = simpleCsvEncode csvName $ AllocationUserTableCsv - <$> view (resultUser . _entityVal . _userSurname) - <*> view (resultUser . _entityVal . _userFirstName) - <*> view (resultUser . _entityVal . _userDisplayName) - <*> view (resultUser . _entityVal . _userMatrikelnummer) - <*> view (resultAllocationUser . _entityVal . _allocationUserTotalCourses) - <*> view (resultAppliedCourses . to fromIntegral) - <*> view (resultVetoedCourses . to fromIntegral) - <*> view (resultAssignedCourses . to fromIntegral) - <*> view (resultAllocationUser . _entityVal . _allocationUserPriority) + dbtCsvEncode = return DBTCsvEncode + { dbtCsvExportForm = pure () + , dbtCsvDoEncode = \() -> C.mapM $ \(_, row) -> flip runReaderT row $ + AllocationUserTableCsv + <$> view (resultUser . _entityVal . _userSurname) + <*> 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) + <*> view (resultAssignedCourses . to fromIntegral) + <*> views (resultUser . _entityKey) (\uid -> maybe 0 (fromIntegral . olength) . Map.lookup uid <$> allocMatching) + <*> view (resultAllocationUser . _entityVal . _allocationUserPriority) + , dbtCsvName = unpack csvName + , dbtCsvNoExportData = Just id + , dbtCsvHeader = \_ -> return . userTableCsvHeader $ is _Just allocMatching + , dbtCsvExampleData = Nothing + } dbtCsvDecode = Nothing allocationUsersDBTableValidator = def & defaultSorting [SortAscBy "priority", SortAscBy "user-matriculation"] 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 + }