feat(allocations): include study features in users table

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)

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)

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)

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