fix(csv upload exams): allow ambiguous harmless study fields
This commit is contained in:
parent
6384ead0f9
commit
7d2937c71d
@ -617,7 +617,11 @@ 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
|
||||
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
|
||||
@ -644,6 +648,7 @@ postEUsersR tid ssh csh examn = do
|
||||
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
|
||||
@ -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"]
|
||||
|
||||
@ -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
|
||||
|
||||
Reference in New Issue
Block a user