From 7aadb6662bc8db76436f8d41ded7156acb98418e Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Wed, 18 Aug 2021 20:59:52 +0200 Subject: [PATCH] feat(corrections-r): allow csv exporting one line per submittor --- .../courses/submission/de-de-formal.msg | 2 ++ .../categories/courses/submission/en-eu.msg | 2 ++ src/Data/Scientific/Instances.hs | 10 +++++++++- src/Handler/Submission/List.hs | 17 ++++++++++++----- 4 files changed, 25 insertions(+), 6 deletions(-) diff --git a/messages/uniworx/categories/courses/submission/de-de-formal.msg b/messages/uniworx/categories/courses/submission/de-de-formal.msg index b2b734946..145768cc4 100644 --- a/messages/uniworx/categories/courses/submission/de-de-formal.msg +++ b/messages/uniworx/categories/courses/submission/de-de-formal.msg @@ -251,6 +251,8 @@ CsvColumnCorrectionAssigned: Zeitpunkt der Zuteilung des Korrektors (ISO 8601) CsvColumnCorrectionLastEdit: Zeitpunkt der letzten Änderung der Abgabe (ISO 8601) CsvColumnCorrectionRatingPoints: Erreichte Punktezahl (Für “_{MsgSheetGradingPassBinary}” entspricht 0 “_{MsgRatingNotPassed}” und alles andere “_{MsgRatingPassed}”) CsvColumnCorrectionRatingComment: Bewertungskommentar +CorrectionCsvSingleSubmittors: Eine Zeile pro Abgebende:n +CorrectionCsvSingleSubmittorsTip: Sollen Abgaben mit mehreren Abgebenden mehrfach vorkommen, sodass jeweils eine Zeile pro Abgebende:n enthalten ist, statt mehrere Abgebende in einer Zeile zusammenzufassen? CorrectionTableCsvNameSheetCorrections tid@TermId ssh@SchoolId csh@CourseShorthand shn@SheetName: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase csh}-#{foldedCase shn}-abgaben CorrectionTableCsvSheetNameSheetCorrections tid@TermId ssh@SchoolId csh@CourseShorthand shn@SheetName: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase csh}-#{foldedCase shn} Abgaben diff --git a/messages/uniworx/categories/courses/submission/en-eu.msg b/messages/uniworx/categories/courses/submission/en-eu.msg index 1e9adbd3b..0574c4a9d 100644 --- a/messages/uniworx/categories/courses/submission/en-eu.msg +++ b/messages/uniworx/categories/courses/submission/en-eu.msg @@ -250,6 +250,8 @@ CsvColumnCorrectionAssigned: Timestamp of when corrector was assigned (ISO 8601) CsvColumnCorrectionLastEdit: Timestamp of the last edit of the submission (ISO 8601) CsvColumnCorrectionRatingPoints: Achieved points (for “_{MsgSheetGradingPassBinary}” 0 means “_{MsgRatingNotPassed}”, everything else means “_{MsgRatingPassed}”) CsvColumnCorrectionRatingComment: Rating comment +CorrectionCsvSingleSubmittors: One row per submittor +CorrectionCsvSingleSubmittorsTip: Should submissions with multiple submittors be split into multiple rows, such that there is one row per submittor instead of having multiple submittors within one row? CorrectionTableCsvNameSheetCorrections tid ssh csh shn: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase csh}-#{foldedCase shn}-submissions CorrectionTableCsvSheetNameSheetCorrections tid ssh csh shn: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase csh}-#{foldedCase shn} Submissions diff --git a/src/Data/Scientific/Instances.hs b/src/Data/Scientific/Instances.hs index 8c0c83e89..87b079e7e 100644 --- a/src/Data/Scientific/Instances.hs +++ b/src/Data/Scientific/Instances.hs @@ -11,7 +11,15 @@ import Web.PathPieces import Text.ParserCombinators.ReadP (readP_to_S) +import Control.Monad.Fail + instance PathPiece Scientific where toPathPiece = pack . formatScientific Fixed Nothing - fromPathPiece = fmap fst . listToMaybe . filter (\(_, rStr) -> null rStr) . readP_to_S scientificP . unpack + + fromPathPiece = disambiguate . readP_to_S scientificP . unpack + where + disambiguate strs = case filter (\(_, rStr) -> null rStr) strs of + [(x, _)] -> pure x + _other -> fail "fromPathPiece Scientific: Ambiguous parse" + diff --git a/src/Handler/Submission/List.hs b/src/Handler/Submission/List.hs index be7f33c88..d9976e95c 100644 --- a/src/Handler/Submission/List.hs +++ b/src/Handler/Submission/List.hs @@ -302,6 +302,12 @@ data CorrectionTableCsvSettings = forall filename sheetName. , cTableShowCorrector :: Bool } +newtype CorrectionTableCsvExportData = CorrectionTableCsvExportData + { csvCorrectionSingleSubmittors :: Bool + } deriving (Eq, Ord, Read, Show, Generic, Typeable) +instance Default CorrectionTableCsvExportData where + def = CorrectionTableCsvExportData False + data CorrectionTableJson = CorrectionTableJson { jsonCorrectionTerm :: TermIdentifier , jsonCorrectionSchool :: SchoolShorthand @@ -698,11 +704,12 @@ makeCorrectionsTable whereClause dbtColonnade dbtFilterUI' mCSVSettings psValida dbtCsvEncode = do CorrectionTableCsvSettings{..} <- mCSVSettings return DBTCsvEncode - { dbtCsvExportForm = pure () - , dbtCsvNoExportData = Just id - , dbtCsvDoEncode = \() -> awaitForever $ \(_, row) -> runReaderC row $ do + { dbtCsvExportForm = CorrectionTableCsvExportData + <$> apopt checkBoxField (fslI MsgCorrectionCsvSingleSubmittors & setTooltip MsgCorrectionCsvSingleSubmittorsTip) (Just $ csvCorrectionSingleSubmittors def) + , dbtCsvNoExportData = Nothing + , dbtCsvDoEncode = \CorrectionTableCsvExportData{..} -> awaitForever $ \(_, row) -> runReaderC row $ do submittors <- asks $ sortOn (view $ resultUserUser . $(multifocusG 2) _userSurname _userDisplayName) . toListOf resultSubmittors - forM_ (bool pure (map pure) False submittors) $ \submittors' -> transPipe (withReaderT (, submittors')) $ do + forM_ (bool pure (map pure) csvCorrectionSingleSubmittors submittors) $ \submittors' -> transPipe (withReaderT (, submittors')) $ do let guardNonAnonymous = runMaybeT . guardMOnM (view $ _1 . resultNonAnonymousAccess) . MaybeT yieldM $ CorrectionTableCsv <$> preview (_1 . resultCourseTerm . _TermId) @@ -731,7 +738,7 @@ makeCorrectionsTable whereClause dbtColonnade dbtFilterUI' mCSVSettings psValida , dbtCsvExampleData = Nothing } dbtCsvDecode = Nothing - dbtExtraReps = + dbtExtraReps = maybe id (\CorrectionTableCsvSettings{..} -> withCsvExtraRep cTableCsvSheetName (def :: CorrectionTableCsvExportData) dbtCsvEncode) mCSVSettings [ DBTExtraRep $ toPrettyJSON <$> repCorrectionJson, DBTExtraRep $ toYAML <$> repCorrectionJson ]