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

fix(csv exam import): ignore unchanged noshow and voided

Browse Source 
noshow and voided are now independent of whether the exam is graded or
pass and fail only
This commit is contained in:
Steffen Jost 2019-08-22 10:29:49 +02:00
parent 3881f3a71d
commit a346524073
3 changed files with 20 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
src/Foundation.hs
View File

@ -369,6 +369,11 @@ instance RenderMessage UniWorX a => RenderMessage UniWorX (ExamResult' a) where
mr :: RenderMessage UniWorX msg => msg -> Text mr :: RenderMessage UniWorX msg => msg -> Text
mr = renderMessage foundation ls mr = renderMessage foundation ls
instance RenderMessage UniWorX (Either ExamPassed ExamGrade) where
renderMessage foundation ls = either mr mr
where
mr :: RenderMessage UniWorX msg => msg -> Text
mr = renderMessage foundation ls
-- ToMessage instances for converting raw numbers to Text (no internationalization) -- ToMessage instances for converting raw numbers to Text (no internationalization)

18
src/Handler/Exam/Users.hs
View File

@ -109,7 +109,7 @@ data ExamUserTableCsv = ExamUserTableCsv
, csvEUserExerciseNumPasses :: Maybe Int , csvEUserExerciseNumPasses :: Maybe Int
, csvEUserExercisePointsMax :: Maybe Points , csvEUserExercisePointsMax :: Maybe Points
, csvEUserExerciseNumPassesMax :: Maybe Int , csvEUserExerciseNumPassesMax :: Maybe Int
, csvEUserExamResult :: Maybe (Either ExamResultPassed ExamResultGrade) , csvEUserExamResult :: Maybe ExamResultPassedGrade
, csvEUserCourseNote :: Maybe Html , csvEUserCourseNote :: Maybe Html
} }
deriving (Generic) deriving (Generic)
@ -209,7 +209,7 @@ data ExamUserCsvAction
} }
| ExamUserCsvSetResultData | ExamUserCsvSetResultData
{ examUserCsvActUser :: UserId { examUserCsvActUser :: UserId
, examUserCsvActExamResult :: Maybe (Either ExamResultPassed ExamResultGrade) , examUserCsvActExamResult :: Maybe ExamResultPassedGrade
} }
| ExamUserCsvSetCourseNoteData | ExamUserCsvSetCourseNoteData
{ examUserCsvActUser :: UserId { examUserCsvActUser :: UserId
@ -244,8 +244,8 @@ postEUsersR tid ssh csh examn = do
showPasses = numSheetsPasses allBoni /= 0 showPasses = numSheetsPasses allBoni /= 0
showPoints = getSum (numSheetsPoints allBoni) /= 0 showPoints = getSum (numSheetsPoints allBoni) /= 0
resultView :: ExamResultGrade -> Either ExamResultPassed ExamResultGrade resultView :: ExamResultGrade -> ExamResultPassedGrade
resultView = bool (Left . over _examResult (view passingGrade)) Right examShowGrades resultView = fmap $ bool (Left . view passingGrade) Right examShowGrades
let let
examUsersDBTable = DBTable{..} examUsersDBTable = DBTable{..}
@ -471,7 +471,7 @@ postEUsersR tid ssh csh examn = do
deleteBy $ UniqueExamResult eid examUserCsvActUser deleteBy $ UniqueExamResult eid examUserCsvActUser
audit $ TransactionExamResultDeleted eid examUserCsvActUser audit $ TransactionExamResultDeleted eid examUserCsvActUser
Just res -> do Just res -> do
let res' = either (over _examResult $ review passingGrade) id res let res' = either (review passingGrade) id <$> res
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
void $ upsertBy void $ upsertBy
(UniqueExamResult eid examUserCsvActUser) (UniqueExamResult eid examUserCsvActUser)
@ -550,11 +550,7 @@ postEUsersR tid ssh csh examn = do
$newline never $newline never
^{nameWidget userDisplayName userSurname} ^{nameWidget userDisplayName userSurname}
$maybe newResult <- examUserCsvActExamResult $maybe newResult <- examUserCsvActExamResult
$case newResult , _{newResult}
$of Left pResult
, _{pResult}
$of Right gResult
, _{gResult}
$nothing $nothing
, _{MsgExamResultNone} , _{MsgExamResultNone}
|] |]
@ -643,8 +639,6 @@ postEUsersR tid ssh csh examn = do
] ]
E.where_ $ studyFeatures E.^. StudyFeaturesUser E.==. E.val uid E.where_ $ studyFeatures E.^. StudyFeaturesUser E.==. E.val uid
let isActive = studyFeatures E.^. StudyFeaturesValid E.==. E.val True let isActive = studyFeatures E.^. StudyFeaturesValid E.==. E.val True
-- isActiveOrPrevious = maybe isActive (\Entity sfid _ -> isActive E.||. (studyFeatures E.^. StudyFeaturesId E.==. E.val sfid)) oldFeatures -- one line, but obfuscates the `or else` structure
-- isActiveOrPrevious = isActive E.||. $ maybe (E.val False) (\Entity sfid _ -> (studyFeatures E.^. StudyFeaturesId E.==. E.val sfid)) oldFeatures -- meh
isActiveOrPrevious = case oldFeatures of isActiveOrPrevious = case oldFeatures of
Just (Entity _ CourseParticipant{courseParticipantField = Just sfid}) Just (Entity _ CourseParticipant{courseParticipantField = Just sfid})
-> isActive E.||. (E.val sfid E.==. studyFeatures E.^. StudyFeaturesId) -> isActive E.||. (E.val sfid E.==. studyFeatures E.^. StudyFeaturesId)

6
src/Model/Types/Exam.hs
View File

@ -217,8 +217,10 @@ type ExamResultPoints = ExamResult' Points
type ExamResultGrade = ExamResult' ExamGrade type ExamResultGrade = ExamResult' ExamGrade
type ExamResultPassed = ExamResult' ExamPassed type ExamResultPassed = ExamResult' ExamPassed
instance Csv.ToField (Either ExamResultPassed ExamResultGrade) where type ExamResultPassedGrade = ExamResult' (Either ExamPassed ExamGrade)
instance Csv.ToField (Either ExamPassed ExamGrade) where
toField = either Csv.toField Csv.toField toField = either Csv.toField Csv.toField
instance Csv.FromField (Either ExamResultPassed ExamResultGrade) where instance Csv.FromField (Either ExamPassed ExamGrade) where
parseField x = (Left <$> Csv.parseField x) <|> (Right <$> Csv.parseField x) -- encodings are disjoint parseField x = (Left <$> Csv.parseField x) <|> (Right <$> Csv.parseField x) -- encodings are disjoint