feat(allocations): show & export priority

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

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

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 --
 ----------------------------

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)
 

templates/table/cell/allocation-priority.hamlet

@@ -0,0 +1,9 @@
+$newline never
+$case priority
+  $of AllocationPriorityOrdinal n
+    #{n}
+  $of AllocationPriorityNumeric ns
+    <ul .list--inline .list--iconless .list--comma-separated>
+      $forall n <- ns
+        <li>
+          #{n}