Merge branch 'master' into 470-lecturerinfo-seite-uberarbeiten

messages/uniworx/de.msg

@@ -1517,6 +1517,7 @@ CsvImportExplanationLabel: Hinweise zum CSV-Import
 
 Proportion c@Text of@Text prop@Rational: #{c}/#{of} (#{rationalToFixed2 (100 * prop)}%)
 
+CourseUserCsvName tid@TermId ssh@SchoolId csh@CourseShorthand: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase csh}-teilnehmer
 ExamUserCsvName tid@TermId ssh@SchoolId csh@CourseShorthand examn@ExamName: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase csh}-#{foldedCase examn}-teilnehmer
 CourseApplicationsTableCsvName tid@TermId ssh@SchoolId csh@CourseShorthand: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase csh}-bewerbungen
 
@@ -1539,6 +1540,15 @@ CsvColumnExamUserParts: Erreichte Punktezahlen in den Teilprüfungen, sofern vor
 CsvColumnExamUserResult: Erreichte Prüfungsleistung; "passed", "failed", "no-show", "voided", oder eine Note ("1.0", "1.3", "1.7", ..., "4.0", "5.0")
 CsvColumnExamUserCourseNote: Notizen zum Teilnehmer
 
+CsvColumnUserName: Voller Name des Teilnehmers
+CsvColumnUserMatriculation: Matrikelnummer des Teilnehmers
+CsvColumnUserEmail: E-Mail Addresse des Teilnehmers
+CsvColumnUserField: Studienfach, mit dem der Teilnehmer seine Kursanmeldung assoziiert hat
+CsvColumnUserDegree: Abschluss, den der Teilnehmer im assoziierten Studienfach anstrebt
+CsvColumnUserSemester: Fachsemester des Teilnehmers im assoziierten Studienfach
+CsvColumnUserRegistration: Zeitpunkt der Anmeldung zum Kurs (ISO 8601)
+CsvColumnUserNote: Notizen zum Teilnehmer
+
 CsvColumnExamOfficeExamUserOccurrenceStart: Prüfungstermin (ISO 8601)
 
 CsvColumnApplicationsAllocation: Zentralanmeldung über die die Bewerbung eingegangen ist

src/Handler/Course/Users.hs

@@ -21,6 +21,8 @@ import qualified Data.Map as Map
 
 import qualified Database.Esqueleto as E
 
+import qualified Data.Csv as Csv
+
 
 type UserTableExpr   = (E.SqlExpr (Entity User) `E.InnerJoin` E.SqlExpr (Entity CourseParticipant))
         `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity CourseUserNote))
@@ -117,6 +119,38 @@ colUserDegreeShort = sortable (Just "degree-short") (i18nCell MsgStudyFeatureDeg
     foldMap (i18nCell . ShortStudyDegree) . preview (_userTableFeatures . _2 . _Just)
 
 
+data UserTableCsv = UserTableCsv
+  { csvUserName :: Text
+  , csvUserMatriculation :: Maybe Text
+  , csvUserEmail :: CI Email
+  , csvUserField :: Maybe Text
+  , csvUserDegree :: Maybe Text
+  , csvUserSemester :: Maybe Int
+  , csvUserRegistration :: UTCTime
+  , csvUserNote :: Maybe Html
+  }
+  deriving (Generic)
+makeLenses_ ''UserTableCsv
+
+userTableCsvOptions :: Csv.Options
+userTableCsvOptions = Csv.defaultOptions { Csv.fieldLabelModifier = camelToPathPiece' 2 }
+instance Csv.ToNamedRecord UserTableCsv where
+  toNamedRecord = Csv.genericToNamedRecord userTableCsvOptions
+instance Csv.DefaultOrdered UserTableCsv where
+  headerOrder = Csv.genericHeaderOrder userTableCsvOptions
+instance CsvColumnsExplained UserTableCsv where
+  csvColumnsExplanations = genericCsvColumnsExplanations userTableCsvOptions $ mconcat
+    [ singletonMap 'csvUserName          MsgCsvColumnUserName
+    , singletonMap 'csvUserMatriculation MsgCsvColumnUserMatriculation
+    , singletonMap 'csvUserEmail         MsgCsvColumnUserEmail
+    , singletonMap 'csvUserField         MsgCsvColumnUserField
+    , singletonMap 'csvUserDegree        MsgCsvColumnUserDegree
+    , singletonMap 'csvUserSemester      MsgCsvColumnUserSemester
+    , singletonMap 'csvUserRegistration  MsgCsvColumnUserRegistration
+    , singletonMap 'csvUserNote          MsgCsvColumnUserNote
+    ]
+
+
 data CourseUserAction = CourseUserSendMail | CourseUserDeregister
   deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
 
@@ -144,6 +178,8 @@ makeCourseUserTable :: forall h act act'.
                     -> DB (FormResult (act', Set UserId), Widget)
 makeCourseUserTable cid acts restrict colChoices psValidator = do
     currentRoute <- fromMaybe (error "makeCourseUserTable called from 404-handler") <$> liftHandler getCurrentRoute
+    Course{..} <- getJust cid
+    csvName <- getMessageRender <*> pure (MsgCourseUserCsvName courseTerm courseSchool courseShorthand)
     -- -- psValidator has default sorting and filtering
     let dbtIdent     = "courseUsers" :: Text
         dbtStyle     = def { dbsFilterLayout = defaultDBSFilterLayout }
@@ -218,7 +254,24 @@ makeCourseUserTable cid acts restrict colChoices psValidator = do
           , dbParamsFormResult   = id
           , dbParamsFormIdent    = def
           }
-        dbtCsvEncode = noCsvEncode
+        dbtCsvEncode = simpleCsvEncodeM csvName $ UserTableCsv
+          <$> view (hasUser . _userDisplayName)
+          <*> view (hasUser . _userMatrikelnummer)
+          <*> view (hasUser . _userEmail)
+          <*> preview (   _userTableFeatures . _3 . _Just . _studyTermsName . _Just
+                       <> _userTableFeatures . _3 . _Just . _studyTermsKey . to tshow
+                      )
+          <*> preview (   _userTableFeatures . _2 . _Just . _studyDegreeName . _Just
+                       <> _userTableFeatures . _2 . _Just . _studyDegreeKey . to tshow
+                      )
+          <*> preview (_userTableFeatures . _1 . _Just . _studyFeaturesSemester)
+          <*> view _userTableRegistration
+          <*> userNote
+          where
+            userNote = runMaybeT $ do
+              noteId <- MaybeT . preview $ _userTableNote . _Just
+              CourseUserNote{..} <- lift . lift $ getJust noteId
+              return courseUserNoteNote
         dbtCsvDecode = Nothing
     over _1 postprocess <$> dbTable psValidator DBTable{..}
   where

src/Handler/Utils/Table/Pagination.hs

@@ -982,7 +982,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
       | Just DBTCsvEncode{..} <- dbtCsvEncode
       , Just exportData <- fromDynamic dbCsvExportData -> do
         hdr <- dbtCsvHeader $ Just exportData
-        let ensureExtension ext fName = bool (addExtension ext) id (ext `isExtensionOf` fName) fName
+        let ensureExtension ext fName = bool (`addExtension` ext) id (ext `isExtensionOf` fName) fName
         setContentDisposition' . Just $ ensureExtension (unpack extensionCsv) dbtCsvName
         sendResponse <=< liftHandler . respondCsvDB hdr $ C.sourceList (zip currentKeys rows) .| dbtCsvDoEncode exportData >> lift E.transactionSave
     DBCsvImport{..}