feat(corrections-r): json export

src/Handler/Submission/List.hs

@@ -302,6 +302,40 @@ data CorrectionTableCsvSettings = forall filename sheetName.
   , cTableShowCorrector :: Bool
   }
 
+data CorrectionTableJson = CorrectionTableJson
+  { jsonCorrectionTerm :: TermIdentifier
+  , jsonCorrectionSchool :: SchoolShorthand
+  , jsonCorrectionCourse :: CourseShorthand
+  , jsonCorrectionSheet :: SheetName
+  , jsonCorrectionLastEdit :: Maybe UTCTime
+  , jsonCorrectionSubmittors :: Maybe [CorrectionTableSubmittorJson]
+  , jsonCorrectionAssigned :: Maybe UTCTime
+  , jsonCorrectionCorrectorName :: Maybe UserDisplayName
+  , jsonCorrectionCorrectorEmail :: Maybe UserEmail
+  , jsonCorrectionRatingDone :: Bool
+  , jsonCorrectionRatedAt :: Maybe UTCTime
+  , jsonCorrectionRatingPoints :: Maybe Points
+  , jsonCorrectionRatingComment :: Maybe Text
+  } deriving (Generic)
+
+data CorrectionTableSubmittorJson = CorrectionTableSubmittorJson
+  { jsonCorrectionSurname :: UserSurname
+  , jsonCorrectionFirstName :: UserFirstName
+  , jsonCorrectionName :: UserDisplayName
+  , jsonCorrectionMatriculation :: Maybe UserMatriculation
+  , jsonCorrectionEmail :: UserEmail
+  , jsonCorrectionPseudonym :: Maybe Pseudonym
+  , jsonCorrectionSubmissionGroup :: Maybe SubmissionGroupName
+  , jsonCorrectionAuthorshipStatementState :: Maybe AuthorshipStatementSubmissionState
+  } deriving (Generic)
+
+deriveToJSON defaultOptions
+  { fieldLabelModifier = camelToPathPiece' 2
+  } ''CorrectionTableSubmittorJson
+
+deriveToJSON defaultOptions
+  { fieldLabelModifier = camelToPathPiece' 2
+  } ''CorrectionTableJson
 
 -- Where Clauses
 ratedBy :: UserId -> CorrectionTableWhere
@@ -667,7 +701,7 @@ makeCorrectionsTable whereClause dbtColonnade dbtFilterUI' mCSVSettings psValida
             { dbtCsvExportForm = pure ()
             , dbtCsvNoExportData = Just id
             , dbtCsvDoEncode = \() -> awaitForever $ \(_, row) -> runReaderC row $ do
-                submittors <- asks $ sortOn (view $ resultUserUser . $(multifocusG 2) _userSurname _userDisplayName ) . toListOf resultSubmittors
+                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
@@ -697,7 +731,44 @@ makeCorrectionsTable whereClause dbtColonnade dbtFilterUI' mCSVSettings psValida
             , dbtCsvExampleData = Nothing
             }
         dbtCsvDecode = Nothing
-        dbtExtraReps = []
+        dbtExtraReps =
+          [ DBTExtraRep $ toPrettyJSON <$> repCorrectionJson, DBTExtraRep $ toYAML <$> repCorrectionJson
+          ]
+
+        repCorrectionJson :: ConduitT (E.Value SubmissionId, CorrectionTableData) Void DB (Map CryptoFileNameSubmission CorrectionTableJson)
+        repCorrectionJson = C.foldMap $ \(_, res) -> Map.singleton (res ^. resultCryptoID) $ mkCorrectionTableJson res
+          where
+            mkCorrectionTableJson :: CorrectionTableData -> CorrectionTableJson
+            mkCorrectionTableJson res' = flip runReader res' $ do
+              let guardNonAnonymous :: Reader CorrectionTableData (Maybe a) -> Reader CorrectionTableData (Maybe a)
+                  guardNonAnonymous = runMaybeT . guardMOnM (view resultNonAnonymousAccess) . MaybeT
+                  mkCorrectionTableSubmittorJson :: Reader CorrectionTableData (Maybe [CorrectionTableSubmittorJson])
+                  mkCorrectionTableSubmittorJson = Just <$> do
+                    submittors <- asks $ sortOn (view $ resultUserUser . $(multifocusG 2) _userSurname _userDisplayName) . toListOf resultSubmittors
+                    forM submittors $ \submittor -> lift . flip runReaderT submittor $
+                      CorrectionTableSubmittorJson
+                        <$> view (resultUserUser . _userSurname)
+                        <*> view (resultUserUser . _userFirstName)
+                        <*> view (resultUserUser . _userDisplayName)
+                        <*> view (resultUserUser . _userMatrikelnummer)
+                        <*> view (resultUserUser . _userEmail)
+                        <*> preview resultUserPseudonym
+                        <*> preview resultUserSubmissionGroup
+                        <*> preview resultUserAuthorshipStatementState
+              CorrectionTableJson
+                <$> view (resultCourseTerm . _TermId)
+                <*> view (resultCourseSchool . _SchoolId)
+                <*> view resultCourseShorthand
+                <*> view (resultSheet . _entityVal . _sheetName)
+                <*> guardNonAnonymous (preview resultLastEdit)
+                <*> guardNonAnonymous mkCorrectionTableSubmittorJson
+                <*> preview (resultSubmission . _entityVal . _submissionRatingAssigned . _Just)
+                <*> preview (resultCorrector . _entityVal . _userDisplayName)
+                <*> preview (resultCorrector . _entityVal . _userEmail)
+                <*> view (resultSubmission . _entityVal . to submissionRatingDone)
+                <*> preview (resultSubmission . _entityVal . _submissionRatingTime . _Just)
+                <*> preview (resultSubmission . _entityVal . _submissionRatingPoints . _Just)
+                <*> preview (resultSubmission . _entityVal . _submissionRatingComment . _Just)
    in dbTable psValidator DBTable{..}
 
 data ActionCorrections = CorrDownload

src/Model/Types/Submission.hs

@@ -153,3 +153,4 @@ deriving stock instance Ord AuthorshipStatementSubmissionState -- ^ Larger rough
 
 nullaryPathPiece ''AuthorshipStatementSubmissionState $ camelToPathPiece' 1
 pathPieceCsv ''AuthorshipStatementSubmissionState
+pathPieceJSON ''AuthorshipStatementSubmissionState