From 44eeffcc70a8b4c119e1a88a9ef01c687fe2e10a Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Thu, 27 Aug 2020 13:14:18 +0200 Subject: [PATCH] feat: course applications study features --- messages/uniworx/de-de-formal.msg | 4 ++ src/Handler/Course/Application/List.hs | 40 +++++++++++++------- src/Handler/Utils/ExamOffice/Exam.hs | 14 ++++--- src/Handler/Utils/ExamOffice/ExternalExam.hs | 8 ++-- src/Handler/Utils/StudyFeatures.hs | 18 ++++++++- 5 files changed, 61 insertions(+), 23 deletions(-) diff --git a/messages/uniworx/de-de-formal.msg b/messages/uniworx/de-de-formal.msg index 98a0788b5..22f213807 100644 --- a/messages/uniworx/de-de-formal.msg +++ b/messages/uniworx/de-de-formal.msg @@ -2025,6 +2025,10 @@ CsvColumnApplicationsVeto: Bewerber mit Veto werden garantiert nicht dem Kurs zu CsvColumnApplicationsRating: Bewertung der Bewerbung; "1.0", "1.3", "1.7", ..., "4.0", "5.0" (Leer wird behandelt wie eine Note zwischen 2.3 und 2.7) CsvColumnApplicationsComment: Kommentar zur Bewerbung; je nach Kurs-Einstellungen entweder nur als Notiz für die Kursverwalter oder Feedback für den Bewerber +ApplicationGeneratedColumns: Stammdaten +ApplicationUserColumns: Bewerbung +ApplicationRatingColumns: Bewertung + Action: Aktion ActionNoUsersSelected: Keine Benutzer ausgewählt diff --git a/src/Handler/Course/Application/List.hs b/src/Handler/Course/Application/List.hs index a47d967f7..426c519d8 100644 --- a/src/Handler/Course/Application/List.hs +++ b/src/Handler/Course/Application/List.hs @@ -25,6 +25,7 @@ import qualified Data.Map as Map import qualified Data.Conduit.List as C import Handler.Course.ParticipantInvite +import Handler.Utils.StudyFeatures import Jobs.Queue @@ -39,6 +40,7 @@ type CourseApplicationsTableData = DBRow ( Entity CourseApplication , Bool -- hasFiles , Maybe (Entity Allocation) , Bool -- isParticipant + , UserTableStudyFeatures ) courseApplicationsIdent :: Text @@ -80,6 +82,9 @@ resultAllocation = _dbrOutput . _4 . _Just resultIsParticipant :: Lens' CourseApplicationsTableData Bool resultIsParticipant = _dbrOutput . _5 +resultStudyFeatures :: Lens' CourseApplicationsTableData UserTableStudyFeatures +resultStudyFeatures = _dbrOutput . _6 + newtype CourseApplicationsTableVeto = CourseApplicationsTableVeto Bool deriving (Eq, Ord, Read, Show, Generic, Typeable) @@ -265,23 +270,32 @@ postCApplicationsR tid ssh csh = do ) dbtProj :: DBRow _ -> DB CourseApplicationsTableData - dbtProj = traverse $ return . over _3 E.unValue . over _5 E.unValue + dbtProj = traverse $ \(application, user, E.Value hasFiles, allocation, E.Value isParticipant) -> do + feats <- courseUserStudyFeatures (application ^. _entityVal . _courseApplicationCourse) (user ^. _entityKey) + return (application, user, hasFiles, allocation, isParticipant, feats) dbtRowKey = view $ queryCourseApplication . to (E.^. CourseApplicationId) - dbtColonnade :: Colonnade Sortable _ _ + dbtColonnade :: Cornice Sortable ('Cap 'Base) _ _ dbtColonnade = mconcat - [ sortable (Just "participant") (i18nCell MsgCourseApplicationIsParticipant) $ bool mempty (cell $ toWidget iconOK) . view resultIsParticipant - , emptyOpticColonnade (resultAllocation . _entityVal) $ \l -> anchorColonnade (views l allocationLink) $ colAllocationShorthand (l . _allocationShorthand) - , anchorColonnadeM (views (resultCourseApplication . _entityKey) applicationLink) $ colApplicationId (resultCourseApplication . _entityKey) - , anchorColonnadeM (views (resultUser . _entityKey) participantLink) $ colUserDisplayName (resultUser . _entityVal . $(multifocusL 2) _userDisplayName _userSurname) - , lmap (view $ resultUser . _entityVal) colUserEmail - , colUserMatriculation (resultUser . _entityVal . _userMatrikelnummer) - , colApplicationText (resultCourseApplication . _entityVal . _courseApplicationText) - , lmap ((tid, ssh, csh), ) $ colApplicationFiles ($(multifocusG 5) (_1 . _1) (_1 . _2) (_1 . _3) (_2 . resultCourseApplication . _entityKey) (_2 . resultHasFiles)) - , colApplicationVeto (resultCourseApplication . _entityVal . _courseApplicationRatingVeto) - , colApplicationRatingPoints (resultCourseApplication . _entityVal . _courseApplicationRatingPoints) - , colApplicationRatingComment (resultCourseApplication . _entityVal . _courseApplicationRatingComment) + [ cap (Sortable Nothing $ i18nCell MsgApplicationGeneratedColumns) $ mconcat + [ sortable (Just "participant") (i18nCell MsgCourseApplicationIsParticipant) $ bool mempty (cell $ toWidget iconOK) . view resultIsParticipant + , emptyOpticColonnade (resultAllocation . _entityVal) $ \l -> anchorColonnade (views l allocationLink) $ colAllocationShorthand (l . _allocationShorthand) + , anchorColonnadeM (views (resultCourseApplication . _entityKey) applicationLink) $ colApplicationId (resultCourseApplication . _entityKey) + , anchorColonnadeM (views (resultUser . _entityKey) participantLink) $ colUserDisplayName (resultUser . _entityVal . $(multifocusL 2) _userDisplayName _userSurname) + , lmap (view $ resultUser . _entityVal) colUserEmail + , colUserMatriculation (resultUser . _entityVal . _userMatrikelnummer) + , colStudyFeatures resultStudyFeatures + ] + , cap (Sortable Nothing $ i18nCell MsgApplicationUserColumns) $ mconcat + [ colApplicationText (resultCourseApplication . _entityVal . _courseApplicationText) + , lmap ((tid, ssh, csh), ) $ colApplicationFiles ($(multifocusG 5) (_1 . _1) (_1 . _2) (_1 . _3) (_2 . resultCourseApplication . _entityKey) (_2 . resultHasFiles)) + ] + , cap (Sortable Nothing $ i18nCell MsgApplicationRatingColumns) $ mconcat + [ colApplicationVeto (resultCourseApplication . _entityVal . _courseApplicationRatingVeto) + , colApplicationRatingPoints (resultCourseApplication . _entityVal . _courseApplicationRatingPoints) + , colApplicationRatingComment (resultCourseApplication . _entityVal . _courseApplicationRatingComment) + ] ] dbtSorting = mconcat diff --git a/src/Handler/Utils/ExamOffice/Exam.hs b/src/Handler/Utils/ExamOffice/Exam.hs index 32248dc7b..9d8d1b50c 100644 --- a/src/Handler/Utils/ExamOffice/Exam.hs +++ b/src/Handler/Utils/ExamOffice/Exam.hs @@ -8,6 +8,7 @@ import Import.NoFoundation import Handler.Utils.StudyFeatures import qualified Database.Esqueleto as E +import qualified Database.Esqueleto.Utils as E resultIsSynced :: E.SqlExpr (E.Value UserId) -- ^ office -> E.SqlExpr (Entity ExamResult) @@ -35,10 +36,13 @@ examOfficeExamResultAuth :: E.SqlExpr (E.Value UserId) -- ^ office -> E.SqlExpr (E.Value Bool) examOfficeExamResultAuth authId examResult = authByUser E.||. authByField E.||. authBySchool where - authByField = E.exists . E.from $ \(course `E.InnerJoin` examOfficeField `E.InnerJoin` studyFeatures) -> do + cId = E.subSelectForeign examResult ExamResultExam (\exam -> E.subSelectForeign exam ExamCourse (E.^. CourseId)) + + authByField = E.exists . E.from $ \(examOfficeField `E.InnerJoin` studyFeatures) -> do E.on $ studyFeatures E.^. StudyFeaturesField E.==. examOfficeField E.^. ExamOfficeFieldField - E.on $ isCourseStudyFeature course studyFeatures - E.&&. course E.^. CourseId E.==. E.subSelectForeign examResult ExamResultExam (\exam -> E.subSelectForeign exam ExamCourse (E.^. CourseId)) + E.where_ . E.maybe E.false id . E.subSelectMaybe . E.from $ \course -> do + E.where_ $ course E.^. CourseId E.==. cId + return . E.just $ isCourseStudyFeature course studyFeatures E.where_ $ studyFeatures E.^. StudyFeaturesUser E.==. examResult E.^. ExamResultUser E.&&. examOfficeField E.^. ExamOfficeFieldOffice E.==. authId E.&&. examOfficeField E.^. ExamOfficeFieldField E.==. studyFeatures E.^. StudyFeaturesField @@ -46,8 +50,8 @@ examOfficeExamResultAuth authId examResult = authByUser E.||. authByField E.||. E.||. E.exists (E.from $ \userFunction -> E.where_ $ userFunction E.^. UserFunctionUser E.==. authId E.&&. userFunction E.^. UserFunctionFunction E.==. E.val SchoolExamOffice - E.&&. E.not_ (E.exists . E.from $ \courseUserExamOfficeOptOut -> - E.where_ $ courseUserExamOfficeOptOut E.^. CourseUserExamOfficeOptOutCourse E.==. course E.^. CourseId + E.&&. E.not_ (E.exists . E.from $ \courseUserExamOfficeOptOut -> do + E.where_ $ courseUserExamOfficeOptOut E.^. CourseUserExamOfficeOptOutCourse E.==. cId E.&&. courseUserExamOfficeOptOut E.^. CourseUserExamOfficeOptOutUser E.==. examResult E.^. ExamResultUser E.&&. courseUserExamOfficeOptOut E.^. CourseUserExamOfficeOptOutSchool E.==. userFunction E.^. UserFunctionSchool ) diff --git a/src/Handler/Utils/ExamOffice/ExternalExam.hs b/src/Handler/Utils/ExamOffice/ExternalExam.hs index 7d9c177d3..ed7be4aba 100644 --- a/src/Handler/Utils/ExamOffice/ExternalExam.hs +++ b/src/Handler/Utils/ExamOffice/ExternalExam.hs @@ -7,6 +7,7 @@ import Import.NoFoundation import Handler.Utils.StudyFeatures import qualified Database.Esqueleto as E +import qualified Database.Esqueleto.Utils as E resultIsSynced :: E.SqlExpr (E.Value UserId) -- ^ office @@ -35,10 +36,11 @@ examOfficeExternalExamResultAuth :: E.SqlExpr (E.Value UserId) -- ^ office -> E.SqlExpr (E.Value Bool) examOfficeExternalExamResultAuth authId eexamResult = authByUser E.||. authByField E.||. authBySchool E.||. authByExtraSchool where - authByField = E.exists . E.from $ \(externalExam `E.InnerJoin` examOfficeField `E.InnerJoin` studyFeatures) -> do + authByField = E.exists . E.from $ \(examOfficeField `E.InnerJoin` studyFeatures) -> do E.on $ studyFeatures E.^. StudyFeaturesField E.==. examOfficeField E.^. ExamOfficeFieldField - E.on $ isExternalExamStudyFeature externalExam studyFeatures - E.&&. externalExam E.^. ExternalExamId E.==. eexamResult E.^. ExternalExamResultExam + E.where_ . E.maybe E.false id . E.subSelectMaybe . E.from $ \externalExam -> do + E.where_ $ externalExam E.^. ExternalExamId E.==. eexamResult E.^. ExternalExamResultExam + return . E.just $ isExternalExamStudyFeature externalExam studyFeatures E.where_ $ studyFeatures E.^. StudyFeaturesUser E.==. eexamResult E.^. ExternalExamResultUser E.&&. examOfficeField E.^. ExamOfficeFieldOffice E.==. authId E.&&. examOfficeField E.^. ExamOfficeFieldField E.==. studyFeatures E.^. StudyFeaturesField diff --git a/src/Handler/Utils/StudyFeatures.hs b/src/Handler/Utils/StudyFeatures.hs index 359f6780a..00af8c928 100644 --- a/src/Handler/Utils/StudyFeatures.hs +++ b/src/Handler/Utils/StudyFeatures.hs @@ -74,8 +74,18 @@ isRelevantStudyFeature :: PersistEntity record -> E.SqlExpr (Entity StudyFeatures) -> E.SqlExpr (E.Value Bool) isRelevantStudyFeature termField record studyFeatures - = overlap studyFeatures E.>. E.val 0 - E.&&. E.not_ (E.exists betterOverlap) + = ( ( overlap studyFeatures E.>. E.val 0 + E.||. ( E.just (studyFeatures E.^. StudyFeaturesLastObserved) E.==. studyFeatures E.^. StudyFeaturesFirstObserved + E.&&. termStart E.<=. E.day (studyFeatures E.^. StudyFeaturesLastObserved) + E.&&. E.day (studyFeatures E.^. StudyFeaturesLastObserved) E.<=. termEnd + ) + ) + E.&&. E.not_ (E.exists betterOverlap) + ) + E.||. ( E.subSelectForeign record termField (E.^. TermActive) + E.&&. E.not_ (E.exists anyOverlap) + E.&&. studyFeatures E.^. StudyFeaturesValid + ) where termEnd = E.subSelectForeign record termField (E.^. TermEnd) termStart = E.subSelectForeign record termField (E.^. TermStart) @@ -84,6 +94,10 @@ isRelevantStudyFeature termField record studyFeatures = E.min (E.day $ studyFeatures' E.^. StudyFeaturesLastObserved) termEnd `E.diffDays` E.maybe termStart (E.max termStart . E.day) (studyFeatures' E.^. StudyFeaturesFirstObserved) + anyOverlap = E.from $ \studyFeatures' -> do + E.where_ $ studyFeatures' E.^. StudyFeaturesUser E.==. studyFeatures E.^. StudyFeaturesUser + E.where_ $ overlap studyFeatures' E.>. E.val 0 + betterOverlap = E.from $ \studyFeatures' -> do E.where_ $ studyFeatures' E.^. StudyFeaturesUser E.==. studyFeatures E.^. StudyFeaturesUser E.&&. studyFeatures' E.^. StudyFeaturesDegree E.==. studyFeatures E.^. StudyFeaturesDegree