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

feat(exams): csv-export exercise data

Browse Source
This commit is contained in:
Gregor Kleen 2019-07-16 11:45:21 +02:00
parent cf040ce686
commit 2218103cbd
2 changed files with 36 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
src/Data/Fixed/Instances.hs
View File

@ -9,5 +9,18 @@ import Data.Fixed
import Text.Blaze (ToMarkup(..)) import Text.Blaze (ToMarkup(..))
import qualified Data.Csv as Csv
import Data.Proxy (Proxy(..))
import Data.Scientific
instance HasResolution a => ToMarkup (Fixed a) where 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

32
src/Handler/Exam.hs
View File

@ -34,6 +34,8 @@ import qualified Data.Csv as Csv
import qualified Data.Conduit.List as C import qualified Data.Conduit.List as C
import Numeric.Lens (integral)
getCExamListR :: TermId -> SchoolId -> CourseShorthand -> Handler Html getCExamListR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
getCExamListR tid ssh csh = do getCExamListR tid ssh csh = do
@ -806,18 +808,22 @@ resultExamOccurrence :: Traversal' ExamUserTableData (Entity ExamOccurrence)
resultExamOccurrence = _dbrOutput . _3 . _Just resultExamOccurrence = _dbrOutput . _3 . _Just
data ExamUserTableCsv = ExamUserTableCsv data ExamUserTableCsv = ExamUserTableCsv
{ csvUserSurname :: Text { csvEUserSurname :: Maybe Text
, csvUserName :: Text , csvEUserName :: Maybe Text
, csvUserMatriculation :: Maybe Text , csvEUserMatriculation :: Maybe Text
, csvUserField :: Maybe Text , csvEUserField :: Maybe Text
, csvUserDegree :: Maybe Text , csvEUserDegree :: Maybe Text
, csvUserSemester :: Maybe Int , csvEUserSemester :: Maybe Int
, csvUserOccurrence :: Maybe (CI Text) , csvEUserOccurrence :: Maybe (CI Text)
, csvEUserExercisePoints, csvEUserExercisePassPoints :: Maybe Points
, csvEUserExercisePasses :: Maybe Int
, csvEUserExercisePointsMax, csvEUserExercisePassPointsMax :: Maybe Points
, csvEUserExercisePassesMax :: Maybe Int
} }
deriving (Generic) deriving (Generic)
examUserTableCsvOptions :: Csv.Options examUserTableCsvOptions :: Csv.Options
examUserTableCsvOptions = Csv.defaultOptions { Csv.fieldLabelModifier = camelToPathPiece' 1 } examUserTableCsvOptions = Csv.defaultOptions { Csv.fieldLabelModifier = camelToPathPiece' 3 }
instance ToNamedRecord ExamUserTableCsv where instance ToNamedRecord ExamUserTableCsv where
toNamedRecord = Csv.genericToNamedRecord examUserTableCsvOptions toNamedRecord = Csv.genericToNamedRecord examUserTableCsvOptions
@ -909,13 +915,19 @@ postEUsersR tid ssh csh examn = do
dbtIdent = "exam-users" dbtIdent = "exam-users"
dbtCsvEncode :: DBTCsvEncode ExamUserTableData ExamUserTableCsv dbtCsvEncode :: DBTCsvEncode ExamUserTableData ExamUserTableCsv
dbtCsvEncode = DictJust . C.map $ ExamUserTableCsv dbtCsvEncode = DictJust . C.map $ ExamUserTableCsv
<$> view (resultUser . _entityVal . _userSurname) <$> view (resultUser . _entityVal . _userSurname . to Just)
<*> view (resultUser . _entityVal . _userDisplayName) <*> view (resultUser . _entityVal . _userDisplayName . to Just)
<*> view (resultUser . _entityVal . _userMatrikelnummer) <*> view (resultUser . _entityVal . _userMatrikelnummer)
<*> preview (resultStudyField . _entityVal . to (\StudyTerms{..} -> studyTermsName <|> studyTermsShorthand <|> Just (tshow studyTermsKey)) . _Just) <*> preview (resultStudyField . _entityVal . to (\StudyTerms{..} -> studyTermsName <|> studyTermsShorthand <|> Just (tshow studyTermsKey)) . _Just)
<*> preview (resultStudyDegree . _entityVal . to (\StudyDegree{..} -> studyDegreeName <|> studyDegreeShorthand <|> Just (tshow studyDegreeKey)) . _Just) <*> preview (resultStudyDegree . _entityVal . to (\StudyDegree{..} -> studyDegreeName <|> studyDegreeShorthand <|> Just (tshow studyDegreeKey)) . _Just)
<*> preview (resultStudyFeatures . _entityVal . _studyFeaturesSemester) <*> preview (resultStudyFeatures . _entityVal . _studyFeaturesSemester)
<*> preview (resultExamOccurrence . _entityVal . _examOccurrenceName) <*> 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 dbtCsvDecode = Nothing
examUsersDBTableValidator = def examUsersDBTableValidator = def