feat(corrections-r): csv export

Fixes #705

messages/uniworx/categories/courses/submission/de-de-formal.msg

@@ -228,4 +228,35 @@ SubmissionColumnAuthorshipStatementTime: Zeitstempel
 SubmissionColumnAuthorshipStatementWording: Wortlaut
 SubmissionFilterAuthorshipStatementCurrent: Aktueller Wortlaut
 
-SubmissionNoUsers: Diese Abgabe hat keine assoziierten Benutzer!
+SubmissionNoUsers: Diese Abgabe hat keine assoziierten Benutzer!
+
+CsvColumnCorrectionTerm: Semester des Kurses der Abgabe
+CsvColumnCorrectionSchool: Institut des Kurses der Abgabe
+CsvColumnCorrectionCourse: Kürzel des Kurses der Abgabe
+CsvColumnCorrectionSheet: Name des Übungsblatts der Abgabe
+CsvColumnCorrectionSubmission: Nummer der Abgabe (uwa…)
+CsvColumnCorrectionSurname: Nachnamen der Abgebenden als Semikolon (;) separierte Liste
+CsvColumnCorrectionFirstName: Vornamen der Abgebenden als Semikolon (;) separierte Liste
+CsvColumnCorrectionName: Volle Namen der Abgebenden als Semikolon (;) separierte Liste
+CsvColumnCorrectionMatriculation: Matrikelnummern der Abgebenden als Semikolon (;) separierte Liste
+CsvColumnCorrectionEmail: E-Mail Adressen der Abgebenden als Semikolon (;) separierte Liste
+CsvColumnCorrectionPseudonym: Abgabe-Pseudonyme der Abgebenden als Semikolon (;) separierte Liste
+CsvColumnCorrectionSubmissionGroup: Feste Abgabegruppen der Abgebenden als Semikolon (;) separierte Liste
+CsvColumnCorrectionAuthorshipStatementState: Zustände der Eigenständigkeitserklärungen ("#{toPathPiece ASMissing}", "#{toPathPiece ASOldStatement}" oder "#{toPathPiece ASExists}") als Semikolon (;) separierte Liste
+CsvColumnCorrectionCorrectorName: Voller Name des Korrektors der Abgabe
+CsvColumnCorrectionCorrectorEmail: E-Mail Adresse des Korrektors der Abgabe
+CsvColumnCorrectionRatingDone: Bewertung abgeschlossen ("t"/"f")
+CsvColumnCorrectionRatedAt: Zeitpunkt der Bewertung (ISO 8601)
+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
+
+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
+CorrectionTableCsvNameCourseCorrections tid@TermId ssh@SchoolId csh@CourseShorthand: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase csh}-abgaben
+CorrectionTableCsvSheetNameCourseCorrections tid@TermId ssh@SchoolId csh@CourseShorthand: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase csh} Abgaben
+CorrectionTableCsvNameCorrections: abgaben
+CorrectionTableCsvSheetNameCorrections: Abgaben
+CorrectionTableCsvNameCourseUserCorrections tid@TermId ssh@SchoolId csh@CourseShorthand displayName@Text: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase csh}-#{foldCase displayName}-abgaben
+CorrectionTableCsvSheetNameCourseUserCorrections tid@TermId ssh@SchoolId csh@CourseShorthand displayName@Text: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase csh}-#{foldCase displayName} Abgaben

messages/uniworx/categories/courses/submission/en-eu.msg

@@ -228,3 +228,34 @@ SubmissionColumnAuthorshipStatementWording: Wording
 SubmissionFilterAuthorshipStatementCurrent: Current wording
 
 SubmissionNoUsers: This submission has no associated users!
+
+CsvColumnCorrectionTerm: Term of the course of the submission
+CsvColumnCorrectionSchool: School of the course of the submission
+CsvColumnCorrectionCourse: Shorthand of the course of the submission
+CsvColumnCorrectionSheet: Name of the sheet of the submission
+CsvColumnCorrectionSubmission: Number of the submission (uwa…)
+CsvColumnCorrectionSurname: Submittor's surnames, separated by semicolon (;)
+CsvColumnCorrectionFirstName: Submittor's first names, separated by semicolon (;)
+CsvColumnCorrectionName: Submittor's full names, separated by semicolon (;)
+CsvColumnCorrectionMatriculation: Submittor's matriculations, separated by semicolon (;)
+CsvColumnCorrectionEmail: Submittor's email addresses, separated by semicolon (;)
+CsvColumnCorrectionPseudonym: Submittor's submission pseudonyms, separated by semicolon (;)
+CsvColumnCorrectionSubmissionGroup: Submittor's submisson groups, separated by semicolon (;)
+CsvColumnCorrectionAuthorshipStatementState: States of the statements of authorship ("#{toPathPiece ASMissing}", "#{toPathPiece ASOldStatement}", or "#{toPathPiece ASExists}"), separated by semicolon (;)
+CsvColumnCorrectionCorrectorName: Full name of the corrector of the submission
+CsvColumnCorrectionCorrectorEmail: Email address of the corrector of the submission
+CsvColumnCorrectionRatingDone: Rating done ("t"/"f")
+CsvColumnCorrectionRatedAt: Timestamp of rating (ISO 8601)
+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
+
+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
+CorrectionTableCsvNameCourseCorrections tid ssh csh: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase csh}-submissions
+CorrectionTableCsvSheetNameCourseCorrections tid ssh csh: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase csh} Submissions
+CorrectionTableCsvNameCorrections: submissions
+CorrectionTableCsvSheetNameCorrections: Submissions
+CorrectionTableCsvNameCourseUserCorrections tid ssh csh displayName: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase csh}-#{foldCase displayName}-submissions
+CorrectionTableCsvSheetNameCourseUserCorrections tid ssh csh displayName: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase csh}-#{foldCase displayName} Submissions

src/Data/Scientific/Instances.hs

@@ -9,7 +9,9 @@ import Data.Scientific
 
 import Web.PathPieces
 
+import Text.ParserCombinators.ReadP (readP_to_S)
+
 
 instance PathPiece Scientific where
   toPathPiece = pack . formatScientific Fixed Nothing
-  fromPathPiece = readFromPathPiece
+  fromPathPiece = fmap fst . listToMaybe . filter (\(_, rStr) -> null rStr) . readP_to_S scientificP . unpack

src/Data/Word/Word24/Instances.hs

@@ -12,6 +12,8 @@ import System.Random (Random(..))
 import Data.Aeson (FromJSON(..), ToJSON(..))
 import qualified Data.Aeson.Types as Aeson
 
+import Web.PathPieces
+
 import Data.Word.Word24
 
 import Control.Lens
@@ -19,6 +21,7 @@ import Control.Lens
 import Control.Monad.Fail
 
 import qualified Data.Scientific as Scientific
+import Data.Scientific.Instances ()
 
 import Data.Binary
 import Data.Bits
@@ -51,6 +54,10 @@ instance FromJSON Word24 where
 instance ToJSON Word24 where
   toJSON = Aeson.Number . fromIntegral
 
+instance PathPiece Word24 where
+  toPathPiece p = toPathPiece (fromIntegral p :: Word32)
+  fromPathPiece = Scientific.toBoundedInteger <=< fromPathPiece
+
 
 -- | Big Endian
 instance Binary Word24 where

src/Foundation/I18n.hs

@@ -308,6 +308,8 @@ embedRenderMessageVariant ''UniWorX ''ADInvalidCredentials ("InvalidCredentials"
 embedRenderMessage ''UniWorX ''SchoolAuthorshipStatementMode id
 embedRenderMessage ''UniWorX ''SheetAuthorshipStatementMode id
 
+embedRenderMessage ''UniWorX ''AuthorshipStatementSubmissionState $ concat . ("SubmissionAuthorshipStatementState" :) . drop 1 . splitCamel
+
 newtype ShortSex = ShortSex Sex
 embedRenderMessageVariant ''UniWorX ''ShortSex ("Short" <>)
 

src/Handler/Course/User.hs

@@ -240,7 +240,7 @@ courseUserNoteSection (Entity cid Course{..}) (Entity uid _) = do
 
 
 courseUserSubmissionsSection :: Entity Course -> Entity User -> MaybeT Handler Widget
-courseUserSubmissionsSection (Entity cid Course{..}) (Entity uid _) = do
+courseUserSubmissionsSection (Entity cid Course{..}) (Entity uid User{..}) = do
   guardM . lift . hasWriteAccessTo $ CourseR courseTerm courseSchool courseShorthand CCorrectionsR
 
   let whereClause :: CorrectionTableWhere
@@ -268,7 +268,13 @@ courseUserSubmissionsSection (Entity cid Course{..}) (Entity uid _) = do
         , filterUISubmission
         ]
       psValidator = def & defaultPagesize PagesizeAll -- Assisstant always want to see them all at once anyway
-  (cWdgt, statistics) <- lift . correctionsR' whereClause colonnade filterUI psValidator $ Map.fromList
+      csvSettings = Just CorrectionTableCsvSettings
+        { cTableCsvQualification = CorrectionTableCsvQualifySheet
+        , cTableCsvName = MsgCorrectionTableCsvNameCourseUserCorrections courseTerm courseSchool courseShorthand userDisplayName
+        , cTableCsvSheetName = MsgCorrectionTableCsvSheetNameCourseUserCorrections courseTerm courseSchool courseShorthand userDisplayName
+        , cTableShowCorrector = True
+        }
+  (cWdgt, statistics) <- lift . correctionsR' whereClause colonnade filterUI csvSettings psValidator $ Map.fromList
     [ downloadAction
     , assignAction (Left cid)
     , deleteAction

src/Handler/Course/Users.hs

@@ -197,17 +197,13 @@ instance Csv.ToNamedRecord UserTableCsv where
     , "email" Csv..= csvUserEmail
     , "study-features" Csv..= csvUserStudyFeatures
     , "submission-group" Csv..= csvUserSubmissionGroup
-    ] ++
+    , "tutorial" Csv..= CsvSemicolonList (csvUserTutorials ^. _1)
-    [ let tutsStr = Text.intercalate "; " . map CI.original $ csvUserTutorials ^. _1
-       in "tutorial" Csv..= tutsStr
     ] ++
     [ encodeUtf8 (CI.foldedCase regGroup) Csv..= (CI.original <$> mTut)
     | (regGroup, mTut) <- Map.toList $ csvUserTutorials ^. _2
     ] ++
-    [ let examsStr = Text.intercalate "; " $ map CI.original csvUserExams
+    [ "exams" Csv..= CsvSemicolonList csvUserExams
-       in "exams" Csv..= examsStr
+    , "registration" Csv..= csvUserRegistration
-    ] ++
-    [ "registration" Csv..= csvUserRegistration
     ] ++
     [ encodeUtf8 (CI.foldedCase shn) Csv..= res
     | (shn, res) <- Map.toList csvUserSheets

src/Handler/Submission/Grade.hs

@@ -64,7 +64,7 @@ postCorrectionsGradeR = do
         & defaultSorting [SortDescBy "ratingtime"] :: PSValidator (MForm (HandlerFor UniWorX)) (FormResult (DBFormResult SubmissionId (Bool, Maybe Points, Maybe Text) CorrectionTableData))
       unFormResult = getDBFormResult $ \(view $ resultSubmission . _entityVal -> sub@Submission{..}) -> (submissionRatingDone sub, submissionRatingPoints, submissionRatingComment)
 
-  (fmap unFormResult -> tableRes, table) <- runDB $ makeCorrectionsTable whereClause displayColumns filterUI psValidator $ def
+  (fmap unFormResult -> tableRes, table) <- runDB $ makeCorrectionsTable whereClause displayColumns filterUI Nothing psValidator $ def
     { dbParamsFormAction = Just $ SomeRoute CorrectionsGradeR
     }
 

src/Handler/Submission/List.hs

@@ -14,6 +14,7 @@ module Handler.Submission.List
   , makeCorrectionsTable
   , CorrectionTableData, CorrectionTableWhere
   , ActionCorrections(..), downloadAction, deleteAction, assignAction, autoAssignAction
+  , CorrectionTableCsvQualification(..), CorrectionTableCsvSettings(..)
   ) where
 
 import Import hiding (link)
@@ -23,7 +24,6 @@ import Handler.Utils.Submission
 import Handler.Utils.SheetType
 import Handler.Utils.Delete
 
-import Data.List as List (foldr)
 import qualified Data.Set as Set
 import qualified Data.Map.Strict as Map
 
@@ -42,6 +42,8 @@ import Database.Persist.Sql (updateWhereCount)
 
 import Data.List (genericLength)
 
+import qualified Data.Csv as Csv
+
 
 data CorrectionTableFilterProj = CorrectionTableFilterProj
   { corrProjFilterSubmission :: Maybe (Set [CI Char])
@@ -66,7 +68,7 @@ type CorrectionTableExpr  = (               E.SqlExpr (Entity Course)
           `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity User))
 type CorrectionTableWhere = forall m. MonadReader CorrectionTableExpr m => m (E.SqlExpr (E.Value Bool))
 type CorrectionTableCourseData = (CourseName, CourseShorthand, TermId, SchoolId)
-type CorrectionTableUserData = (User, Maybe Pseudonym, Maybe SubmissionGroupName)
+type CorrectionTableUserData = (User, Maybe Pseudonym, Maybe SubmissionGroupName, Maybe AuthorshipStatementSubmissionState)
 type CorrectionTableData = DBRow ( Entity Submission
                                  , Entity Sheet
                                  , CorrectionTableCourseData
@@ -135,6 +137,9 @@ resultUserPseudonym = _2 . _Just
 resultUserSubmissionGroup :: Traversal' CorrectionTableUserData SubmissionGroupName
 resultUserSubmissionGroup = _3 . _Just
 
+resultUserAuthorshipStatementState :: Traversal' CorrectionTableUserData AuthorshipStatementSubmissionState
+resultUserAuthorshipStatementState = _4 . _Just
+
 resultCryptoID :: Lens' CorrectionTableData CryptoFileNameSubmission
 resultCryptoID = _dbrOutput . _7
 
@@ -145,6 +150,159 @@ resultASState :: Lens' CorrectionTableData (Maybe AuthorshipStatementSubmissionS
 resultASState = _dbrOutput . _9
 
 
+data CorrectionTableCsv = CorrectionTableCsv
+  { csvCorrectionTerm :: Maybe TermIdentifier
+  , csvCorrectionSchool :: Maybe SchoolShorthand
+  , csvCorrectionCourse :: Maybe CourseShorthand
+  , csvCorrectionSheet :: Maybe SheetName
+  , csvCorrectionSubmission :: Maybe (CI Text)
+  , csvCorrectionLastEdit :: Maybe UTCTime
+  , csvCorrectionSurname :: Maybe [Maybe UserSurname]
+  , csvCorrectionFirstName :: Maybe [Maybe UserFirstName]
+  , csvCorrectionName :: Maybe [Maybe UserDisplayName]
+  , csvCorrectionMatriculation :: Maybe [Maybe UserMatriculation]
+  , csvCorrectionEmail :: Maybe [Maybe UserEmail]
+  , csvCorrectionPseudonym :: Maybe [Maybe Pseudonym]
+  , csvCorrectionSubmissionGroup :: Maybe [Maybe SubmissionGroupName]
+  , csvCorrectionAuthorshipStatementState :: Maybe [Maybe AuthorshipStatementSubmissionState]
+  , csvCorrectionAssigned :: Maybe UTCTime
+  , csvCorrectionCorrectorName :: Maybe UserDisplayName
+  , csvCorrectionCorrectorEmail :: Maybe UserEmail
+  , csvCorrectionRatingDone :: Maybe Bool
+  , csvCorrectionRatedAt :: Maybe UTCTime
+  , csvCorrectionRatingPoints :: Maybe Points
+  , csvCorrectionRatingComment :: Maybe Text
+  } deriving (Generic)
+makeLenses_ ''CorrectionTableCsv
+
+correctionTableCsvOptions :: Csv.Options
+correctionTableCsvOptions = Csv.defaultOptions { Csv.fieldLabelModifier = camelToPathPiece' 2 }
+
+instance Csv.ToNamedRecord CorrectionTableCsv where
+  toNamedRecord CorrectionTableCsv{..} = Csv.namedRecord
+      [ "term" Csv..= csvCorrectionTerm
+      , "school" Csv..= csvCorrectionSchool
+      , "course" Csv..= csvCorrectionCourse
+      , "sheet" Csv..= csvCorrectionSheet
+      , "submission" Csv..= csvCorrectionSubmission
+      , "last-edit" Csv..= csvCorrectionLastEdit
+      , "surname" Csv..= maybe mempty (Csv.toField . CsvSemicolonList) csvCorrectionSurname
+      , "first-name" Csv..= maybe mempty (Csv.toField . CsvSemicolonList) csvCorrectionFirstName
+      , "name" Csv..= maybe mempty (Csv.toField . CsvSemicolonList) csvCorrectionName
+      , "matriculation" Csv..= maybe mempty (Csv.toField . CsvSemicolonList . mkEmpty) csvCorrectionMatriculation
+      , "email" Csv..= maybe mempty (Csv.toField . CsvSemicolonList) csvCorrectionEmail
+      , "pseudonym" Csv..= maybe mempty (Csv.toField . CsvSemicolonList . mkEmpty) csvCorrectionPseudonym
+      , "submission-group" Csv..= maybe mempty (Csv.toField . CsvSemicolonList . mkEmpty) csvCorrectionSubmissionGroup
+      , "authorship-statement-state" Csv..= maybe mempty (Csv.toField . CsvSemicolonList . mkEmpty) csvCorrectionAuthorshipStatementState
+      , "assigned" Csv..= csvCorrectionAssigned
+      , "corrector-name" Csv..= csvCorrectionCorrectorName
+      , "corrector-email" Csv..= csvCorrectionCorrectorEmail
+      , "rating-done" Csv..= csvCorrectionRatingDone
+      , "rated-at" Csv..= csvCorrectionRatedAt
+      , "rating-points" Csv..= csvCorrectionRatingPoints
+      , "rating-comment" Csv..= csvCorrectionRatingComment
+      ]
+    where 
+      mkEmpty = \case
+        [Nothing] -> []
+        x -> x
+
+instance Csv.DefaultOrdered CorrectionTableCsv where
+  headerOrder = Csv.genericHeaderOrder correctionTableCsvOptions
+
+instance Csv.FromNamedRecord CorrectionTableCsv where
+  parseNamedRecord csv
+    = CorrectionTableCsv
+      <$> csv .:?? "term"
+      <*> csv .:?? "school"
+      <*> csv .:?? "course"
+      <*> csv .:?? "sheet"
+      <*> csv .:?? "submission"
+      <*> csv .:?? "last-edit"
+      <*> fmap (fmap unCsvSemicolonList) (csv .:?? "surname")
+      <*> fmap (fmap unCsvSemicolonList) (csv .:?? "first-name")
+      <*> fmap (fmap unCsvSemicolonList) (csv .:?? "name")
+      <*> fmap (fmap unCsvSemicolonList) (csv .:?? "matriculation")
+      <*> fmap (fmap unCsvSemicolonList) (csv .:?? "email")
+      <*> fmap (fmap unCsvSemicolonList) (csv .:?? "pseudonym")
+      <*> fmap (fmap unCsvSemicolonList) (csv .:?? "submission-group")
+      <*> fmap (fmap unCsvSemicolonList) (csv .:?? "authorship-statement-state")
+      <*> csv .:?? "assigned"
+      <*> csv .:?? "corrector-name"
+      <*> csv .:?? "corrector-email"
+      <*> csv .:?? "rating-done"
+      <*> csv .:?? "rated-at"
+      <*> csv .:?? "rating-points"
+      <*> csv .:?? "rating-comment"
+
+instance CsvColumnsExplained CorrectionTableCsv where
+  csvColumnsExplanations = genericCsvColumnsExplanations correctionTableCsvOptions $ Map.fromList
+    [ ('csvCorrectionTerm           , MsgCsvColumnCorrectionTerm)
+    , ('csvCorrectionSchool         , MsgCsvColumnCorrectionSchool)
+    , ('csvCorrectionCourse         , MsgCsvColumnCorrectionCourse)
+    , ('csvCorrectionSheet          , MsgCsvColumnCorrectionSheet)
+    , ('csvCorrectionSubmission     , MsgCsvColumnCorrectionSubmission)
+    , ('csvCorrectionLastEdit       , MsgCsvColumnCorrectionLastEdit)
+    , ('csvCorrectionSurname        , MsgCsvColumnCorrectionSurname)
+    , ('csvCorrectionFirstName      , MsgCsvColumnCorrectionFirstName)
+    , ('csvCorrectionName           , MsgCsvColumnCorrectionName)
+    , ('csvCorrectionMatriculation  , MsgCsvColumnCorrectionMatriculation)
+    , ('csvCorrectionEmail          , MsgCsvColumnCorrectionEmail)
+    , ('csvCorrectionPseudonym      , MsgCsvColumnCorrectionPseudonym)
+    , ('csvCorrectionSubmissionGroup, MsgCsvColumnCorrectionSubmissionGroup)
+    , ('csvCorrectionAuthorshipStatementState, MsgCsvColumnCorrectionAuthorshipStatementState)
+    , ('csvCorrectionAssigned       , MsgCsvColumnCorrectionAssigned)
+    , ('csvCorrectionCorrectorName  , MsgCsvColumnCorrectionCorrectorName)
+    , ('csvCorrectionCorrectorEmail , MsgCsvColumnCorrectionCorrectorEmail)
+    , ('csvCorrectionRatingDone     , MsgCsvColumnCorrectionRatingDone)
+    , ('csvCorrectionRatedAt        , MsgCsvColumnCorrectionRatedAt)
+    , ('csvCorrectionRatingPoints   , MsgCsvColumnCorrectionRatingPoints)
+    , ('csvCorrectionRatingComment  , MsgCsvColumnCorrectionRatingComment)
+    ]
+
+data CorrectionTableCsvQualification
+  = CorrectionTableCsvNoQualification
+  | CorrectionTableCsvQualifySheet
+  | CorrectionTableCsvQualifyCourse
+  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)    
+  deriving anyclass (Universe, Finite)
+
+correctionTableCsvHeader :: Bool -- ^ @showCorrector@
+                         -> CorrectionTableCsvQualification -> Csv.Header
+correctionTableCsvHeader showCorrector qual = Csv.header $ catMaybes
+  [ guardOn (qual >= CorrectionTableCsvQualifyCourse) "term"
+  , guardOn (qual >= CorrectionTableCsvQualifyCourse) "school"
+  , guardOn (qual >= CorrectionTableCsvQualifyCourse) "course"
+  , guardOn (qual >= CorrectionTableCsvQualifySheet) "sheet"
+  , pure "submission"
+  , pure "last-edit"
+  , pure "surname"
+  , pure "first-name"
+  , pure "name"
+  , pure "matriculation"
+  , pure "email"
+  , pure "pseudonym"
+  , pure "submission-group"
+  , pure "authorship-statement-state"
+  , pure "assigned"
+  , guardOn showCorrector "corrector-name"
+  , guardOn showCorrector "corrector-email"
+  , pure "rating-done"
+  , pure "rated-at"
+  , pure "rating-points"
+  , pure "rating-comment"
+  ]
+
+data CorrectionTableCsvSettings = forall filename sheetName.
+  ( RenderMessage UniWorX filename, RenderMessage UniWorX sheetName
+  ) => CorrectionTableCsvSettings
+  { cTableCsvQualification :: CorrectionTableCsvQualification
+  , cTableCsvName :: filename
+  , cTableCsvSheetName :: sheetName
+  , cTableShowCorrector :: Bool
+  }
+
+
 -- Where Clauses
 ratedBy :: UserId -> CorrectionTableWhere
 ratedBy uid = views querySubmission $ (E.==. E.justVal uid) . (E.^. SubmissionRatingBy)
@@ -206,10 +364,10 @@ colSubmittors = sortable (Just "submittors") (i18nCell MsgSubmissionUsers) $ \x
       ssh = x ^. resultCourseSchool
       csh = x ^. resultCourseShorthand
       link uCID = CourseR tid ssh csh $ CUserR uCID
-      protoCell = listCell (sortOn (view $ _2 . resultUserUser . $(multifocusG 2) _userSurname _userDisplayName) $ itoListOf resultSubmittors x) $ \((encrypt -> mkUCID), u) ->
+      protoCell = listCell (sortOn (view $ _2 . resultUserUser . $(multifocusG 2) _userSurname _userDisplayName) $ itoListOf resultSubmittors x) $ \(encrypt -> mkUCID, u) ->
         let User{..} = u ^. resultUserUser
             mPseudo = u ^? resultUserPseudonym
-         in anchorCellCM $cacheIdentHere (link <$> mkUCID) $
+         in anchorCellCM $cacheIdentHere (link <$> mkUCID)
               [whamlet|
                 $newline never
                 ^{nameWidget userDisplayName userSurname}
@@ -298,7 +456,7 @@ colCommentField' l = sortable (Just "comment") (i18nCell MsgRatingComment) $ (ce
   (\(view (resultSubmission . _entityVal) -> Submission{..}) mkUnique -> over (_1.mapped) ((l .~) . assertM (not . null) . fmap (Text.strip . unTextarea)) . over _2 fvWidget <$> mopt textareaField (fsUniq mkUnique "comment") (Just $ Textarea <$> submissionRatingComment))
 
 colLastEdit :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
-colLastEdit = sortable (Just "last-edit") (i18nCell MsgTableLastEdit) $ \x -> maybeCell (x ^? resultLastEdit) dateTimeCell
+colLastEdit = sortable (Just "last-edit") (i18nCell MsgTableLastEdit) $ \x -> maybeCell (guardOnM (x ^. resultNonAnonymousAccess) $ x ^? resultLastEdit) dateTimeCell
 
 colAuthorshipStatementState :: forall m a. IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
 colAuthorshipStatementState = sortable (Just "as-state") (i18nCell MsgSubmissionUserAuthorshipStatementState) $ \x ->
@@ -314,7 +472,7 @@ colAuthorshipStatementState = sortable (Just "as-state") (i18nCell MsgSubmission
       cID = x ^. resultCryptoID
       
       asRoute = CSubmissionR tid ssh csh shn cID SubAuthorshipStatementsR
-   in maybeCell (x ^. resultASState) (\s -> heatC s $ anchorCell asRoute (i18n s :: Widget))
+   in maybeCell (guardOnM (x ^. resultNonAnonymousAccess) $ x ^. resultASState) (\s -> heatC s $ anchorCell asRoute (i18n s :: Widget))
 
 
 filterUICourse :: Handler (OptionList Text) -> DBFilterUI
@@ -364,8 +522,8 @@ filterUIAuthorshipStatementState = flip (prismAForm $ singletonFilter "as-state"
 
 
 makeCorrectionsTable :: ( IsDBTable m x, ToSortable h, Functor h )
-                     => CorrectionTableWhere -> Colonnade h CorrectionTableData (DBCell m x) -> _ -> PSValidator m x -> DBParams m x -> DB (DBResult m x)
+                     => CorrectionTableWhere -> Colonnade h CorrectionTableData (DBCell m x) -> _ -> Maybe CorrectionTableCsvSettings -> PSValidator m x -> DBParams m x -> DB (DBResult m x)
-makeCorrectionsTable whereClause dbtColonnade dbtFilterUI' psValidator dbtParams
+makeCorrectionsTable whereClause dbtColonnade dbtFilterUI' mCSVSettings psValidator dbtParams
   = let dbtSQLQuery = runReaderT $ do
           course <- view queryCourse
           sheet <- view querySheet
@@ -396,12 +554,6 @@ makeCorrectionsTable whereClause dbtColonnade dbtFilterUI' psValidator dbtParams
             let haystack = map CI.mk . unpack $ toPathPiece cid
              in guard $ any (`isInfixOf` haystack) criteria
 
-          mASDefinition <- lift . lift . $cachedHereBinary shId $ getSheetAuthorshipStatement sheet
-          asState <- for mASDefinition $ \_ ->
-            lift . lift . $cachedHereBinary sId $ getSubmissionAuthorshipStatement mASDefinition sId
-
-          forMM_ (preview $ _dbtProjFilter . _corrProjFilterAuthorshipStatementState . _Wrapped . _Just) $ \criterion ->
-            guard $ asState == Just criterion
 
           submittors <- lift . lift . E.select . E.from $ \((submissionUser `E.InnerJoin` user) `E.LeftOuterJoin` pseudonym) -> do
             E.on $ pseudonym E.?. SheetPseudonymUser E.==. E.just (user E.^. UserId)
@@ -416,8 +568,15 @@ makeCorrectionsTable whereClause dbtColonnade dbtFilterUI' psValidator dbtParams
                   return . E.just $ submissionGroup E.^. SubmissionGroupName
 
             return (user, pseudonym E.?. SheetPseudonymPseudonym, submissionGroup')
-          let
+
-            submittorMap = List.foldr (\(Entity userId user, E.Value pseudo, E.Value sGroup) -> Map.insert userId (user, pseudo, sGroup)) Map.empty submittors
+          mASDefinition <- lift . lift . $cachedHereBinary shId $ getSheetAuthorshipStatement sheet
+          (submittorMap, fmap getMax -> asState) <- runWriterT . flip foldMapM submittors $ \(Entity userId user, E.Value pseudo, E.Value sGroup) -> do
+            asState <- for mASDefinition $ \_ -> lift . lift . lift $ getUserAuthorshipStatement mASDefinition sId userId
+            tell $ Max <$> asState
+            return $ Map.singleton userId (user, pseudo, sGroup, asState)
+
+          forMM_ (preview $ _dbtProjFilter . _corrProjFilterAuthorshipStatementState . _Wrapped . _Just) $ \criterion ->
+            guard $ asState == Just criterion
 
           forMM_ (view $ _dbtProjFilter . _corrProjFilterPseudonym) $ \criteria ->
             let haystacks = setOf (folded . resultUserPseudonym . re _PseudonymText . to (map CI.mk . unpack)) submittorMap
@@ -502,7 +661,41 @@ makeCorrectionsTable whereClause dbtColonnade dbtFilterUI' psValidator dbtParams
         dbtFilterUI  = fromMaybe mempty dbtFilterUI'
         dbtStyle     = def { dbsFilterLayout = maybe (\_ _ _ -> id) (const defaultDBSFilterLayout) dbtFilterUI' }
         dbtIdent     = "corrections" :: Text
-        dbtCsvEncode = noCsvEncode
+        dbtCsvEncode = do
+          CorrectionTableCsvSettings{..} <- mCSVSettings
+          return DBTCsvEncode
+            { dbtCsvExportForm = pure ()
+            , dbtCsvNoExportData = Just id
+            , dbtCsvDoEncode = \() -> 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
+                  let guardNonAnonymous = runMaybeT . guardMOnM (view $ _1 . resultNonAnonymousAccess) . MaybeT
+                  yieldM $ CorrectionTableCsv
+                    <$> preview (_1 . resultCourseTerm . _TermId)
+                    <*> preview (_1 . resultCourseSchool . _SchoolId)
+                    <*> preview (_1 . resultCourseShorthand)
+                    <*> preview (_1 . resultSheet . _entityVal . _sheetName)
+                    <*> preview (_1 . resultCryptoID . re (_CI . _PathPiece))
+                    <*> guardNonAnonymous (preview $ _1 . resultLastEdit)
+                    <*> guardNonAnonymous (previews _2 (toListOf $ folded . resultUserUser . _userSurname . re _Just))
+                    <*> guardNonAnonymous (previews _2 (toListOf $ folded . resultUserUser . _userFirstName . re _Just))
+                    <*> guardNonAnonymous (previews _2 (toListOf $ folded . resultUserUser . _userDisplayName . re _Just))
+                    <*> guardNonAnonymous (previews _2 (toListOf $ folded . resultUserUser . _userMatrikelnummer))
+                    <*> guardNonAnonymous (previews _2 (toListOf $ folded . resultUserUser . _userEmail . re _Just))
+                    <*> guardNonAnonymous (previews _2 (toListOf $ folded . pre resultUserPseudonym))
+                    <*> guardNonAnonymous (previews _2 (toListOf $ folded . pre resultUserSubmissionGroup))
+                    <*> guardNonAnonymous (previews _2 (toListOf $ folded . pre resultUserAuthorshipStatementState))
+                    <*> preview (_1 . resultSubmission . _entityVal . _submissionRatingAssigned . _Just)
+                    <*> preview (_1 . resultCorrector . _entityVal . _userDisplayName)
+                    <*> preview (_1 . resultCorrector . _entityVal . _userEmail)
+                    <*> preview (_1 . resultSubmission . _entityVal . to submissionRatingDone)
+                    <*> preview (_1 . resultSubmission . _entityVal . _submissionRatingTime . _Just)
+                    <*> preview (_1 . resultSubmission . _entityVal . _submissionRatingPoints . _Just)
+                    <*> preview (_1 . resultSubmission . _entityVal . _submissionRatingComment . _Just)
+            , dbtCsvName = cTableCsvName, dbtCsvSheetName = cTableCsvSheetName
+            , dbtCsvHeader = \_ -> return $ correctionTableCsvHeader cTableShowCorrector cTableCsvQualification
+            , dbtCsvExampleData = Nothing
+            }
         dbtCsvDecode = Nothing
         dbtExtraReps = []
    in dbTable psValidator DBTable{..}
@@ -524,16 +717,16 @@ data ActionCorrectionsData = CorrDownloadData SubmissionDownloadAnonymous Submis
                            | CorrAutoSetCorrectorData SheetId
                            | CorrDeleteData
 
-correctionsR :: CorrectionTableWhere -> _ -> _ -> _ -> Map ActionCorrections (AForm (HandlerFor UniWorX) ActionCorrectionsData) -> Handler TypedContent
+correctionsR :: CorrectionTableWhere -> _ -> _ -> Maybe CorrectionTableCsvSettings -> _ -> Map ActionCorrections (AForm (HandlerFor UniWorX) ActionCorrectionsData) -> Handler TypedContent
-correctionsR whereClause displayColumns dbtFilterUI psValidator actions = do
+correctionsR whereClause displayColumns dbtFilterUI csvSettings psValidator actions = do
-  (table, statistics) <- correctionsR' whereClause displayColumns dbtFilterUI psValidator actions
+  (table, statistics) <- correctionsR' whereClause displayColumns dbtFilterUI csvSettings psValidator actions
 
   fmap toTypedContent . defaultLayout $ do
     setTitleI MsgCourseCorrectionsTitle
     $(widgetFile "corrections")
   
-correctionsR' :: CorrectionTableWhere -> _ -> _ -> _ -> Map ActionCorrections (AForm (HandlerFor UniWorX) ActionCorrectionsData) -> Handler (Widget, SheetTypeSummary SqlBackendKey)
+correctionsR' :: CorrectionTableWhere -> _ -> _ -> Maybe CorrectionTableCsvSettings -> _ -> Map ActionCorrections (AForm (HandlerFor UniWorX) ActionCorrectionsData) -> Handler (Widget, SheetTypeSummary SqlBackendKey)
-correctionsR' whereClause displayColumns dbtFilterUI psValidator actions = do
+correctionsR' whereClause displayColumns dbtFilterUI csvSettings psValidator actions = do
   currentRoute <- fromMaybe (error "correctionsR called from 404-handler") <$> getCurrentRoute -- This should never be called from a 404 handler
 
   postDeleteR $ \drRecords -> (submissionDeleteRoute drRecords)
@@ -542,7 +735,7 @@ correctionsR' whereClause displayColumns dbtFilterUI psValidator actions = do
     }
 
   ((actionRes', statistics), table) <- runDB $
-    makeCorrectionsTable whereClause displayColumns dbtFilterUI psValidator DBParamsForm
+    makeCorrectionsTable whereClause displayColumns dbtFilterUI csvSettings psValidator DBParamsForm
       { dbParamsFormMethod = POST
       , dbParamsFormAction = Just $ SomeRoute currentRoute
       , dbParamsFormAttrs = []
@@ -682,7 +875,12 @@ restrictAnonymous :: PSValidator m x -> PSValidator m x
 restrictAnonymous = restrictFilter (\k _ -> k /= "user-matriclenumber")
                   . restrictFilter (\k _ -> k /= "user-name-email")
                   . restrictFilter (\k _ -> k /= "submission-group")
+                  . restrictFilter (\k _ -> k /= "as-state")
+                  . restrictSorting (\k _ -> k /= "submittors")
+                  . restrictSorting (\k _ -> k /= "submittors-matriculation")
+                  . restrictSorting (\k _ -> k /= "submittors-group")
                   . restrictSorting (\k _ -> k /= "last-edit")
+                  . restrictSorting (\k _ -> k /= "as-state")
 
 restrictCorrector :: PSValidator m x -> PSValidator m x
 restrictCorrector = restrictFilter (\k _ -> k /= "corrector")
@@ -772,7 +970,14 @@ postCorrectionsR = do
         & restrictAnonymous
         & defaultSorting [SortDescBy "ratingtime", SortAscBy "assignedtime" ]
         & defaultFilter (singletonMap "israted" [toPathPiece False])
-  correctionsR whereClause colonnade filterUI psValidator $ Map.fromList
+
+      csvSettings = Just CorrectionTableCsvSettings
+        { cTableCsvQualification = CorrectionTableCsvQualifyCourse
+        , cTableCsvName = MsgCorrectionTableCsvNameCorrections
+        , cTableCsvSheetName = MsgCorrectionTableCsvSheetNameCorrections
+        , cTableShowCorrector = False
+        }
+  correctionsR whereClause colonnade filterUI csvSettings psValidator $ Map.fromList
     [ downloadAction
     ]
 
@@ -817,7 +1022,13 @@ postCCorrectionsR tid ssh csh = do
         , filterUISubmission
         ]
       psValidator = def & defaultPagesize PagesizeAll -- Assisstant always want to see them all at once anyway
-  correctionsR whereClause colonnade filterUI psValidator $ Map.fromList
+      csvSettings = Just CorrectionTableCsvSettings
+        { cTableCsvQualification = CorrectionTableCsvQualifySheet
+        , cTableCsvName = MsgCorrectionTableCsvNameCourseCorrections tid ssh csh
+        , cTableCsvSheetName = MsgCorrectionTableCsvSheetNameCourseCorrections tid ssh csh
+        , cTableShowCorrector = True
+        }
+  correctionsR whereClause colonnade filterUI csvSettings psValidator $ Map.fromList
     [ downloadAction
     , assignAction (Left cid)
     , deleteAction
@@ -858,7 +1069,13 @@ postSSubsR tid ssh csh shn = do
         , filterUISubmission
         ]
       psValidator = def & defaultPagesize PagesizeAll -- Assisstant always want to see them all at once anyway
-  correctionsR whereClause colonnade filterUI psValidator $ Map.fromList
+      csvSettings = Just CorrectionTableCsvSettings
+        { cTableCsvQualification = CorrectionTableCsvNoQualification
+        , cTableCsvName = MsgCorrectionTableCsvNameSheetCorrections tid ssh csh shn
+        , cTableCsvSheetName = MsgCorrectionTableCsvSheetNameSheetCorrections tid ssh csh shn
+        , cTableShowCorrector = True
+        }
+  correctionsR whereClause colonnade filterUI csvSettings psValidator $ Map.fromList
     [ downloadAction
     , assignAction (Right shid)
     , autoAssignAction shid

src/Handler/Utils/StudyFeatures.hs

@@ -22,8 +22,6 @@ import Handler.Utils.StudyFeatures.Parse
 
 import qualified Data.Csv as Csv
 
-import qualified Data.ByteString as ByteString
-
 import qualified Data.Set as Set
 
 import Data.RFC5051 (compareUnicode)
@@ -65,7 +63,7 @@ instance Csv.ToField UserTableStudyFeature where
             [] $ ShortStudyFieldType userTableFieldType
 
 instance Csv.ToField UserTableStudyFeatures where
-  toField = ByteString.intercalate "; " . map Csv.toField . view _UserTableStudyFeatures
+  toField = Csv.toField . CsvSemicolonList . view _UserTableStudyFeatures
 
 userTableStudyFeatureSort :: UserTableStudyFeature
                           -> UserTableStudyFeature

src/Handler/Utils/Submission.hs

@@ -981,20 +981,6 @@ correctionInvisibleWidget tid ssh csh shn cID (Entity subId sub) = runMaybeT $ d
   return $ notification NotificationBroad =<< messageIconWidget Warning IconInvisible $(widgetFile "submission-correction-invisible")
 
 
-data AuthorshipStatementSubmissionState
-  = ASMissing
-  | ASOldStatement
-  | ASExists
-  deriving (Eq, Read, Show, Enum, Bounded, Generic, Typeable)
-  deriving anyclass (Universe, Finite)
-
-deriving stock instance Ord AuthorshipStatementSubmissionState -- ^ Larger roughly encodes better; summaries are taken with `max`
-
-nullaryPathPiece ''AuthorshipStatementSubmissionState $ camelToPathPiece' 1
-
-embedRenderMessage ''UniWorX ''AuthorshipStatementSubmissionState $ concat . ("SubmissionAuthorshipStatementState" :) . drop 1 . splitCamel
-
-
 getUserAuthorshipStatement :: ( MonadResource m
                               , IsSqlBackend backend, SqlBackendCanRead backend
                               )

src/Model/Types/DateTime.hs

@@ -133,6 +133,8 @@ instance ToJSON TermIdentifier where
 instance FromJSON TermIdentifier where
   parseJSON = withText "Term" $ either (fail . Text.unpack) return . termFromText
 
+pathPieceCsv ''TermIdentifier
+
 {- Must be defined in a later module:
     termField :: Field (HandlerT UniWorX IO) TermIdentifier
     termField = checkMMap (return . termFromText) termToText textField

src/Model/Types/Submission.hs

@@ -130,3 +130,26 @@ pseudonymWords = folding
 pseudonymFragments :: Fold Text [PseudonymWord]
 pseudonymFragments = folding
   $ mapM (toListOf pseudonymWords) . (\l -> guard (length l == 2) *> l) . filter (not . null) . Text.split (\(CI.mk -> c) -> not $ Set.member c pseudonymCharacters)
+
+
+instance PathPiece Pseudonym where
+  toPathPiece = review _PseudonymText
+  fromPathPiece t
+    | Just p <- t ^? _PseudonymText = Just p
+    | Just n <- fromPathPiece t = Just $ Pseudonym n
+    | otherwise = Nothing
+
+pathPieceCsv ''Pseudonym
+
+  
+data AuthorshipStatementSubmissionState
+  = ASMissing
+  | ASOldStatement
+  | ASExists
+  deriving (Eq, Read, Show, Enum, Bounded, Generic, Typeable)
+  deriving anyclass (Universe, Finite)
+
+deriving stock instance Ord AuthorshipStatementSubmissionState -- ^ Larger roughly encodes better; summaries are taken with `max`
+
+nullaryPathPiece ''AuthorshipStatementSubmissionState $ camelToPathPiece' 1
+pathPieceCsv ''AuthorshipStatementSubmissionState

src/Utils/Csv.hs

@@ -10,6 +10,7 @@ module Utils.Csv
   , toCsvRendered
   , toDefaultOrderedCsvRendered
   , csvRenderedToXlsx, Xlsx, Xlsx.fromXlsx
+  , CsvSemicolonList(..)
   ) where
 
 import ClassyPrelude hiding (lookup)
@@ -39,6 +40,19 @@ import qualified Data.Text as Text
 import qualified Data.Text.Encoding as Text
 import qualified Data.CaseInsensitive as CI
 
+import qualified Data.Binary.Builder as Builder
+import qualified Data.ByteString.Lazy as LBS
+import qualified Data.Attoparsec.ByteString as Attoparsec
+
+import qualified Data.Csv.Parser as Csv
+import qualified Data.Csv.Builder as Csv
+
+import qualified Data.Vector as Vector
+
+import Data.Char (ord)
+
+import Control.Monad.Fail
+
 
 deriving instance Typeable CsvParseError
 instance Exception CsvParseError
@@ -114,3 +128,25 @@ csvRenderedToXlsx sheetName CsvRendered{..} = def & Xlsx.atSheet sheetName ?~ (d
     addValues = flip foldMap (zip [2..] csvRenderedData) $ \(r, nr) -> flip foldMap (zip [1..] $ toList csvRenderedHeader) $ \(c, hBS) -> case HashMap.lookup hBS nr of
       Nothing -> mempty
       Just vBS -> Endo $ Xlsx.cellValueAtRC (r, c) ?~ Xlsx.CellText (decodeUtf8 vBS)
+
+
+newtype CsvSemicolonList a = CsvSemicolonList { unCsvSemicolonList :: [a] }
+  deriving stock (Read, Show, Generic, Typeable)
+  deriving newtype (Eq, Ord)
+
+instance ToField a => ToField (CsvSemicolonList a) where
+  toField (CsvSemicolonList xs) = dropEnd 2 . LBS.toStrict . Builder.toLazyByteString $ Csv.encodeRecordWith encOpts fs
+    where
+      fs = map toField xs
+      encOpts = defaultEncodeOptions
+        { encDelimiter = fromIntegral $ ord ';'
+        , encQuoting = bool QuoteMinimal QuoteAll $ all null fs
+        , encUseCrLf = True
+        }
+
+instance FromField a => FromField (CsvSemicolonList a) where
+  parseField f
+    | null f = pure $ CsvSemicolonList []
+    | otherwise = fmap CsvSemicolonList . mapM parseField . Vector.toList <=< either fail return $ Attoparsec.parseOnly (Csv.record sep) f
+    where
+      sep = fromIntegral $ ord ';'

templates/i18n/changelog/corrections-csv-export.de-de-formal.hamlet

@@ -0,0 +1,2 @@
+$newline never
+Tabellen von Übungsblattabgaben können nun als CSV exportiert werden

templates/i18n/changelog/corrections-csv-export.en-eu.hamlet

@@ -0,0 +1,2 @@
+$newline never
+Tables of exercise sheet submissions can now be exported as CSV

test/Data/Scientific/InstancesSpec.hs

@@ -0,0 +1,10 @@
+module Data.Scientific.InstancesSpec where
+
+import TestImport
+import Data.Scientific
+
+
+spec :: Spec
+spec = modifyMaxSuccess (* 10) $
+  lawsCheckHspec (Proxy @Scientific)
+    [ pathPieceLaws ]

test/Utils/CsvSpec.hs

@@ -0,0 +1,38 @@
+module Utils.CsvSpec where
+
+import TestImport
+
+import Utils.Csv
+
+import Data.Csv (toField, runParser, parseField)
+
+import Data.Char (ord)
+import qualified Data.ByteString as BS
+
+
+deriving newtype instance Arbitrary a => Arbitrary (CsvSemicolonList a)
+  
+
+spec :: Spec
+spec = modifyMaxSuccess (* 10) . parallel $ do
+  lawsCheckHspec (Proxy @(CsvSemicolonList ByteString))
+    [ csvFieldLaws ]
+  describe "CsvSemicolonList" $ do
+    let
+      test :: [ByteString] -> ByteString -> Expectation
+      test (CsvSemicolonList -> x) t = do
+        toField x `shouldBe` t
+        runParser (parseField t) `shouldBe` Right x
+    it "is transparent" . property $ \(bs :: ByteString)
+      -> let expectTransparent = BS.all (`notElem` [34, 10, 13, fromIntegral $ ord ';']) bs
+                              && not (BS.null bs)
+          in expectTransparent ==> test [bs] bs
+    it "behaves as expected on some examples" $ do
+      test ["foo"] "foo"
+      test ["foo", "bar"] "foo;bar"
+      test [] ""
+      test [""] "\"\""
+      test ["", ""] "\"\";\"\""
+      test ["foo", ""] "foo;"
+      test ["", "foo"] ";foo"
+      test ["", "", "foo", ""] ";;foo;"