From 553c1176269850048998ef1a0b8f580c0d4dc267 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Mon, 13 Jan 2020 17:08:51 +0100 Subject: [PATCH] feat: external exam csv export --- messages/uniworx/de-de-formal.msg | 1 + messages/uniworx/en-eu.msg | 1 + src/Handler/ExamOffice/ExternalExam.hs | 17 +++++++-- src/Handler/Utils/ExternalExam/Users.hs | 48 ++++++++++++++++++++++++- 4 files changed, 64 insertions(+), 3 deletions(-) diff --git a/messages/uniworx/de-de-formal.msg b/messages/uniworx/de-de-formal.msg index 3dbd1b138..2516680b4 100644 --- a/messages/uniworx/de-de-formal.msg +++ b/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 diff --git a/messages/uniworx/en-eu.msg b/messages/uniworx/en-eu.msg index 5a8e0840f..4695fd9c7 100644 --- a/messages/uniworx/en-eu.msg +++ b/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 diff --git a/src/Handler/ExamOffice/ExternalExam.hs b/src/Handler/ExamOffice/ExternalExam.hs index 43526eb54..234e9616c 100644 --- a/src/Handler/ExamOffice/ExternalExam.hs +++ b/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 diff --git a/src/Handler/Utils/ExternalExam/Users.hs b/src/Handler/Utils/ExternalExam/Users.hs index 55addd2a9..bc207abd9 100644 --- a/src/Handler/Utils/ExternalExam/Users.hs +++ b/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 + ]