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

src/Foundation.hs

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

src/Handler/Exam/Users.hs

@@ -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 :: ExamResultGrade -> ExamResultPassedGrade
-      resultView = bool (Left . over _examResult (view passingGrade)) Right examShowGrades
+      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
+                      , _{newResult}
-                        $of Left pResult
-                          , _{pResult}
-                        $of Right gResult
-                          , _{gResult}
                     $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)

src/Model/Types/Exam.hs

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