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

feat(allocations): csv-export new-assigned

Browse Source
This commit is contained in:
Gregor Kleen 2020-10-10 21:22:43 +02:00
parent c97f1c0a93
commit a4114a79f1
3 changed files with 60 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
messages/uniworx/de-de-formal.msg
View File

@ -2694,6 +2694,7 @@ CsvColumnAllocationUserRequested: Maximale Anzahl von Plätzen, die der Bewerber
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

1
messages/uniworx/en-eu.msg
View File

@ -2694,6 +2694,7 @@ CsvColumnAllocationUserRequested: Maximum number of placements the applicant is
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

73
src/Handler/Allocation/Users.hs
View File

@ -23,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)
@ -92,6 +94,7 @@ data AllocationUserTableCsv = AllocationUserTableCsv
, csvAUserApplied
, csvAUserVetos
, csvAUserAssigned :: Natural
, csvAUserNewAssigned :: Maybe Natural
, csvAUserPriority :: Maybe AllocationPriority
} deriving (Generic)
makeLenses_ ''AllocationUserTableCsv
@ -100,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
@ -116,9 +131,28 @@ instance CsvColumnsExplained AllocationUserTableCsv where
, 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
@ -262,17 +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 resultStudyFeatures
<*> 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"]