From 7462e03e7073e73d298ee98cb2403c7221c2ea6a Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Thu, 27 Feb 2020 17:04:32 +0100 Subject: [PATCH] feat(allocations): show & export priority --- messages/uniworx/de-de-formal.msg | 2 ++ src/Handler/Allocation/Users.hs | 7 ++++++- src/Handler/Utils/Table/Columns.hs | 16 +++++++++++++++- src/Model/Types/Allocation.hs | 7 +++++++ templates/table/cell/allocation-priority.hamlet | 9 +++++++++ 5 files changed, 39 insertions(+), 2 deletions(-) create mode 100644 templates/table/cell/allocation-priority.hamlet diff --git a/messages/uniworx/de-de-formal.msg b/messages/uniworx/de-de-formal.msg index c5ca45984..a71029fa9 100644 --- a/messages/uniworx/de-de-formal.msg +++ b/messages/uniworx/de-de-formal.msg @@ -2350,6 +2350,7 @@ AllocationUsersApplied: Bewerbungen AllocationUsersAssigned: Zuweisungen AllocationUsersVetoed: Vetos AllocationUsersRequested: Angefragte Plätze +AllocationUsersPriority: Zentrale Dringlichkeit CsvColumnAllocationUserSurname: Nachname(n) des Bewerbers CsvColumnAllocationUserFirstName: Vorname(n) des Bewerbers @@ -2359,6 +2360,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 +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 AllocationPrioritiesMode: Modus diff --git a/src/Handler/Allocation/Users.hs b/src/Handler/Allocation/Users.hs index a7764decc..5654c5dda 100644 --- a/src/Handler/Allocation/Users.hs +++ b/src/Handler/Allocation/Users.hs @@ -73,6 +73,7 @@ data AllocationUserTableCsv = AllocationUserTableCsv , csvAUserApplied , csvAUserVetos , csvAUserAssigned :: Natural + , csvAUserPriority :: Maybe AllocationPriority } deriving (Generic) makeLenses_ ''AllocationUserTableCsv @@ -95,6 +96,7 @@ instance CsvColumnsExplained AllocationUserTableCsv where , singletonMap 'csvAUserApplied MsgCsvColumnAllocationUserApplied , singletonMap 'csvAUserVetos MsgCsvColumnAllocationUserVetos , singletonMap 'csvAUserAssigned MsgCsvColumnAllocationUserAssigned + , singletonMap 'csvAUserPriority MsgCsvColumnAllocationUserPriority ] @@ -141,6 +143,7 @@ postAUsersR tid ssh ash = do , colAllocationApplied resultAppliedCourses , colAllocationVetoed resultVetoedCourses , assignedHeated $ colAllocationAssigned resultAssignedCourses + , emptyOpticColonnade (resultAllocationUser . _entityVal . _allocationUserPriority . _Just) colAllocationPriority ] where assignedHeated @@ -161,6 +164,7 @@ postAUsersR tid ssh ash = do , sortAllocationAssigned queryAssignedCourses , sortAllocationRequested $ queryAllocationUser . (to (E.^. AllocationUserTotalCourses)) , sortAllocationVetoed queryVetoedCourses + , sortAllocationPriority $ queryAllocationUser . (to (E.^. AllocationUserPriority)) ] dbtFilter = mconcat [ fltrUserName' $ queryUser . (to (E.^. UserDisplayName)) @@ -183,9 +187,10 @@ postAUsersR tid ssh ash = do <*> view (resultAppliedCourses . to fromIntegral) <*> view (resultVetoedCourses . to fromIntegral) <*> view (resultAssignedCourses . to fromIntegral) + <*> view (resultAllocationUser . _entityVal . _allocationUserPriority) dbtCsvDecode = Nothing allocationUsersDBTableValidator = def - & defaultSorting [SortAscBy "user-matriculation"] + & defaultSorting [SortAscBy "priority", SortAscBy "user-matriculation"] & defaultPagesize PagesizeAll dbTableWidget' allocationUsersDBTableValidator allocationUsersDBTable diff --git a/src/Handler/Utils/Table/Columns.hs b/src/Handler/Utils/Table/Columns.hs index e63122ea4..fbc5886c9 100644 --- a/src/Handler/Utils/Table/Columns.hs +++ b/src/Handler/Utils/Table/Columns.hs @@ -14,7 +14,9 @@ import Import hiding (link) -- import Text.Blaze (ToMarkup(..)) import qualified Database.Esqueleto as E -import qualified Database.Esqueleto.Utils as E +import qualified Database.Esqueleto.Utils as E hiding ((->.)) +import qualified Database.Esqueleto.PostgreSQL.JSON as E (JSONBExpr, (->.)) +import qualified Database.Esqueleto.Internal.Sql as IE import Database.Esqueleto.Utils (mkExactFilter, mkExactFilterWith, mkContainsFilter, mkContainsFilterWith, anyFilter) import Handler.Utils.Table.Cells @@ -824,6 +826,18 @@ colAllocationRequested resultRequested = Colonnade.singleton (fromSortable heade sortAllocationRequested :: forall requested. PersistField requested => OpticSortColumn requested sortAllocationRequested queryRequested = singletonMap "requested" . SortColumn $ view queryRequested +colAllocationPriority :: OpticColonnade AllocationPriority +colAllocationPriority resultPriority = Colonnade.singleton (fromSortable header) body + where + header = Sortable (Just "priority") (i18nCell MsgAllocationUsersPriority) + body = views resultPriority $ \priority -> cell $(widgetFile "table/cell/allocation-priority") + +sortAllocationPriority :: OpticSortColumn (Maybe AllocationPriority) +sortAllocationPriority queryPriority = singletonMap "priority" . SortColumns . views queryPriority . (. IE.veryUnsafeCoerceSqlExprValue) $ \prio -> + [ SomeExprValue (prio E.->. "priorities" :: E.JSONBExpr Void) + , SomeExprValue (prio E.->. "ordinal" :: E.JSONBExpr Void) + ] + ---------------------------- -- Colonnade manipulation -- ---------------------------- diff --git a/src/Model/Types/Allocation.hs b/src/Model/Types/Allocation.hs index 8f4a6a6bf..b918deab0 100644 --- a/src/Model/Types/Allocation.hs +++ b/src/Model/Types/Allocation.hs @@ -21,6 +21,8 @@ import qualified Database.Esqueleto as E import qualified Database.Esqueleto.Internal.Sql as E import qualified Database.Esqueleto.PostgreSQL.JSON as E +import qualified Data.Text as Text + {-# ANN module ("HLint: ignore Use newtype instead of data"::String) #-} @@ -50,6 +52,11 @@ instance Csv.FromRecord (Map UserMatriculation AllocationPriority) where | otherwise = mzero +instance Csv.ToField AllocationPriority where + toField (AllocationPriorityOrdinal n ) = Csv.toField n + toField (AllocationPriorityNumeric ns) = encodeUtf8 . (\ns' -> "[" <> ns' <> "]") . Text.intercalate "," . map tshow $ Vector.toList ns + + sqlAllocationPriorityNumeric :: E.SqlExpr (E.Value AllocationPriority) -> E.SqlExpr (E.Value Bool) sqlAllocationPriorityNumeric prio = E.veryUnsafeCoerceSqlExprValue prio E.->. "mode" E.==. E.jsonbVal ("numeric" :: Text) diff --git a/templates/table/cell/allocation-priority.hamlet b/templates/table/cell/allocation-priority.hamlet new file mode 100644 index 000000000..86d61a148 --- /dev/null +++ b/templates/table/cell/allocation-priority.hamlet @@ -0,0 +1,9 @@ +$newline never +$case priority + $of AllocationPriorityOrdinal n + #{n} + $of AllocationPriorityNumeric ns +