From 2ddb56640fd0b5ac6bc7757e03b1819007cabd3a Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Tue, 1 Oct 2019 09:38:18 +0200
Subject: [PATCH] fix(exam-users): make csv import much more lenient

---
 src/Handler/Exam/Users.hs | 31 ++++++++++++++++++++-----------
 1 file changed, 20 insertions(+), 11 deletions(-)

diff --git a/src/Handler/Exam/Users.hs b/src/Handler/Exam/Users.hs
index 966853113..87f8e1cb5 100644
--- a/src/Handler/Exam/Users.hs
+++ b/src/Handler/Exam/Users.hs
@@ -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