fix(csv exam import): ignore unchanged noshow and voided
noshow and voided are now independent of whether the exam is graded or pass and fail only
This commit is contained in:
Steffen Jost
parent
3881f3a71d
commit
a346524073
@ -369,6 +369,11 @@ instance RenderMessage UniWorX a => RenderMessage UniWorX (ExamResult' a) where
|
||||
mr :: RenderMessage UniWorX msg => msg -> Text
|
||||
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)
|
||||
|
||||
@ -759,7 +764,7 @@ tagAccessPredicate AuthTime = APDB $ \mAuthId route _ -> case route of
|
||||
guard $ NTop (Just cTime) <= NTop allocationStaffAllocationTo
|
||||
|
||||
return Authorized
|
||||
|
||||
|
||||
CExamR tid ssh csh examn subRoute -> maybeT (unauthorizedI MsgUnauthorizedExamTime) $ do
|
||||
course <- $cachedHereBinary (tid, ssh, csh) . MaybeT . getKeyBy $ TermSchoolCourseShort tid ssh csh
|
||||
Entity eId Exam{..} <- $cachedHereBinary (course, examn) . MaybeT . getBy $ UniqueExam course examn
|
||||
@ -872,7 +877,7 @@ tagAccessPredicate AuthTime = APDB $ \mAuthId route _ -> case route of
|
||||
AllocationR tid ssh ash _ -> maybeT (unauthorizedI MsgUnauthorizedAllocationRegisterTime) $ do
|
||||
-- Checks `registerFrom` and `registerTo`, override as further routes become available
|
||||
now <- liftIO getCurrentTime
|
||||
Entity _ Allocation{..} <- MaybeT . $cachedHereBinary (tid, ssh, ash) . getBy $ TermSchoolAllocationShort tid ssh ash
|
||||
Entity _ Allocation{..} <- MaybeT . $cachedHereBinary (tid, ssh, ash) . getBy $ TermSchoolAllocationShort tid ssh ash
|
||||
guard $ NTop allocationRegisterFrom <= NTop (Just now)
|
||||
guard $ NTop (Just now) <= NTop allocationRegisterTo
|
||||
return Authorized
|
||||
@ -890,7 +895,7 @@ tagAccessPredicate AuthStaffTime = APDB $ \_ route _ -> case route of
|
||||
AllocationR tid ssh ash _ -> maybeT (unauthorizedI MsgUnauthorizedAllocationRegisterTime) $ do
|
||||
-- Checks `registerFrom` and `registerTo`, override as further routes become available
|
||||
now <- liftIO getCurrentTime
|
||||
Entity _ Allocation{..} <- MaybeT . $cachedHereBinary (tid, ssh, ash) . getBy $ TermSchoolAllocationShort tid ssh ash
|
||||
Entity _ Allocation{..} <- MaybeT . $cachedHereBinary (tid, ssh, ash) . getBy $ TermSchoolAllocationShort tid ssh ash
|
||||
guard $ NTop allocationStaffAllocationFrom <= NTop (Just now)
|
||||
guard $ NTop (Just now) <= NTop allocationStaffAllocationTo
|
||||
return Authorized
|
||||
|
||||
@ -109,7 +109,7 @@ data ExamUserTableCsv = ExamUserTableCsv
|
||||
, csvEUserExerciseNumPasses :: Maybe Int
|
||||
, csvEUserExercisePointsMax :: Maybe Points
|
||||
, csvEUserExerciseNumPassesMax :: Maybe Int
|
||||
, csvEUserExamResult :: Maybe (Either ExamResultPassed ExamResultGrade)
|
||||
, csvEUserExamResult :: Maybe ExamResultPassedGrade
|
||||
, csvEUserCourseNote :: Maybe Html
|
||||
}
|
||||
deriving (Generic)
|
||||
@ -209,7 +209,7 @@ data ExamUserCsvAction
|
||||
}
|
||||
| ExamUserCsvSetResultData
|
||||
{ examUserCsvActUser :: UserId
|
||||
, examUserCsvActExamResult :: Maybe (Either ExamResultPassed ExamResultGrade)
|
||||
, examUserCsvActExamResult :: Maybe ExamResultPassedGrade
|
||||
}
|
||||
| ExamUserCsvSetCourseNoteData
|
||||
{ examUserCsvActUser :: UserId
|
||||
@ -244,8 +244,8 @@ postEUsersR tid ssh csh examn = do
|
||||
showPasses = numSheetsPasses allBoni /= 0
|
||||
showPoints = getSum (numSheetsPoints allBoni) /= 0
|
||||
|
||||
resultView :: ExamResultGrade -> Either ExamResultPassed ExamResultGrade
|
||||
resultView = bool (Left . over _examResult (view passingGrade)) Right examShowGrades
|
||||
resultView :: ExamResultGrade -> ExamResultPassedGrade
|
||||
resultView = fmap $ bool (Left . view passingGrade) Right examShowGrades
|
||||
|
||||
let
|
||||
examUsersDBTable = DBTable{..}
|
||||
@ -471,7 +471,7 @@ postEUsersR tid ssh csh examn = do
|
||||
deleteBy $ UniqueExamResult eid examUserCsvActUser
|
||||
audit $ TransactionExamResultDeleted eid examUserCsvActUser
|
||||
Just res -> do
|
||||
let res' = either (over _examResult $ review passingGrade) id res
|
||||
let res' = either (review passingGrade) id <$> res
|
||||
now <- liftIO getCurrentTime
|
||||
void $ upsertBy
|
||||
(UniqueExamResult eid examUserCsvActUser)
|
||||
@ -550,11 +550,7 @@ postEUsersR tid ssh csh examn = do
|
||||
$newline never
|
||||
^{nameWidget userDisplayName userSurname}
|
||||
$maybe newResult <- examUserCsvActExamResult
|
||||
$case newResult
|
||||
$of Left pResult
|
||||
, _{pResult}
|
||||
$of Right gResult
|
||||
, _{gResult}
|
||||
, _{newResult}
|
||||
$nothing
|
||||
, _{MsgExamResultNone}
|
||||
|]
|
||||
@ -643,8 +639,6 @@ postEUsersR tid ssh csh examn = do
|
||||
]
|
||||
E.where_ $ studyFeatures E.^. StudyFeaturesUser E.==. E.val uid
|
||||
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
|
||||
Just (Entity _ CourseParticipant{courseParticipantField = Just sfid})
|
||||
-> isActive E.||. (E.val sfid E.==. studyFeatures E.^. StudyFeaturesId)
|
||||
|
||||
@ -20,7 +20,7 @@ import Utils.Lens.TH
|
||||
import qualified Data.Csv as Csv
|
||||
|
||||
import Database.Persist.Sql
|
||||
|
||||
|
||||
|
||||
data ExamResult' res = ExamAttended { examResult :: res }
|
||||
| ExamNoShow
|
||||
@ -211,14 +211,16 @@ pathPieceJSONKey ''ExamPassed
|
||||
passingGrade :: Iso' ExamGrade ExamPassed
|
||||
-- ^ Improper isomorphism; maps @ExamPassed True@ to `Grade10`
|
||||
passingGrade = iso (ExamPassed . (>= Grade40)) (bool Grade50 Grade10 . examPassed)
|
||||
|
||||
|
||||
|
||||
type ExamResultPoints = ExamResult' Points
|
||||
type ExamResultGrade = ExamResult' ExamGrade
|
||||
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
|
||||
|
||||
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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user