feat: external exam csv export

messages/uniworx/de-de-formal.msg

@@ -1714,6 +1714,7 @@ ProportionNoRatio c@Text of@Text: #{c}/#{of}
 
 CourseUserCsvName tid@TermId ssh@SchoolId csh@CourseShorthand: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase csh}-teilnehmer
 ExamUserCsvName tid@TermId ssh@SchoolId csh@CourseShorthand examn@ExamName: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase csh}-#{foldedCase examn}-teilnehmer
+ExternalExamUserCsvName tid@TermId ssh@SchoolId coursen@CourseName examn@ExamName: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase coursen}-#{foldedCase examn}-teilnehmer
 CourseApplicationsTableCsvName tid@TermId ssh@SchoolId csh@CourseShorthand: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase csh}-bewerbungen
 
 CsvColumnsExplanationsLabel: Spalten- & Zellenformat

messages/uniworx/en-eu.msg

@@ -1703,6 +1703,7 @@ ProportionNoRatio c of: #{c}/#{of}
 
 CourseUserCsvName tid ssh csh: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase csh}-participants
 ExamUserCsvName tid ssh csh examn: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase csh}-#{foldedCase examn}-participants
+ExternalExamUserCsvName tid@TermId ssh@SchoolId coursen@CourseName examn@ExamName: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase coursen}-#{foldedCase examn}-participants
 CourseApplicationsTableCsvName tid ssh csh: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase csh}-applications
 
 CsvColumnsExplanationsLabel: Column & cell format

src/Handler/ExamOffice/ExternalExam.hs

@@ -4,14 +4,27 @@ module Handler.ExamOffice.ExternalExam
 
 import Import
 
+import Handler.Utils
+
 import Handler.Utils.ExternalExam.Users
   
 getEEGradesR, postEEGradesR :: TermId -> SchoolId -> CourseName -> ExamName -> Handler Html
 getEEGradesR = postEEGradesR
 postEEGradesR tid ssh coursen examn = do
-  (_, table) <- runDB $ do
+  (usersResult, table) <- runDB $ do
     eExam <- getBy404 $ UniqueExternalExam tid ssh coursen examn
-    makeExternalExamUsersTable EEUMGrades eExam
+    (usersResult, examUsersTable) <- makeExternalExamUsersTable EEUMGrades eExam
+
+    usersResult' <- formResultMaybe usersResult $ \case
+      (ExternalExamUserMarkSynchronisedData, selectedResults) -> do
+        forM_ selectedResults externalExamResultMarkSynchronised
+        return . Just $ do
+          addMessageI Success $ MsgExamUserMarkedSynchronised (length selectedResults)
+          redirect $ EExamR tid ssh coursen examn EEGradesR
+
+    return (usersResult', examUsersTable)
+
+  whenIsJust usersResult join
 
   siteLayoutMsg (MsgExternalExamGrades coursen examn) $ do
     setTitleI MsgBreadcrumbExternalExamGrades

src/Handler/Utils/ExternalExam/Users.hs

@@ -173,6 +173,7 @@ makeExternalExamUsersTable mode (Entity eeId ExternalExam{..}) = do
       examn = externalExamExamName
   
   uid <- requireAuthId
+  csvName <- getMessageRender <*> pure (MsgExternalExamUserCsvName tid ssh coursen examn)
   isLecturer <- hasReadAccessTo $ EExamR tid ssh coursen examn EEUsersR
   currentRoute <- fromMaybe (error "makeExternalExamUsersTable called from 404-handler") <$> getCurrentRoute
 
@@ -311,7 +312,28 @@ makeExternalExamUsersTable mode (Entity eeId ExternalExam{..}) = do
       , dbParamsFormIdent    = def
       }
     dbtIdent = mode
-    dbtCsvEncode = Nothing
+    dbtCsvEncode = case mode of
+      EEUMGrades -> Just DBTCsvEncode
+        { dbtCsvExportForm = ExternalExamUserCsvExportDataGrades
+          <$> apopt checkBoxField (fslI MsgExamUserMarkSynchronisedCsv & setTooltip MsgExamUserMarkSynchronisedCsvTip) (Just False)
+        , dbtCsvDoEncode = \ExternalExamUserCsvExportDataGrades{..} -> C.mapM $ \(E.Value k, row) -> do
+            when csvEEUserMarkSynchronised $ externalExamResultMarkSynchronised k
+            return $ encodeCsv' row
+        , dbtCsvName = unpack csvName
+        , dbtCsvNoExportData = Nothing
+        , dbtCsvHeader = const . return $ headerOrder (error "headerOrder" :: ExternalExamUserTableCsv)
+        }
+      EEUMUsers -> simpleCsvEncode csvName encodeCsv'
+      where
+        encodeCsv' :: ExternalExamUserTableData -> ExternalExamUserTableCsv
+        encodeCsv' row = ExternalExamUserTableCsv
+          { csvEUserSurname         = row ^? resultUser . _entityVal . _userSurname
+          , csvEUserFirstName       = row ^? resultUser . _entityVal . _userFirstName
+          , csvEUserName            = row ^? resultUser . _entityVal . _userDisplayName
+          , csvEUserMatriculation   = row ^? resultUser . _entityVal . _userMatrikelnummer . _Just
+          , csvEUserOccurrenceStart = row ^. resultResult . _entityVal . _externalExamResultTime . to utcToZonedTime
+          , csvEUserExamResult      = row ^. resultResult . _entityVal . _externalExamResultResult . to (fmap $ bool (Left . view passingGrade) Right externalExamShowGrades)
+          }
     dbtCsvDecode
       | mode == EEUMUsers = Just DBTCsvDecode
         { dbtCsvRowKey = \csv -> do
@@ -428,3 +450,27 @@ makeExternalExamUsersTable mode (Entity eeId ExternalExam{..}) = do
       return (act, regSet)
 
   over _1 postprocess <$> dbTable externalExamUsersDBTableValidator DBTable{..}
+
+externalExamResultMarkSynchronised :: ExternalExamResultId -> DB ()
+externalExamResultMarkSynchronised resId = do
+  uid <- requireAuthId
+  now <- liftIO getCurrentTime
+
+  userFunctions <- selectList [ UserFunctionUser ==. uid, UserFunctionFunction ==. SchoolExamOffice ] []
+  if
+    | null userFunctions ->
+        insert_ ExamOfficeExternalResultSynced
+          { examOfficeExternalResultSyncedOffice = uid
+          , examOfficeExternalResultSyncedResult = resId
+          , examOfficeExternalResultSyncedTime   = now
+          , examOfficeExternalResultSyncedSchool = Nothing
+          }
+    | otherwise ->
+        insertMany_ [ ExamOfficeExternalResultSynced
+                      { examOfficeExternalResultSyncedOffice = uid
+                      , examOfficeExternalResultSyncedResult = resId
+                      , examOfficeExternalResultSyncedTime   = now
+                      , examOfficeExternalResultSyncedSchool = Just userFunctionSchool
+                      }
+                    | Entity _ UserFunction{..} <- userFunctions
+                    ]