From 7d2937c71df50e2fdd1346629d2fc1ca0016cf57 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Wed, 21 Aug 2019 17:45:12 +0200 Subject: [PATCH] fix(csv upload exams): allow ambiguous harmless study fields --- src/Handler/Exam/Users.hs | 68 ++++++++++++++++++++++----------------- src/Model/Types/Misc.hs | 2 ++ 2 files changed, 41 insertions(+), 29 deletions(-) diff --git a/src/Handler/Exam/Users.hs b/src/Handler/Exam/Users.hs index 42ec778b0..8347e26ef 100644 --- a/src/Handler/Exam/Users.hs +++ b/src/Handler/Exam/Users.hs @@ -617,35 +617,40 @@ postEUsersR tid ssh csh examn = do lookupStudyFeatures :: ExamUserTableCsv -> DB (Maybe StudyFeaturesId) lookupStudyFeatures csv@ExamUserTableCsv{..} = do uid <- view _2 <$> guessUser csv - studyFeatures <- E.select . E.from $ \(studyFeatures `E.InnerJoin` studyDegree `E.InnerJoin` studyTerms) -> do - E.on $ studyTerms E.^. StudyTermsId E.==. studyFeatures E.^. StudyFeaturesField - E.on $ studyDegree E.^. StudyDegreeId E.==. studyFeatures E.^. StudyFeaturesDegree - E.where_ . E.and $ catMaybes - [ do - field <- csvEUserField - return . E.or $ catMaybes - [ Just $ studyTerms E.^. StudyTermsName `E.ciEq` E.just (E.val field) - , Just $ studyTerms E.^. StudyTermsShorthand `E.ciEq` E.just (E.val field) - , (studyTerms E.^. StudyTermsKey E.==.) . E.val <$> readMay field - ] - , do - degree <- csvEUserDegree - return . E.or $ catMaybes - [ Just $ studyDegree E.^. StudyDegreeName `E.ciEq` E.just (E.val degree) - , Just $ studyDegree E.^. StudyDegreeShorthand `E.ciEq` E.just (E.val degree) - , (studyDegree E.^. StudyDegreeKey E.==.) . E.val <$> readMay degree - ] - , (studyFeatures E.^. StudyFeaturesSemester E.==.) . E.val <$> csvEUserSemester - ] - E.where_ $ studyFeatures E.^. StudyFeaturesUser E.==. E.val uid - let isCourseParticipantFeature = E.exists $ E.from $ \courseParticipant -> do - E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. E.val examCourse - E.where_ $ courseParticipant E.^. CourseParticipantUser E.==. E.val uid - E.where_ $ courseParticipant E.^. CourseParticipantField E.==. E.just (studyFeatures E.^. StudyFeaturesId) - E.where_ $ (studyFeatures E.^. StudyFeaturesValid E.==. E.val True) - E.||. isCourseParticipantFeature -- either active studyFeature or the one previously associated with the course - E.limit 2 -- we just need to know whether there is a unique one, none, or more than one - return $ studyFeatures E.^. StudyFeaturesId + oldFeatures <- getBy $ UniqueParticipant uid examCourse + studyFeatures <- E.select . E.from $ \(studyFeatures `E.InnerJoin` studyDegree `E.InnerJoin` studyTerms) -> + E.distinctOnOrderBy [ E.asc (studyFeatures E.^. StudyFeaturesField) + , E.asc (studyFeatures E.^. StudyFeaturesDegree) + , E.asc (studyFeatures E.^. StudyFeaturesSemester)] $ do + E.on $ studyTerms E.^. StudyTermsId E.==. studyFeatures E.^. StudyFeaturesField + E.on $ studyDegree E.^. StudyDegreeId E.==. studyFeatures E.^. StudyFeaturesDegree + E.where_ . E.and $ catMaybes + [ do + field <- csvEUserField + return . E.or $ catMaybes + [ Just $ studyTerms E.^. StudyTermsName `E.ciEq` E.just (E.val field) + , Just $ studyTerms E.^. StudyTermsShorthand `E.ciEq` E.just (E.val field) + , (studyTerms E.^. StudyTermsKey E.==.) . E.val <$> readMay field + ] + , do + degree <- csvEUserDegree + return . E.or $ catMaybes + [ Just $ studyDegree E.^. StudyDegreeName `E.ciEq` E.just (E.val degree) + , Just $ studyDegree E.^. StudyDegreeShorthand `E.ciEq` E.just (E.val degree) + , (studyDegree E.^. StudyDegreeKey E.==.) . E.val <$> readMay degree + ] + , (studyFeatures E.^. StudyFeaturesSemester E.==.) . E.val <$> csvEUserSemester + ] + E.where_ $ studyFeatures E.^. StudyFeaturesUser E.==. E.val uid + let isCourseParticipantFeature = E.exists $ E.from $ \courseParticipant -> do + E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. E.val examCourse + E.where_ $ courseParticipant E.^. CourseParticipantUser E.==. E.val uid + E.where_ $ courseParticipant E.^. CourseParticipantField E.==. E.just (studyFeatures E.^. StudyFeaturesId) + E.where_ $ (studyFeatures E.^. StudyFeaturesValid E.==. E.val True) + E.||. isCourseParticipantFeature -- either active studyFeature or the one previously associated with the course + E.orderBy [E.desc isCourseParticipantFeature, E.asc (E.orderByOrd $ studyFeatures E.^. StudyFeaturesType)] + E.limit 2 -- we just need to know whether there is a unique one, none, or more than one + return $ studyFeatures E.^. StudyFeaturesId case studyFeatures of [E.Value fid] -> return $ Just fid _other @@ -653,6 +658,11 @@ postEUsersR tid ssh csh examn = do , is _Nothing csvEUserDegree , is _Nothing csvEUserSemester -> return Nothing + _other + | Just (Entity _ CourseParticipant{..}) <- oldFeatures + , Just sfid <- courseParticipantField + , E.Value sfid `elem` studyFeatures + -> return Nothing _other -> throwM ExamUserCsvExceptionNoMatchingStudyFeatures examUsersDBTableValidator = def & defaultSorting [SortAscBy "user-name"] diff --git a/src/Model/Types/Misc.hs b/src/Model/Types/Misc.hs index 510b21251..1c8d676ae 100644 --- a/src/Model/Types/Misc.hs +++ b/src/Model/Types/Misc.hs @@ -19,6 +19,8 @@ import qualified Data.Text.Lens as Text data StudyFieldType = FieldPrimary | FieldSecondary deriving (Eq, Ord, Enum, Show, Read, Bounded, Generic) derivePersistField "StudyFieldType" +instance Universe StudyFieldType +instance Finite StudyFieldType data Theme