feat(corrections-r): allow csv exporting one line per submittor

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

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

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

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
           ]