fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

feat: restore study features in all tables

Browse Source
This commit is contained in:
Gregor Kleen 2020-08-27 14:29:35 +02:00
parent dcfdb5130d
commit 363f7abc19
9 changed files with 117 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
messages/uniworx/de-de-formal.msg
View File

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

2
messages/uniworx/en-eu.msg
View File

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

19
src/Handler/Course/Application/List.hs
View File

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

2
src/Handler/Course/Users.hs
View File

@ -4,7 +4,7 @@ module Handler.Course.Users
( queryUser
, makeCourseUserTable
, postCUsersR, getCUsersR
, colUserSex'
, colUserSex', _userStudyFeatures
) where
import Import

31
src/Handler/Exam/Users.hs
View File

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

30
src/Handler/ExamOffice/Exam.hs
View File

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

4
src/Handler/Tutorial/Users.hs
View File

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

31
src/Handler/Utils/ExternalExam/Users.hs
View File

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

4
src/Handler/Utils/StudyFeatures.hs
View File

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