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

fix(exam-users): make csv import much more lenient

Browse Source
This commit is contained in:
Gregor Kleen 2019-10-01 09:38:18 +02:00
parent 89adf7f2dc
commit 2ddb56640f
1 changed files with 20 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -931,22 +931,31 @@ postEUsersR tid ssh csh examn = do
guessUser :: ExamUserTableCsv -> DB (Bool, UserId)
guessUser ExamUserTableCsv{..} = $cachedHereBinary (csvEUserMatriculation, csvEUserName, csvEUserSurname) $ do
users <- E.select . E.from $ \user -> do
E.where_ . E.and $ catMaybes
E.where_ . E.or $ catMaybes
[ (user E.^. UserMatrikelnummer E.==.) . E.val . Just <$> csvEUserMatriculation
, (user E.^. UserDisplayName E.==.) . E.val <$> csvEUserName
, (user E.^. UserSurname E.==.) . E.val <$> csvEUserSurname
, (user E.^. UserFirstName E.==.) . E.val <$> csvEUserFirstName
, (user E.^. UserDisplayName `E.hasInfix`) . E.val <$> csvEUserName
, (user E.^. UserSurname `E.hasInfix`) . E.val <$> csvEUserSurname
, (user E.^. UserFirstName `E.hasInfix`) . E.val <$> csvEUserFirstName
]
let isCourseParticipant = E.exists . E.from $ \courseParticipant ->
E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. E.val examCourse
E.&&. courseParticipant E.^. CourseParticipantUser E.==. user E.^. UserId
E.limit 2
return (isCourseParticipant, user E.^. UserId)
case users of
(filter . view $ _1 . _Value -> [(E.Value isPart, E.Value uid)])
-> return (isPart, uid)
[(E.Value isPart, E.Value uid)]
-> return (isPart, uid)
return (isCourseParticipant, user)
let users' = reverse $ sortBy closeness users
closeness :: (E.Value Bool, Entity User) -> (E.Value Bool, Entity User) -> Ordering
closeness = mconcat $ catMaybes
[ pure $ comparing (preview $ _2 . _entityVal . _userMatrikelnummer . only csvEUserMatriculation)
, pure $ comparing (view _1)
, csvEUserSurname <&> \surn -> comparing (preview $ _2 . _entityVal . _userSurname . to CI.mk . only (CI.mk surn))
, csvEUserFirstName <&> \firstn -> comparing (preview $ _2 . _entityVal . _userFirstName . to CI.mk . only (CI.mk firstn))
, csvEUserName <&> \dispn -> comparing (preview $ _2 . _entityVal . _userDisplayName . to CI.mk . only (CI.mk dispn))
]
case users' of
[(E.Value isPart, Entity uid _)]
-> return (isPart, uid)
(x@(E.Value isPart, Entity uid _) : x' : _)
| GT <- x `closeness` x'
-> return (isPart, uid)
_other
-> throwM ExamUserCsvExceptionNoMatchingUser