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

refactor(users): fieldLens function allwos more generic code

Browse Source
This commit is contained in:
Steffen Jost 2023-04-25 16:24:47 +00:00
parent 52afd13b6d
commit 5340bf25dc
1 changed files with 21 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -870,21 +870,25 @@ assimilateUser newUserId oldUserId = mapReaderT execWriterT $ do
deleteWhere [ UserCompanyUser ==. oldUserId] deleteWhere [ UserCompanyUser ==. oldUserId]
-- merge some optional / incomplete user fields -- merge some optional / incomplete user fields
let mergeBy :: forall a . PersistField a => (a -> a -> Bool) -> EntityField User a -> (Bool, Update User)
mergeBy cmp uf = let ufl = fieldLens uf
oldV = oldUserEnt ^. ufl
newV = newUserEnt ^. ufl
in (cmp oldV newV, uf =. oldV)
mergeMaybe :: forall b . PersistField b => EntityField User (Maybe b) -> (Bool, Update User)
mergeMaybe = mergeBy (\oldV newV -> isNothing newV && isJust oldV)
update newUserId [upd | (True, upd) <- -- NOTE: persist does shortcircuit null updates as expected update newUserId [upd | (True, upd) <- -- NOTE: persist does shortcircuit null updates as expected
[ ( isNothing (newUser ^. _userLdapPrimaryKey) && isJust (oldUser ^. _userLdapPrimaryKey) [ mergeMaybe UserLdapPrimaryKey
, UserLdapPrimaryKey =. oldUser ^. _userLdapPrimaryKey ) , mergeBy (<) UserAuthentication
, ( newUser ^. _userAuthentication > oldUser ^. _userAuthentication , mergeBy (>) UserLastAuthentication
, UserAuthentication =. oldUser ^. _userAuthentication ) , mergeBy (<) UserCreated
, ( newUser ^. _userLastAuthentication < oldUser ^. _userLastAuthentication
, UserLastAuthentication =. oldUser ^. _userLastAuthentication )
, ( newUser ^. _userCreated > oldUser ^. _userCreated
, UserCreated =. oldUser ^. _userCreated )
, ( not (validEmail' (newUser ^. _userEmail )) && validEmail' (oldUser ^. _userEmail) , ( not (validEmail' (newUser ^. _userEmail )) && validEmail' (oldUser ^. _userEmail)
, UserEmail =. oldUser ^. _userEmail) , UserEmail =. oldUser ^. _userEmail)
, ( not (validEmail' (newUser ^. _userDisplayEmail)) && validEmail' (oldUser ^. _userDisplayEmail) , ( not (validEmail' (newUser ^. _userDisplayEmail)) && validEmail' (oldUser ^. _userDisplayEmail)
, UserDisplayEmail =. oldUser ^. _userDisplayEmail) , UserDisplayEmail =. oldUser ^. _userDisplayEmail)
, ( isNothing (newUser ^. _userMatrikelnummer) && isJust (oldUser ^. _userMatrikelnummer) , mergeMaybe UserMatrikelnummer
, UserMatrikelnummer =. oldUser ^. _userMatrikelnummer )
, ( isNothing (newUser ^. _userPostAddress) && isJust (oldUser ^. _userPostAddress) , ( isNothing (newUser ^. _userPostAddress) && isJust (oldUser ^. _userPostAddress)
, UserPostAddress =. oldUser ^. _userPostAddress ) , UserPostAddress =. oldUser ^. _userPostAddress )
, ( isNothing (newUser ^. _userPostAddress) && isJust (oldUser ^. _userPostAddress) , ( isNothing (newUser ^. _userPostAddress) && isJust (oldUser ^. _userPostAddress)
@ -892,8 +896,12 @@ assimilateUser newUserId oldUserId = mapReaderT execWriterT $ do
, ( (isJust (newUser ^. _userPostAddress) || isJust (oldUser ^. _userPostAddress)) , ( (isJust (newUser ^. _userPostAddress) || isJust (oldUser ^. _userPostAddress))
&& (newUser ^. _userPrefersPostal || oldUser ^. _userPrefersPostal) && (newUser ^. _userPrefersPostal || oldUser ^. _userPrefersPostal)
, UserPrefersPostal =. True ) , UserPrefersPostal =. True )
, ( isNothing (newUser ^. _userPinPassword) && isJust (oldUser ^. _userPinPassword) , mergeMaybe UserPinPassword
, UserPinPassword =. oldUser ^. _userPinPassword ) , mergeMaybe UserLanguages
, mergeMaybe UserSex
, mergeMaybe UserBirthday
, mergeMaybe UserTelephone
, mergeMaybe UserMobile
] ]
] ]