fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

feat(corrections-r): json export

Browse Source
This commit is contained in:
Gregor Kleen 2021-08-18 19:00:12 +02:00
parent 2a6248e3d5
commit fe8e4bbd4f
2 changed files with 74 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

75
src/Handler/Submission/List.hs
View File

@ -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

1
src/Model/Types/Submission.hs
View File

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