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 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"]

2
src/Model/Types/Misc.hs
View File

@ -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