feat(exams): csv-export exercise data
This commit is contained in:
parent
cf040ce686
commit
2218103cbd
@ -9,5 +9,18 @@ import Data.Fixed
|
||||
|
||||
import Text.Blaze (ToMarkup(..))
|
||||
|
||||
import qualified Data.Csv as Csv
|
||||
|
||||
import Data.Proxy (Proxy(..))
|
||||
|
||||
import Data.Scientific
|
||||
|
||||
|
||||
instance HasResolution a => ToMarkup (Fixed a) where
|
||||
toMarkup = toMarkup . showFixed True
|
||||
toMarkup = toMarkup . showFixed True
|
||||
|
||||
|
||||
instance HasResolution a => Csv.ToField (Fixed a) where
|
||||
toField = Csv.toField . (realToFrac :: Fixed a -> Scientific)
|
||||
instance HasResolution a => Csv.FromField (Fixed a) where
|
||||
parseField = fmap (MkFixed . (round :: Scientific -> Integer) . (* fromInteger (resolution $ Proxy @a))) . Csv.parseField
|
||||
|
||||
@ -34,6 +34,8 @@ import qualified Data.Csv as Csv
|
||||
|
||||
import qualified Data.Conduit.List as C
|
||||
|
||||
import Numeric.Lens (integral)
|
||||
|
||||
|
||||
getCExamListR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
|
||||
getCExamListR tid ssh csh = do
|
||||
@ -806,18 +808,22 @@ resultExamOccurrence :: Traversal' ExamUserTableData (Entity ExamOccurrence)
|
||||
resultExamOccurrence = _dbrOutput . _3 . _Just
|
||||
|
||||
data ExamUserTableCsv = ExamUserTableCsv
|
||||
{ csvUserSurname :: Text
|
||||
, csvUserName :: Text
|
||||
, csvUserMatriculation :: Maybe Text
|
||||
, csvUserField :: Maybe Text
|
||||
, csvUserDegree :: Maybe Text
|
||||
, csvUserSemester :: Maybe Int
|
||||
, csvUserOccurrence :: Maybe (CI Text)
|
||||
{ csvEUserSurname :: Maybe Text
|
||||
, csvEUserName :: Maybe Text
|
||||
, csvEUserMatriculation :: Maybe Text
|
||||
, csvEUserField :: Maybe Text
|
||||
, csvEUserDegree :: Maybe Text
|
||||
, csvEUserSemester :: Maybe Int
|
||||
, csvEUserOccurrence :: Maybe (CI Text)
|
||||
, csvEUserExercisePoints, csvEUserExercisePassPoints :: Maybe Points
|
||||
, csvEUserExercisePasses :: Maybe Int
|
||||
, csvEUserExercisePointsMax, csvEUserExercisePassPointsMax :: Maybe Points
|
||||
, csvEUserExercisePassesMax :: Maybe Int
|
||||
}
|
||||
deriving (Generic)
|
||||
|
||||
examUserTableCsvOptions :: Csv.Options
|
||||
examUserTableCsvOptions = Csv.defaultOptions { Csv.fieldLabelModifier = camelToPathPiece' 1 }
|
||||
examUserTableCsvOptions = Csv.defaultOptions { Csv.fieldLabelModifier = camelToPathPiece' 3 }
|
||||
|
||||
instance ToNamedRecord ExamUserTableCsv where
|
||||
toNamedRecord = Csv.genericToNamedRecord examUserTableCsvOptions
|
||||
@ -909,13 +915,19 @@ postEUsersR tid ssh csh examn = do
|
||||
dbtIdent = "exam-users"
|
||||
dbtCsvEncode :: DBTCsvEncode ExamUserTableData ExamUserTableCsv
|
||||
dbtCsvEncode = DictJust . C.map $ ExamUserTableCsv
|
||||
<$> view (resultUser . _entityVal . _userSurname)
|
||||
<*> view (resultUser . _entityVal . _userDisplayName)
|
||||
<$> view (resultUser . _entityVal . _userSurname . to Just)
|
||||
<*> view (resultUser . _entityVal . _userDisplayName . to Just)
|
||||
<*> view (resultUser . _entityVal . _userMatrikelnummer)
|
||||
<*> preview (resultStudyField . _entityVal . to (\StudyTerms{..} -> studyTermsName <|> studyTermsShorthand <|> Just (tshow studyTermsKey)) . _Just)
|
||||
<*> preview (resultStudyDegree . _entityVal . to (\StudyDegree{..} -> studyDegreeName <|> studyDegreeShorthand <|> Just (tshow studyDegreeKey)) . _Just)
|
||||
<*> preview (resultStudyFeatures . _entityVal . _studyFeaturesSemester)
|
||||
<*> preview (resultExamOccurrence . _entityVal . _examOccurrenceName)
|
||||
<*> preview (resultUser . _entityKey . to (examBonusAchieved ?? bonus) . _Just . _achievedPoints . _Wrapped)
|
||||
<*> preview (resultUser . _entityKey . to (examBonusAchieved ?? bonus) . _Just . _achievedPassPoints . _Wrapped)
|
||||
<*> preview (resultUser . _entityKey . to (examBonusAchieved ?? bonus) . _Just . _achievedPasses . _Wrapped . integral)
|
||||
<*> preview (resultUser . _entityKey . to (examBonusPossible ?? bonus) . _Just . _sumSheetsPoints . _Wrapped)
|
||||
<*> preview (resultUser . _entityKey . to (examBonusPossible ?? bonus) . _Just . _sumSheetsPassPoints . _Wrapped)
|
||||
<*> preview (resultUser . _entityKey . to (examBonusPossible ?? bonus) . _Just . _numSheetsPasses . _Wrapped . integral)
|
||||
dbtCsvDecode = Nothing
|
||||
|
||||
examUsersDBTableValidator = def
|
||||
|
||||
Loading…
Reference in New Issue
Block a user