feat(exam-correct): single runDB in POST handler; more response handling

frontend/src/utils/exam-correct/exam-correct.js

@@ -99,8 +99,6 @@ export class ExamCorrect {
     // abort send if there are no results (after validation)
     if (Object.keys(results).length <= 0) return;
 
-    console.log('input validated, proceeding', participant, results);
-
     // TODO create and use template for this
     const correctionRow = document.createElement('TR');
     correctionRow.classList.add('table__row');
@@ -145,8 +143,6 @@ export class ExamCorrect {
       op: true,
     };
 
-    console.log('body', body);
-
     this._app.httpClient.post({
       url: url,
       headers: headers,
@@ -170,19 +166,35 @@ export class ExamCorrect {
         if (participantIdent === participant) {
           let faIcon, ecClass;
           switch (response.status) {
+            // TODO fetch update time from response and replace
             case 'success':
-              // TODO replace loading spinner class with fontawesome tick mark icon
-              // TODO replace participant identifier with participant from response
               faIcon = 'fa-check';
               ecClass = 'exam-correct--success';
+              if (response.user) {
+                participantElem.setAttribute(EXAM_CORRECT_PARTICIPANT_ATTR, response.user.id);
+                participantElem.innerHTML = '';
+                formatUser(participantElem, response.user);
+              }
+              // TODO replace results with results from response
+              // TODO set edit button visibility
               break;
-            case 'error':
+            case 'ambiguous':
-              // TODO replace loading spinner class with fontawesome error icon
+              // TODO show tooltip with error message
-              // TODO show tooltip with error message?
+              // TODO set edit button visibility
+              faIcon = 'fa-times';
+              ecClass = 'exam-correct--error';
+              // TODO show users
+              if (response.users) {
+                showUsers(participantElem, response.users);
+              }
+              break;
+            case 'failure':
               faIcon = 'fa-times';
               ecClass = 'exam-correct--error';
               break;
             default:
+              // TODO show tooltip with 'invalid response'
+              // TODO set edit button visibility
               console.error('Invalid response');
               faIcon = 'fa-times';
               ecClass = 'exam-correct--error';
@@ -212,3 +224,24 @@ export class ExamCorrect {
 function clearInput(inputElement) {
   inputElement.value = null;
 }
+
+function formatUser(elem, user) {
+  if (user && user['display-name'] && user['surname']) {
+    elem.innerHTML += user['display-name'].replace(new RegExp(user['surname']), `<strong>${user['surname']}</strong>`) + (user['mat-nr'] ? ` (${user['mat-nr']})` : '');
+  } else {
+    console.error('Unable to format invalid user response');
+  }
+}
+
+// TODO better name
+function showUsers(elem, users) {
+  elem.innerHTML = '';
+  if (users) {
+    for (const user of users) {
+      formatUser(elem, user);
+      elem.innerHTML += '<br/>';
+    }
+  } else {
+    console.error('Unable to show users from invalid response');
+  }
+}

src/Handler/Exam/Correct.hs

@@ -29,6 +29,7 @@ data CorrectInterfaceResponse
   = CorrectInterfaceResponseSuccess
     { cirsUser       :: CorrectInterfaceUser
     , cirsResults    :: Map ExamPartNumber (Maybe Points)
+    , cirsTime       :: UTCTime
     }
   | CorrectInterfaceResponseAmbiguous
     { ciraUsers      :: Set CorrectInterfaceUser
@@ -85,25 +86,26 @@ getECorrectR tid ssh csh examn = do
     $(widgetFile "exam-correct")
 
 
-postECorrectR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Handler Value
+postECorrectR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Handler Void
 postECorrectR tid ssh csh examn = do
   MsgRenderer mr <- getMsgRenderer
 
   CorrectInterfaceRequest{ciqName,ciqResults,ciqOp} <- requireCheckJsonBody
 
-  participantMatches <- runDB $ do
+  response <- runDB $ do
     Entity eId _ <- fetchExam tid ssh csh examn
-    E.select . E.from $ \(examRegistration `E.InnerJoin` user) -> do
+
+    participantMatches <- E.select . E.from $ \(examRegistration `E.InnerJoin` user) -> do
       E.on $ examRegistration E.^. ExamRegistrationUser E.==. user E.^. UserId
       E.where_ $ examRegistration E.^. ExamRegistrationExam E.==. E.val eId
-        E.&&. ( user E.^. UserMatrikelnummer E.==. E.val (Just ciqName)
+      E.where_ $ user E.^. UserMatrikelnummer E.==. E.val (Just ciqName)
            E.||. user E.^. UserMatrikelnummer `E.hasInfix` E.val (Just ciqName)
            E.||. user E.^. UserSurname E.==. E.val ciqName
            E.||. user E.^. UserSurname `E.hasInfix` E.val ciqName
            E.||. user E.^. UserFirstName E.==. E.val ciqName
            E.||. user E.^. UserFirstName `E.hasInfix` E.val ciqName
            E.||. user E.^. UserDisplayName E.==. E.val ciqName
-          E.||. user E.^. UserDisplayName `E.hasInfix` E.val ciqName )
+           E.||. user E.^. UserDisplayName `E.hasInfix` E.val ciqName
       return user
 
     let
@@ -117,45 +119,65 @@ postECorrectR tid ssh csh examn = do
           }
 
     if
+      -- on no-op request, answer with 200 and a set of all participant matches
       | not ciqOp -> do
         users <- traverse userToResponse participantMatches
-      returnJson $ CorrectInterfaceResponseNoOp
+        return CorrectInterfaceResponseNoOp
           { cirnUsers = Set.fromList users
           }
+
+      -- on match with exactly one exam participant, insert results and answer with 200
       | [match@(Entity uid _)] <- participantMatches -> do
-      runDB $ do
+        now <- liftIO getCurrentTime
-        Entity eId _ <- fetchExam tid ssh csh examn
+        newExamPartResults <- iforM ciqResults $ \partNumber mPartResult -> do
-        iforM_ ciqResults $ \partNumber mPartResult -> do
             examPartId <- getKeyBy404 $ UniqueExamPartNumber eId partNumber
             mOldResult <- getBy $ UniqueExamPartResult examPartId uid
-          unless (fmap (examPartResultResult . entityVal) mOldResult /= mPartResult) $ do
+            if
-            let partResult = maybe 0.00 (\p -> ExamPartResultResult p) mPartResult
+              | Just (Entity oldId _) <- mOldResult, is _Nothing mPartResult -> do
-            now <- liftIO getCurrentTime
+                delete oldId
-            upsert ExamPartResult
+                audit $ TransactionExamPartResultDeleted examPartId uid
+                return Nothing
+              | Just partResult <- mPartResult
+              , fmap (examPartResultResult . entityVal) mOldResult /= fmap ExamAttended mPartResult -> do
+                newExamPartResult <- upsert ExamPartResult
                   { examPartResultExamPart    = examPartId
                   , examPartResultUser        = uid
-              , examPartResultResult      = partResult
+                  , examPartResultResult      = ExamAttended partResult
                   , examPartResultLastChanged = now
                   }
-              [ ExamPartResultResult =. partResult
+                  [ ExamPartResultResult      =. ExamAttended partResult
+                  , ExamPartResultLastChanged =. now
                   ]
                 audit $ TransactionExamPartResultEdit examPartId uid
+                return $ newExamPartResult ^? _entityVal . _examPartResultResult . _ExamAttended
+              | otherwise -> return Nothing
         user <- userToResponse match
-      returnJson $ CorrectInterfaceResponseSuccess
+        return CorrectInterfaceResponseSuccess
           { cirsUser    = user
-        , cirsResults   = ciqResults
+          , cirsResults = newExamPartResults
+          , cirsTime    = now
           }
-    | [] <- participantMatches -> returnJson $ CorrectInterfaceResponseFailure
+
+      -- on match with no exam participant, answer with 400
+      | [] <- participantMatches -> return CorrectInterfaceResponseFailure
         { cirfMessage   = mr MsgExamCorrectErrorNoMatchingParticipants
         }
+
+      -- on match with multiple exam participants, answer with 400 and a set of all matches
       | otherwise -> do
         users <- traverse userToResponse participantMatches
-      returnJson $ CorrectInterfaceResponseAmbiguous
+        return CorrectInterfaceResponseAmbiguous
           { ciraMessage = mr MsgExamCorrectErrorMultipleMatchingParticipants
           , ciraUsers   = Set.fromList users
           }
   
-    -- TODO if the request is a noop, respond with a 200
+  let
-    -- TODO if there is exactly one match, respond with a 200
+    responseStatus = case response of
-    -- TODO if there are multiple matches, respond with a 400
+      CorrectInterfaceResponseSuccess{} -> ok200
-    -- TODO if there are no matches, respond with a 400
+      CorrectInterfaceResponseNoOp{}    -> ok200
+      _                                 -> badRequest400
+
+  whenM acceptsJson $
+    sendResponseStatus responseStatus $ toJSON response
+  
+  redirect $ CExamR tid ssh csh examn EShowR