diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 0b9f793ac..b4fed19f3 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -1514,6 +1514,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 @@ -1536,6 +1537,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 diff --git a/src/Handler/Course/Users.hs b/src/Handler/Course/Users.hs index a89645a81..91bfdf0c3 100644 --- a/src/Handler/Course/Users.hs +++ b/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 diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs index a5845696b..b62b8cc52 100644 --- a/src/Handler/Utils/Table/Pagination.hs +++ b/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{..}