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

chore(guess-user): first stub with PredDNF

Browse Source
This commit is contained in:
Sarah Vaupel 2020-08-13 13:48:31 +02:00
parent 753e29dfff
commit e1a9977772
1 changed files with 14 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
src/Handler/Utils/Users.hs
View File

@ -124,9 +124,9 @@ guessUser (Set.toList -> criteria) = $cachedHereBinary criteria $ go False
-- TODO replace guessUser with guessUserTmp when finished
-- TODO PredDNF GuessUserInfo instead of Set GuessUserInfo
guessUserTmp :: Set GuessUserInfo -> DB (Maybe (Either (NonEmpty (Entity User)) (Entity User)))
guessUserTmp (Set.toList -> criteria) = $cachedHereBinary criteria $ go False
-- TODO PredDNF GuessUserInfo instead of Set GuessUserInfo (work in progress)
guessUserTmp :: PredDNF GuessUserInfo -> DB (Maybe (Either (NonEmpty (Entity User)) (Entity User)))
guessUserTmp (((Set.toList . toNullable) <$>) . Set.toList . dnfTerms -> criteria) = $cachedHereBinary criteria $ go False
where
asWords :: Text -> [Text]
asWords = filter (not . Text.null) . Text.words . Text.strip
@ -139,22 +139,27 @@ guessUserTmp (Set.toList -> criteria) = $cachedHereBinary criteria $ go False
GuessUserSurname userSurname' -> user E.^. UserSurname `containsAsSet` userSurname'
GuessUserFirstName userFirstName' -> user E.^. UserFirstName `containsAsSet` userFirstName'
mNeg PLVariable{} = id
mNeg PLNegated{} = E.not_
go didLdap = do
let retrieveUsers = E.select . E.from $ \user -> do
E.where_ . E.and $ map (toSql user) criteria
E.where_ . E.or $ map (E.and . map (\c -> mNeg c $ toSql user $ plVar c)) criteria
return user
users <- retrieveUsers
let users' = sortBy (flip closeness) users
-- TODO account for PLNegated
matchesMatriculation :: Entity User -> Maybe Bool
matchesMatriculation = preview $ _entityVal . _userMatrikelnummer . to (\userMatr -> all ((== userMatr) . Just) $ criteria ^.. folded . _guessUserMatrikelnummer)
matchesMatriculation = preview $ _entityVal . _userMatrikelnummer . to (\userMatr -> any ((== userMatr) . Just) $ criteria ^.. folded . folded . _plVar . _guessUserMatrikelnummer)
closeness :: Entity User -> Entity User -> Ordering
closeness = mconcat $ concat
[ pure $ comparing (fmap Down . matchesMatriculation)
, (criteria ^.. folded . _guessUserSurname) <&> \surn -> comparing (view $ _entityVal . _userSurname . to (`matchesName` surn))
, (criteria ^.. folded . _guessUserFirstName) <&> \firstn -> comparing (view $ _entityVal . _userFirstName . to (`matchesName` firstn))
, (criteria ^.. folded . _guessUserDisplayName) <&> \dispn -> comparing (view $ _entityVal . _userDisplayName . to (`matchesName` dispn))
-- TODO account for PLNegated below
, (criteria ^.. folded . folded . _plVar . _guessUserSurname) <&> \surn -> comparing (view $ _entityVal . _userSurname . to (`matchesName` surn))
, (criteria ^.. folded . folded . _plVar . _guessUserFirstName) <&> \firstn -> comparing (view $ _entityVal . _userFirstName . to (`matchesName` firstn))
, (criteria ^.. folded . folded . _plVar . _guessUserDisplayName) <&> \dispn -> comparing (view $ _entityVal . _userDisplayName . to (`matchesName` dispn))
]
doLdap userMatr = do
@ -182,7 +187,7 @@ guessUserTmp (Set.toList -> criteria) = $cachedHereBinary criteria $ go False
, fromMaybe False (matchesMatriculation x) || didLdap
-> return $ Just $ Left $ NonEmpty.fromList xs
| not didLdap
, userMatr : userMatrs' <- criteria ^.. folded . _guessUserMatrikelnummer
, userMatr : userMatrs' <- criteria ^.. folded . folded . _plVar . _guessUserMatrikelnummer
, all (== userMatr) userMatrs'
-> doLdap userMatr >>= maybe (go True) (return . Just . Right)
| otherwise