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

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

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -617,35 +617,40 @@ 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
E.on $ studyTerms E.^. StudyTermsId E.==. studyFeatures E.^. StudyFeaturesField studyFeatures <- E.select . E.from $ \(studyFeatures `E.InnerJoin` studyDegree `E.InnerJoin` studyTerms) ->
E.on $ studyDegree E.^. StudyDegreeId E.==. studyFeatures E.^. StudyFeaturesDegree E.distinctOnOrderBy [ E.asc (studyFeatures E.^. StudyFeaturesField)
E.where_ . E.and $ catMaybes , E.asc (studyFeatures E.^. StudyFeaturesDegree)
[ do , E.asc (studyFeatures E.^. StudyFeaturesSemester)] $ do
field <- csvEUserField E.on $ studyTerms E.^. StudyTermsId E.==. studyFeatures E.^. StudyFeaturesField
return . E.or $ catMaybes E.on $ studyDegree E.^. StudyDegreeId E.==. studyFeatures E.^. StudyFeaturesDegree
[ Just $ studyTerms E.^. StudyTermsName `E.ciEq` E.just (E.val field) E.where_ . E.and $ catMaybes
, Just $ studyTerms E.^. StudyTermsShorthand `E.ciEq` E.just (E.val field) [ do
, (studyTerms E.^. StudyTermsKey E.==.) . E.val <$> readMay field field <- csvEUserField
] return . E.or $ catMaybes
, do [ Just $ studyTerms E.^. StudyTermsName `E.ciEq` E.just (E.val field)
degree <- csvEUserDegree , Just $ studyTerms E.^. StudyTermsShorthand `E.ciEq` E.just (E.val field)
return . E.or $ catMaybes , (studyTerms E.^. StudyTermsKey E.==.) . E.val <$> readMay field
[ Just $ studyDegree E.^. StudyDegreeName `E.ciEq` E.just (E.val degree) ]
, Just $ studyDegree E.^. StudyDegreeShorthand `E.ciEq` E.just (E.val degree) , do
, (studyDegree E.^. StudyDegreeKey E.==.) . E.val <$> readMay degree degree <- csvEUserDegree
] return . E.or $ catMaybes
, (studyFeatures E.^. StudyFeaturesSemester E.==.) . E.val <$> csvEUserSemester [ Just $ studyDegree E.^. StudyDegreeName `E.ciEq` E.just (E.val degree)
] , Just $ studyDegree E.^. StudyDegreeShorthand `E.ciEq` E.just (E.val degree)
E.where_ $ studyFeatures E.^. StudyFeaturesUser E.==. E.val uid , (studyDegree E.^. StudyDegreeKey E.==.) . E.val <$> readMay degree
let isCourseParticipantFeature = E.exists $ E.from $ \courseParticipant -> do ]
E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. E.val examCourse , (studyFeatures E.^. StudyFeaturesSemester E.==.) . E.val <$> csvEUserSemester
E.where_ $ courseParticipant E.^. CourseParticipantUser E.==. E.val uid ]
E.where_ $ courseParticipant E.^. CourseParticipantField E.==. E.just (studyFeatures E.^. StudyFeaturesId) E.where_ $ studyFeatures E.^. StudyFeaturesUser E.==. E.val uid
E.where_ $ (studyFeatures E.^. StudyFeaturesValid E.==. E.val True) let isCourseParticipantFeature = E.exists $ E.from $ \courseParticipant -> do
E.||. isCourseParticipantFeature -- either active studyFeature or the one previously associated with the course E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. E.val examCourse
E.limit 2 -- we just need to know whether there is a unique one, none, or more than one E.where_ $ courseParticipant E.^. CourseParticipantUser E.==. E.val uid
return $ studyFeatures E.^. StudyFeaturesId 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 case studyFeatures of
[E.Value fid] -> return $ Just fid [E.Value fid] -> return $ Just fid
_other _other
@ -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"]

2
src/Model/Types/Misc.hs
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