diff --git a/messages/uniworx/de-de-formal.msg b/messages/uniworx/de-de-formal.msg index 22f213807..cc7329693 100644 --- a/messages/uniworx/de-de-formal.msg +++ b/messages/uniworx/de-de-formal.msg @@ -1999,7 +1999,7 @@ CsvColumnUserName: Voller Name des Teilnehmers CsvColumnUserMatriculation: Matrikelnummer des Teilnehmers CsvColumnUserSex: Geschlecht CsvColumnUserEmail: E-Mail-Adresse des Teilnehmers -CsvColumnUserStudyFeatures: Alle aktiven Studiendaten des Teilnehmers als Semikolon (;) separierte Liste +CsvColumnUserStudyFeatures: Alle relevanten Studiendaten des Teilnehmers als Semikolon (;) separierte Liste CsvColumnUserField: Studienfach, mit dem der Teilnehmer seine Kursanmeldung assoziiert hat CsvColumnUserDegree: Abschluss, den der Teilnehmer im assoziierten Studienfach anstrebt CsvColumnUserSemester: Fachsemester des Teilnehmers im assoziierten Studienfach diff --git a/messages/uniworx/en-eu.msg b/messages/uniworx/en-eu.msg index 218a2f410..fb555bcb4 100644 --- a/messages/uniworx/en-eu.msg +++ b/messages/uniworx/en-eu.msg @@ -1998,7 +1998,7 @@ CsvColumnUserName: Participant's full name CsvColumnUserMatriculation: Participant's matriculation CsvColumnUserSex: Participant's sex CsvColumnUserEmail: Participant's email address -CsvColumnUserStudyFeatures: All active fields of study for the participant, separated by semicolon (;) +CsvColumnUserStudyFeatures: All relevant features of study for the participant, separated by semicolon (;) CsvColumnUserField: Field of study the participant specified when enrolling for the course CsvColumnUserDegree: Degree the participant pursues in their associated field of study CsvColumnUserSemester: Semester the participant is in wrt. to their associated field of study diff --git a/src/Handler/Course/Application/List.hs b/src/Handler/Course/Application/List.hs index 426c519d8..6ba8ebcc1 100644 --- a/src/Handler/Course/Application/List.hs +++ b/src/Handler/Course/Application/List.hs @@ -107,6 +107,7 @@ data CourseApplicationsTableCsv = CourseApplicationsTableCsv , csvCAName :: Maybe Text , csvCAEmail :: Maybe UserEmail , csvCAMatriculation :: Maybe Text + , csvCAStudyFeatures :: UserTableStudyFeatures , csvCAText :: Maybe Text , csvCAHasFiles :: Maybe Bool , csvCAVeto :: Maybe CourseApplicationsTableVeto @@ -129,6 +130,7 @@ instance Csv.FromNamedRecord CourseApplicationsTableCsv where <*> csv .:?? "name" <*> csv .:?? "email" <*> csv .:?? "matriculation" + <*> pure mempty <*> csv .:?? "text" <*> csv .:?? "has-files" <*> csv .:?? "veto" @@ -145,6 +147,7 @@ instance CsvColumnsExplained CourseApplicationsTableCsv where , ('csvCAName , MsgCsvColumnApplicationsName ) , ('csvCAEmail , MsgCsvColumnApplicationsEmail ) , ('csvCAMatriculation, MsgCsvColumnApplicationsMatriculation) + , ('csvCAStudyFeatures, MsgCsvColumnUserStudyFeatures ) , ('csvCAText , MsgCsvColumnApplicationsText ) , ('csvCAHasFiles , MsgCsvColumnApplicationsHasFiles ) , ('csvCAVeto , MsgCsvColumnApplicationsVeto ) @@ -321,6 +324,18 @@ postCApplicationsR tid ssh csh = do , fltrApplicationVeto $ queryCourseApplication . to (E.^. CourseApplicationRatingVeto) , fltrApplicationRatingPoints $ queryCourseApplication . to (E.^. CourseApplicationRatingPoints) , fltrApplicationRatingComment $ queryCourseApplication . to (E.^. CourseApplicationRatingComment) + , fltrRelevantStudyFeaturesTerms (to $ + \t -> ( E.val courseTerm + , views queryUser (E.^. UserId) t + )) + , fltrRelevantStudyFeaturesDegree (to $ + \t -> ( E.val courseTerm + , views queryUser (E.^. UserId) t + )) + , fltrRelevantStudyFeaturesSemester (to $ + \t -> ( E.val courseTerm + , views queryUser (E.^. UserId) t + )) ] dbtFilterUI = mconcat [ fltrAllocationUI @@ -332,6 +347,9 @@ postCApplicationsR tid ssh csh = do , fltrApplicationVetoUI , fltrApplicationRatingPointsUI , fltrApplicationRatingCommentUI + , fltrRelevantStudyFeaturesTermsUI + , fltrRelevantStudyFeaturesDegreeUI + , fltrRelevantStudyFeaturesSemesterUI ] dbtStyle = def @@ -345,6 +363,7 @@ postCApplicationsR tid ssh csh = do <*> preview (resultUser . _entityVal . _userDisplayName) <*> preview (resultUser . _entityVal . _userEmail) <*> preview (resultUser . _entityVal . _userMatrikelnummer . _Just) + <*> view resultStudyFeatures <*> preview (resultCourseApplication . _entityVal . _courseApplicationText . _Just) <*> preview resultHasFiles <*> preview (resultCourseApplication . _entityVal . _courseApplicationRatingVeto . re _CourseApplicationsTableVeto) diff --git a/src/Handler/Course/Users.hs b/src/Handler/Course/Users.hs index 8db6e791c..68abfdcd3 100644 --- a/src/Handler/Course/Users.hs +++ b/src/Handler/Course/Users.hs @@ -4,7 +4,7 @@ module Handler.Course.Users ( queryUser , makeCourseUserTable , postCUsersR, getCUsersR - , colUserSex' + , colUserSex', _userStudyFeatures ) where import Import diff --git a/src/Handler/Exam/Users.hs b/src/Handler/Exam/Users.hs index a347d95a0..30b351113 100644 --- a/src/Handler/Exam/Users.hs +++ b/src/Handler/Exam/Users.hs @@ -10,6 +10,7 @@ import Handler.Utils import Handler.Utils.Exam import Handler.Utils.Users import Handler.Utils.Csv +import Handler.Utils.StudyFeatures import Handler.Exam.AutoOccurrence (examAutoOccurrenceCalculateWidget) @@ -58,6 +59,7 @@ type ExamUserTableData = DBRow ( Entity ExamRegistration , Maybe (Entity ExamResult) , Map ExamPartId (ExamPart, Maybe (Entity ExamPartResult)) , Maybe (Entity CourseUserNote) + , UserTableStudyFeatures ) instance HasEntity ExamUserTableData User where @@ -137,6 +139,9 @@ resultExamPartResults = resultExamParts <. _2 resultCourseNote :: Traversal' ExamUserTableData (Entity CourseUserNote) resultCourseNote = _dbrOutput . _7 . _Just +resultStudyFeatures :: Lens' ExamUserTableData UserTableStudyFeatures +resultStudyFeatures = _dbrOutput . _8 + resultAutomaticExamBonus :: Exam -> Map UserId SheetTypeSummary -> Fold ExamUserTableData Points resultAutomaticExamBonus exam examBonus' = resultUser . _entityKey . folding (\uid -> join $ examResultBonus <$> examBonusRule exam <*> pure (examBonusPossible uid examBonus') <*> pure (examBonusAchieved uid examBonus')) @@ -165,6 +170,7 @@ data ExamUserTableCsv = ExamUserTableCsv , csvEUserFirstName :: Maybe Text , csvEUserName :: Maybe Text , csvEUserMatriculation :: Maybe Text + , csvEUserStudyFeatures :: UserTableStudyFeatures , csvEUserOccurrence :: Maybe (CI Text) , csvEUserExercisePoints :: Maybe (Maybe Points) , csvEUserExerciseNumPasses :: Maybe (Maybe Int) @@ -184,6 +190,7 @@ instance ToNamedRecord ExamUserTableCsv where , "first-name" Csv..= csvEUserFirstName , "name" Csv..= csvEUserName , "matriculation" Csv..= csvEUserMatriculation + , "study-features" Csv..= csvEUserStudyFeatures , "occurrence" Csv..= csvEUserOccurrence ] ++ catMaybes [ fmap ("exercise-points" Csv..=) csvEUserExercisePoints @@ -208,6 +215,7 @@ instance FromNamedRecord ExamUserTableCsv where <*> csv .:?? "first-name" <*> csv .:?? "name" <*> csv .:?? "matriculation" + <*> pure mempty <*> csv .:?? "occurrence" <*> fmap Just (csv .:?? "exercise-points") <*> fmap Just (csv .:?? "exercise-num-passes") @@ -228,6 +236,7 @@ instance CsvColumnsExplained ExamUserTableCsv where , single "first-name" MsgCsvColumnExamUserFirstName , single "name" MsgCsvColumnExamUserName , single "matriculation" MsgCsvColumnExamUserMatriculation + , single "study-features" MsgCsvColumnUserStudyFeatures , single "occurrence" MsgCsvColumnExamUserOccurrence , single "exercise-points" MsgCsvColumnExamUserExercisePoints , single "exercise-num-passes" MsgCsvColumnExamUserExercisePasses @@ -249,6 +258,7 @@ examUserTableCsvHeader :: ( MonoFoldable mono examUserTableCsvHeader allBoni doBonus pNames = Csv.header $ [ "surname", "first-name", "name" , "matriculation" + , "study-features" , "course-note" , "occurrence" ] ++ bool mempty ["exercise-points", "exercise-points-max"] (doBonus && showPoints) @@ -359,6 +369,7 @@ getEUsersR = postEUsersR postEUsersR tid ssh csh examn = do (((Any computedValues, registrationResult), examUsersTable), Entity eId examVal@Exam{..}, bonus) <- runDB $ do exam@(Entity eid examVal@Exam{..}) <- fetchExam tid ssh csh examn + Course{..} <- getJust examCourse occurrences <- selectList [ExamOccurrenceExam ==. eid] [Asc ExamOccurrenceName] examParts <- selectList [ExamPartExam ==. eid] [Asc ExamPartName] bonus <- examBonus exam @@ -431,10 +442,11 @@ postEUsersR tid ssh csh examn = do return (examRegistration, user, occurrence, examBonus', examResult, courseUserNote) dbtRowKey = queryExamRegistration >>> (E.^. ExamRegistrationId) dbtProj = runReaderT $ (asks . set _dbrOutput) <=< magnify _dbrOutput $ - (,,,,,,) + (,,,,,,,) <$> view _1 <*> view _2 <*> view _3 <*> view _4 <*> view _5 <*> getExamParts <*> view _6 + <*> (lift . courseUserStudyFeatures examCourse =<< view (_2 . _entityKey)) where getExamParts :: ReaderT _ DB (Map ExamPartId (ExamPart, Maybe (Entity ExamPartResult))) getExamParts = do @@ -453,6 +465,7 @@ postEUsersR tid ssh csh examn = do [ pure $ dbSelect (_2 . applying _2) _1 $ return . view (resultExamRegistration . _entityKey) , pure $ colUserNameLink (CourseR tid ssh csh . CUserR) , pure colUserMatriclenr + , pure $ colStudyFeatures resultStudyFeatures , pure $ sortable (Just "occurrence") (i18nCell MsgExamOccurrence) $ maybe mempty (anchorCell' (\n -> CExamR tid ssh csh examn EShowR :#: [st|exam-occurrence__#{n}|]) id . examOccurrenceName . entityVal) . view _userTableOccurrence , guardOn showPasses $ sortable Nothing (i18nCell MsgAchievedPasses) $ \(view $ resultUser . _entityKey -> uid) -> let SheetGradeSummary{achievedPasses} = examBonusAchieved uid bonus @@ -491,12 +504,27 @@ postEUsersR tid ssh csh examn = do , uncurry singletonMap $ fltrUserMatriclenr queryUser , uncurry singletonMap ("occurrence", FilterColumn . E.mkContainsFilterWith Just $ queryExamOccurrence >>> (E.?. ExamOccurrenceName)) , fltrExamResultPoints (to $ queryExamResult >>> (E.?. ExamResultResult)) + , fltrRelevantStudyFeaturesTerms (to $ + \t -> ( E.val courseTerm + , queryUser t E.^. UserId + )) + , fltrRelevantStudyFeaturesDegree (to $ + \t -> ( E.val courseTerm + , queryUser t E.^. UserId + )) + , fltrRelevantStudyFeaturesSemester (to $ + \t -> ( E.val courseTerm + , queryUser t E.^. UserId + )) ] dbtFilterUI mPrev = mconcat $ catMaybes [ Just $ fltrUserNameEmailUI mPrev , Just $ fltrUserMatriclenrUI mPrev , Just $ prismAForm (singletonFilter "occurrence") mPrev $ aopt (selectField' (Just $ SomeMessage MsgNoFilter) $ optionsF [CI.original examOccurrenceName | Entity _ ExamOccurrence{..} <- occurrences]) (fslI MsgExamOccurrence) , Just $ fltrExamResultPointsUI mPrev + , Just $ fltrRelevantStudyFeaturesTermsUI mPrev + , Just $ fltrRelevantStudyFeaturesDegreeUI mPrev + , Just $ fltrRelevantStudyFeaturesSemesterUI mPrev ] dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout } dbtParams = DBParamsForm @@ -564,6 +592,7 @@ postEUsersR tid ssh csh examn = do <*> view (resultUser . _entityVal . _userFirstName . to Just) <*> view (resultUser . _entityVal . _userDisplayName . to Just) <*> view (resultUser . _entityVal . _userMatrikelnummer) + <*> view resultStudyFeatures <*> preview (resultExamOccurrence . _entityVal . _examOccurrenceName) <*> fmap (bool (const Nothing) Just showPoints) (preview $ resultUser . _entityKey . to (examBonusAchieved ?? bonus) . _achievedPoints . _Wrapped) <*> fmap (bool (const Nothing) Just showPasses) (preview $ resultUser . _entityKey . to (examBonusAchieved ?? bonus) . _achievedPasses . _Wrapped . integral) diff --git a/src/Handler/ExamOffice/Exam.hs b/src/Handler/ExamOffice/Exam.hs index 209da69f2..4364079c7 100644 --- a/src/Handler/ExamOffice/Exam.hs +++ b/src/Handler/ExamOffice/Exam.hs @@ -22,6 +22,8 @@ import qualified Data.Map as Map import qualified Data.Conduit.List as C import qualified Colonnade +import Handler.Utils.StudyFeatures + data ButtonCloseExam = BtnCloseExam deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable) @@ -75,6 +77,7 @@ type ExamUserTableData = DBRow ( Entity ExamResult , Maybe (Entity ExamRegistration) , Bool , [(UserDisplayName, UserSurname, UTCTime, Set SchoolShorthand)] + , UserTableStudyFeatures ) queryExamRegistration :: Getter ExamUserTableExpr (E.SqlExpr (Maybe (Entity ExamRegistration))) @@ -113,11 +116,15 @@ resultIsSynced = _dbrOutput . _5 resultSynchronised :: Traversal' ExamUserTableData (UserDisplayName, UserSurname, UTCTime, Set SchoolShorthand) resultSynchronised = _dbrOutput . _6 . traverse +resultStudyFeatures :: Lens' ExamUserTableData UserTableStudyFeatures +resultStudyFeatures = _dbrOutput . _7 + data ExamUserTableCsv = ExamUserTableCsv { csvEUserSurname :: Text , csvEUserFirstName :: Text , csvEUserName :: Text , csvEUserMatriculation :: Maybe Text + , csvEUserStudyFeatures :: UserTableStudyFeatures , csvEUserOccurrenceStart :: Maybe ZonedTime , csvEUserExamResult :: ExamResultPassedGrade } @@ -139,6 +146,7 @@ instance CsvColumnsExplained ExamUserTableCsv where , ('csvEUserFirstName , MsgCsvColumnExamUserFirstName ) , ('csvEUserName , MsgCsvColumnExamUserName ) , ('csvEUserMatriculation , MsgCsvColumnExamUserMatriculation ) + , ('csvEUserStudyFeatures , MsgCsvColumnUserStudyFeatures ) , ('csvEUserOccurrenceStart , MsgCsvColumnExamOfficeExamUserOccurrenceStart ) , ('csvEUserExamResult , MsgCsvColumnExamUserResult ) ] @@ -166,6 +174,7 @@ postEGradesR tid ssh csh examn = do now <- liftIO getCurrentTime ((usersResult, examUsersTable), Entity eId _) <- runDB $ do exam@(Entity eid Exam{..}) <- fetchExam tid ssh csh examn + Course{..} <- getJust examCourse csvName <- getMessageRender <*> pure (MsgExamUserCsvName tid ssh csh examn) isLecturer <- hasReadAccessTo $ CExamR tid ssh csh examn EUsersR @@ -241,9 +250,10 @@ postEGradesR tid ssh csh examn = do dbtProj :: DBRow _ -> DB ExamUserTableData dbtProj = runReaderT $ (asks . set _dbrOutput) <=< magnify _dbrOutput $ - (,,,,,) + (,,,,,,) <$> view _1 <*> view _2 <*> view _3 <*> view _4 <*> view (_5 . _Value) <*> getSynchronised + <*> (lift . courseUserStudyFeatures examCourse =<< view (_2 . _entityKey)) where getSynchronised :: ReaderT _ DB [(UserDisplayName, UserSurname, UTCTime, Set SchoolShorthand)] getSynchronised = do @@ -297,6 +307,7 @@ postEGradesR tid ssh csh examn = do , colSynced , imapColonnade participantAnchor . anchorColonnadeM (views (resultUser . _entityKey) participantLink) $ colUserDisplayName (resultUser . _entityVal . $(multifocusL 2) _userDisplayName _userSurname) , colUserMatriculation (resultUser . _entityVal . _userMatrikelnummer) + , colStudyFeatures resultStudyFeatures , Colonnade.singleton (fromSortable . Sortable (Just "occurrence-start") $ i18nCell MsgExamTime) $ \x -> cell . flip runReaderT x $ do start <- preview $ resultExamOccurrence . _entityVal . _examOccurrenceStart <> like examStart . _Just end <- preview $ resultExamOccurrence . _entityVal . _examOccurrenceEnd . _Just <> like examEnd . _Just @@ -315,12 +326,28 @@ postEGradesR tid ssh csh examn = do , fltrUserMatriculation (queryUser . to (E.^. UserMatrikelnummer)) , fltrExamResultPoints (queryExamResult . to (E.^. ExamResultResult) . to E.just) , singletonMap "is-synced" . FilterColumn $ E.mkExactFilter (view . queryIsSynced $ E.val uid) + , fltrRelevantStudyFeaturesTerms (to $ + \t -> ( E.val courseTerm + , views queryUser (E.^. UserId) t + )) + , fltrRelevantStudyFeaturesDegree (to $ + \t -> ( E.val courseTerm + , views queryUser (E.^. UserId) t + )) + , fltrRelevantStudyFeaturesSemester (to $ + \t -> ( E.val courseTerm + , views queryUser (E.^. UserId) t + )) + ] dbtFilterUI = mconcat [ fltrUserNameUI' , fltrUserMatriculationUI , fltrExamResultPointsUI , \mPrev -> prismAForm (singletonFilter "is-synced" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgExamUserSynchronised) + , fltrRelevantStudyFeaturesTermsUI + , fltrRelevantStudyFeaturesDegreeUI + , fltrRelevantStudyFeaturesSemesterUI ] dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout } dbtParams = DBParamsForm @@ -355,6 +382,7 @@ postEGradesR tid ssh csh examn = do (row ^. resultUser . _entityVal . _userFirstName) (row ^. resultUser . _entityVal . _userDisplayName) (row ^. resultUser . _entityVal . _userMatrikelnummer) + (row ^. resultStudyFeatures) (row ^? (resultExamOccurrence . _entityVal . _examOccurrenceStart <> like examStart . _Just) . to utcToZonedTime) (row ^. resultExamResult . _entityVal . _examResultResult) , dbtCsvName = unpack csvName diff --git a/src/Handler/Tutorial/Users.hs b/src/Handler/Tutorial/Users.hs index 6e7c9184f..5e91ce386 100644 --- a/src/Handler/Tutorial/Users.hs +++ b/src/Handler/Tutorial/Users.hs @@ -41,10 +41,12 @@ postTUsersR tid ssh csh tutn = do , guardOn showSex colUserSex' , pure colUserEmail , pure colUserMatriclenr + , pure $ colStudyFeatures _userStudyFeatures ] psValidator = def & defaultSortingByName - & restrictSorting (\name _ -> none (== name) ["note", "registration", "tutorials"]) -- We need to be careful to restrict allowed sorting/filter to not expose sensitive information + & restrictSorting (\name _ -> none (== name) ["note", "registration", "tutorials", "exams", "submission-group", "state"]) -- We need to be careful to restrict allowed sorting/filter to not expose sensitive information + & restrictFilter (\name _ -> none (== name) ["tutorial", "exam", "submission-group", "active", "has-personalised-sheet-files"]) isInTut q = E.exists . E.from $ \tutorialParticipant -> E.where_ $ tutorialParticipant E.^. TutorialParticipantUser E.==. queryUser q E.^. UserId E.&&. tutorialParticipant E.^. TutorialParticipantTutorial E.==. E.val tutid diff --git a/src/Handler/Utils/ExternalExam/Users.hs b/src/Handler/Utils/ExternalExam/Users.hs index 68d6a5875..a64df671f 100644 --- a/src/Handler/Utils/ExternalExam/Users.hs +++ b/src/Handler/Utils/ExternalExam/Users.hs @@ -29,6 +29,8 @@ import qualified Data.Conduit.List as C import Data.List (cycle) +import Handler.Utils.StudyFeatures + data ExternalExamUserMode = EEUMUsers | EEUMGrades deriving (Eq, Ord, Read, Show, Bounded, Enum, Generic, Typeable) @@ -45,6 +47,7 @@ type ExternalExamUserTableData = DBRow ( Entity ExternalExamResult , Entity User , Bool , [(UserDisplayName, UserSurname, UTCTime, Set SchoolShorthand)] + , UserTableStudyFeatures ) queryUser :: Getter ExternalExamUserTableExpr (E.SqlExpr (Entity User)) @@ -68,12 +71,16 @@ resultIsSynced = _dbrOutput . _3 resultSynchronised :: Traversal' ExternalExamUserTableData (UserDisplayName, UserSurname, UTCTime, Set SchoolShorthand) resultSynchronised = _dbrOutput . _4 . traverse +resultStudyFeatures :: Lens' ExternalExamUserTableData UserTableStudyFeatures +resultStudyFeatures = _dbrOutput . _5 + data ExternalExamUserTableCsv = ExternalExamUserTableCsv { csvEUserSurname :: Maybe Text , csvEUserFirstName :: Maybe Text , csvEUserName :: Maybe Text , csvEUserMatriculation :: Maybe Text + , csvEUserStudyFeatures :: UserTableStudyFeatures , csvEUserOccurrenceStart :: Maybe ZonedTime , csvEUserExamResult :: ExamResultPassedGrade } deriving (Generic) @@ -95,6 +102,7 @@ instance FromNamedRecord ExternalExamUserTableCsv where <*> csv .:?? "first-name" <*> csv .:?? "name" <*> csv .:?? "matriculation" + <*> pure mempty <*> csv .:?? "occurrence-start" <*> csv .: "exam-result" @@ -105,6 +113,7 @@ instance CsvColumnsExplained ExternalExamUserTableCsv where , ('csvEUserFirstName , MsgCsvColumnExamUserFirstName ) , ('csvEUserName , MsgCsvColumnExamUserName ) , ('csvEUserMatriculation , MsgCsvColumnExamUserMatriculation ) + , ('csvEUserStudyFeatures , MsgCsvColumnUserStudyFeatures ) , ('csvEUserOccurrenceStart , MsgCsvColumnExamOfficeExamUserOccurrenceStart ) , ('csvEUserExamResult , MsgCsvColumnExamUserResult ) ] @@ -209,9 +218,10 @@ makeExternalExamUsersTable mode (Entity eeId ExternalExam{..}) = do dbtProj :: DBRow _ -> DB ExternalExamUserTableData dbtProj = runReaderT $ (asks . set _dbrOutput) <=< magnify _dbrOutput $ - (,,,) + (,,,,) <$> view _1 <*> view _2 <*> view (_3 . _Value) <*> getSynchronised + <*> (lift . externalExamUserStudyFeatures eeId =<< view (_2 . _entityKey)) where getSynchronised :: ReaderT _ DB [(UserDisplayName, UserSurname, UTCTime, Set SchoolShorthand)] getSynchronised = do @@ -265,6 +275,7 @@ makeExternalExamUsersTable mode (Entity eeId ExternalExam{..}) = do , fromMaybe mempty . guardOn (is _EEUMGrades mode) $ colSynced , colUserDisplayName (resultUser . _entityVal . $(multifocusL 2) _userDisplayName _userSurname) , colUserMatriculation (resultUser . _entityVal . _userMatrikelnummer) + , colStudyFeatures resultStudyFeatures , Colonnade.singleton (fromSortable . Sortable (Just "occurrence-start") $ i18nCell MsgExamTime) $ \x -> cell . flip runReaderT x $ do t <- view $ resultResult . _entityVal . _externalExamResultTime lift $ formatTimeW SelFormatDateTime t @@ -282,6 +293,19 @@ makeExternalExamUsersTable mode (Entity eeId ExternalExam{..}) = do , fltrUserMatriculation (queryUser . to (E.^. UserMatrikelnummer)) , fltrExamResultPoints (queryResult . to (E.^. ExternalExamResultResult) . to E.just) , singletonMap "is-synced" . FilterColumn $ E.mkExactFilter (view . queryIsSynced $ E.val uid) + , fltrRelevantStudyFeaturesTerms (to $ + \t -> ( E.val externalExamTerm + , views queryUser (E.^. UserId) t + )) + , fltrRelevantStudyFeaturesDegree (to $ + \t -> ( E.val externalExamTerm + , views queryUser (E.^. UserId) t + )) + , fltrRelevantStudyFeaturesSemester (to $ + \t -> ( E.val externalExamTerm + , views queryUser (E.^. UserId) t + )) + ] dbtFilterUI = mconcat [ fltrUserNameUI' @@ -291,6 +315,9 @@ makeExternalExamUsersTable mode (Entity eeId ExternalExam{..}) = do EEUMGrades -> \mPrev -> prismAForm (singletonFilter "is-synced" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgExamUserSynchronised) _other -> mempty + , fltrRelevantStudyFeaturesTermsUI + , fltrRelevantStudyFeaturesDegreeUI + , fltrRelevantStudyFeaturesSemesterUI ] dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout } dbtParams = DBParamsForm @@ -345,6 +372,7 @@ makeExternalExamUsersTable mode (Entity eeId ExternalExam{..}) = do } EEUMUsers -> let baseEncode = simpleCsvEncode csvName encodeCsv' + csvEUserStudyFeatures = mempty in baseEncode <&> \enc -> enc { dbtCsvExampleData = Just [ ExternalExamUserTableCsv{..} @@ -388,6 +416,7 @@ makeExternalExamUsersTable mode (Entity eeId ExternalExam{..}) = do , csvEUserFirstName = row ^? resultUser . _entityVal . _userFirstName , csvEUserName = row ^? resultUser . _entityVal . _userDisplayName , csvEUserMatriculation = row ^? resultUser . _entityVal . _userMatrikelnummer . _Just + , csvEUserStudyFeatures = row ^. resultStudyFeatures , csvEUserOccurrenceStart = row ^? resultResult . _entityVal . _externalExamResultTime . to utcToZonedTime , csvEUserExamResult = row ^. resultResult . _entityVal . _externalExamResultResult } diff --git a/src/Handler/Utils/StudyFeatures.hs b/src/Handler/Utils/StudyFeatures.hs index 00af8c928..f4d146d11 100644 --- a/src/Handler/Utils/StudyFeatures.hs +++ b/src/Handler/Utils/StudyFeatures.hs @@ -41,7 +41,9 @@ deriveJSON defaultOptions newtype UserTableStudyFeatures = UserTableStudyFeatures (Set UserTableStudyFeature) deriving (Eq, Ord, Read, Show, Generic, Typeable) - deriving newtype (ToJSON, FromJSON) + deriving newtype ( ToJSON, FromJSON + , Semigroup, Monoid + ) makeWrapped ''UserTableStudyFeatures _UserTableStudyFeatures :: Iso' UserTableStudyFeatures [UserTableStudyFeature]