fix(csv upload exams): allow ambiguous harmless study fields

This commit is contained in:
Steffen Jost 2019-08-21 17:45:12 +02:00
parent 6384ead0f9
commit 7d2937c71d
2 changed files with 41 additions and 29 deletions

View File

@ -617,7 +617,11 @@ postEUsersR tid ssh csh examn = do
lookupStudyFeatures :: ExamUserTableCsv -> DB (Maybe StudyFeaturesId) lookupStudyFeatures :: ExamUserTableCsv -> DB (Maybe StudyFeaturesId)
lookupStudyFeatures csv@ExamUserTableCsv{..} = do lookupStudyFeatures csv@ExamUserTableCsv{..} = do
uid <- view _2 <$> guessUser csv uid <- view _2 <$> guessUser csv
studyFeatures <- E.select . E.from $ \(studyFeatures `E.InnerJoin` studyDegree `E.InnerJoin` studyTerms) -> do 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 $ studyTerms E.^. StudyTermsId E.==. studyFeatures E.^. StudyFeaturesField
E.on $ studyDegree E.^. StudyDegreeId E.==. studyFeatures E.^. StudyFeaturesDegree E.on $ studyDegree E.^. StudyDegreeId E.==. studyFeatures E.^. StudyFeaturesDegree
E.where_ . E.and $ catMaybes E.where_ . E.and $ catMaybes
@ -644,6 +648,7 @@ postEUsersR tid ssh csh examn = do
E.where_ $ courseParticipant E.^. CourseParticipantField E.==. E.just (studyFeatures E.^. StudyFeaturesId) E.where_ $ courseParticipant E.^. CourseParticipantField E.==. E.just (studyFeatures E.^. StudyFeaturesId)
E.where_ $ (studyFeatures E.^. StudyFeaturesValid E.==. E.val True) E.where_ $ (studyFeatures E.^. StudyFeaturesValid E.==. E.val True)
E.||. isCourseParticipantFeature -- either active studyFeature or the one previously associated with the course 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 E.limit 2 -- we just need to know whether there is a unique one, none, or more than one
return $ studyFeatures E.^. StudyFeaturesId return $ studyFeatures E.^. StudyFeaturesId
case studyFeatures of case studyFeatures of
@ -653,6 +658,11 @@ postEUsersR tid ssh csh examn = do
, is _Nothing csvEUserDegree , is _Nothing csvEUserDegree
, is _Nothing csvEUserSemester , is _Nothing csvEUserSemester
-> return Nothing -> return Nothing
_other
| Just (Entity _ CourseParticipant{..}) <- oldFeatures
, Just sfid <- courseParticipantField
, E.Value sfid `elem` studyFeatures
-> return Nothing
_other -> throwM ExamUserCsvExceptionNoMatchingStudyFeatures _other -> throwM ExamUserCsvExceptionNoMatchingStudyFeatures
examUsersDBTableValidator = def & defaultSorting [SortAscBy "user-name"] examUsersDBTableValidator = def & defaultSorting [SortAscBy "user-name"]

View File

@ -19,6 +19,8 @@ import qualified Data.Text.Lens as Text
data StudyFieldType = FieldPrimary | FieldSecondary data StudyFieldType = FieldPrimary | FieldSecondary
deriving (Eq, Ord, Enum, Show, Read, Bounded, Generic) deriving (Eq, Ord, Enum, Show, Read, Bounded, Generic)
derivePersistField "StudyFieldType" derivePersistField "StudyFieldType"
instance Universe StudyFieldType
instance Finite StudyFieldType
data Theme data Theme