fix(avs): towards #117 update if current value is Nothing even if oldval == newval

Damit sollten zumindest die ganzen NULL Fälle bein einem neuen Update erledigt sein. Unklar, wo diese aber herkamen.

src/Handler/Utils/AvsUpdate.hs

@@ -67,11 +67,11 @@ instance MkCheckUpdate CU_AvsPersonInfo_User where
   mkCheckUpdate CU_API_UserFirstName             = CheckUpdate     UserFirstName               _avsInfoFirstName
   mkCheckUpdate CU_API_UserSurname               = CheckUpdate     UserSurname                 _avsInfoLastName
   mkCheckUpdate CU_API_UserDisplayName           = CheckUpdate     UserDisplayName             _avsInfoDisplayName
-  mkCheckUpdate CU_API_UserBirthday              = CheckUpdate     UserBirthday                _avsInfoDateOfBirth
+  mkCheckUpdate CU_API_UserBirthday              = CheckUpdateMay  UserBirthday                _avsInfoDateOfBirth
-  mkCheckUpdate CU_API_UserMobile                = CheckUpdate     UserMobile                  _avsInfoPersonMobilePhoneNo
+  mkCheckUpdate CU_API_UserMobile                = CheckUpdateMay  UserMobile                  _avsInfoPersonMobilePhoneNo
-  mkCheckUpdate CU_API_UserMatrikelnummer        = CheckUpdate     UserMatrikelnummer        $ _avsInfoPersonNo . re _Just                                              -- Maybe im User, aber nicht im AvsInfo; also: `re _Just` work like `to Just
+  mkCheckUpdate CU_API_UserMatrikelnummer        = CheckUpdateMay  UserMatrikelnummer        $ _avsInfoPersonNo . re _Just                                              -- Maybe im User, aber nicht im AvsInfo; also: `re _Just` work like `to Just
-  mkCheckUpdate CU_API_UserCompanyPersonalNumber = CheckUpdate     UserCompanyPersonalNumber $ _avsInfoInternalPersonalNo . _Just . _avsInternalPersonalNo . re _Just   -- Maybe im User und im AvsInfo; needs special treatment, see ldap_ups abov
+  mkCheckUpdate CU_API_UserCompanyPersonalNumber = CheckUpdateMay  UserCompanyPersonalNumber $ _avsInfoInternalPersonalNo . _Just . _avsInternalPersonalNo . re _Just   -- Maybe im User und im AvsInfo; needs special treatment, see ldap_ups abov
-  mkCheckUpdate CU_API_UserLdapPrimaryKey        = CheckUpdate     UserLdapPrimaryKey        $ _avsInfoInternalPersonalNo . _Just . _avsInternalPersonalNo . re _Just
+  mkCheckUpdate CU_API_UserLdapPrimaryKey        = CheckUpdateMay  UserLdapPrimaryKey        $ _avsInfoInternalPersonalNo . _Just . _avsInternalPersonalNo . re _Just
   -- mkCheckUpdate CU_API_UserDisplayEmail          = CheckUpdateOpt  UserDisplayEmail          $ _avsInfoPersonEMail  . _Just . from _CI                                  -- Maybe im AvsInfo, aber nicht im User, daher Opt
 
 data CU_AvsDataContcat_User
@@ -82,7 +82,7 @@ data CU_AvsDataContcat_User
 instance MkCheckUpdate CU_AvsDataContcat_User where
   type MCU_Rec CU_AvsDataContcat_User = User
   type MCU_Raw CU_AvsDataContcat_User = AvsDataContact
-  mkCheckUpdate CU_ADC_UserPostAddress  = CheckUpdate    UserPostAddress    _avsContactPrimaryPostAddress
+  mkCheckUpdate CU_ADC_UserPostAddress  = CheckUpdateMay UserPostAddress    _avsContactPrimaryPostAddress
   mkCheckUpdate CU_ADC_UserDisplayEmail = CheckUpdateOpt UserDisplayEmail $ _avsContactPrimaryEmail . _Just . from _CI
 
 data CU_AvsFirmInfo_User
@@ -94,7 +94,7 @@ data CU_AvsFirmInfo_User
 instance MkCheckUpdate CU_AvsFirmInfo_User where
   type MCU_Rec CU_AvsFirmInfo_User = User
   type MCU_Raw CU_AvsFirmInfo_User = AvsFirmInfo
-  mkCheckUpdate CU_AFI_UserPostAddress           = CheckUpdate     UserPostAddress             _avsFirmPostAddress
+  mkCheckUpdate CU_AFI_UserPostAddress           = CheckUpdateMay  UserPostAddress             _avsFirmPostAddress
   -- mkCheckUpdate CU_AFI_UserEmail              = CheckUpdateOpt  UserEmail                 $ _avsFirmEMailSuperior . _Just . from _CI   -- in rare cases, firm superior email is used as fallback here; but UserEmail must be unique!
   -- mkCheckUpdate CU_AFI_UserDisplayEmail       = CheckUpdateOpt  UserDisplayEmail          $ _avsFirmPrimaryEmail  . _Just . from _CI   -- Maybe im AvsInfo, aber nicht im User, daher Opt
 

src/Utils/DB.hs

@@ -341,6 +341,8 @@ instance WithRunDB backend m (ReaderT backend m) where
 data CheckUpdate record iraw =
     forall typ. (Eq typ, PersistField typ) =>
     CheckUpdate     (EntityField record typ) (Getting               typ  iraw typ) -- A persistent record field and fitting getting (also use for typ ~ Maybe typ')
+  | forall typ. (Eq typ, PersistField typ) =>
+    CheckUpdateMay  (EntityField record (Maybe typ)) (Getting (Maybe typ) iraw (Maybe typ)) -- Special case, when `typ` is optional everywhere, forces update of Nothing to Just values
   | forall typ. (Eq typ, PersistField typ) =>
     CheckUpdateOpt  (EntityField record typ) (Getting (Monoid.First typ) iraw typ) -- Special case, when `typ` is optional for the lens, but not optional in DB.
 
@@ -348,11 +350,16 @@ data CheckUpdate record iraw =
 -- instance Lift (CheckUpdate record iraw) where
 --   lift = $(makeLift ''CheckUpdate)
 
+-- | checks if an update would be performed, if a new different value would be presented. Should agree with `mkUpdate` familiy of functions
 mayUpdate :: PersistEntity record => record -> Maybe iraw -> CheckUpdate record iraw -> Bool
 mayUpdate ent (Just old) (CheckUpdate up l)
   | let oldval = old ^. l
   , let entval = ent ^. fieldLensVal up
     = oldval == entval
+mayUpdate ent (Just old) (CheckUpdateMay up l)
+  | let oldval = old ^. l
+  , let entval = ent ^. fieldLensVal up
+    = isNothing entval || oldval == entval
 mayUpdate ent (Just old) (CheckUpdateOpt up l)
   | Just oldval <- old ^? l
   , let entval = ent ^. fieldLensVal up
@@ -369,6 +376,12 @@ mkUpdate ent new (Just old) (CheckUpdate up l)
   , newval /= entval
   , oldval == entval
     = Just (up =. newval)
+mkUpdate ent new (Just old) (CheckUpdateMay up l)
+  | let newval = new ^. l
+  , let oldval = old ^. l
+  , let entval = ent ^. fieldLensVal up
+  , (isNothing entval && isJust newval) || (newval /= entval && oldval == entval)
+    = Just (up =. newval)
 mkUpdate ent new (Just old) (CheckUpdateOpt up l)
   | Just newval <- new ^? l
   , Just oldval <- old ^? l
@@ -383,12 +396,18 @@ mkUpdate' :: PersistEntity record => record -> iraw -> Maybe iraw -> CheckUpdate
 mkUpdate' ent new Nothing = mkUpdateDirect ent new
 mkUpdate' ent new just    = mkUpdate       ent new just
 
+-- | Like `mkUpdate` but performs the update without comparison to a previous older value, whenever current entity value and new value are different
 mkUpdateDirect :: PersistEntity record => record -> iraw -> CheckUpdate record iraw -> Maybe (Update record)
 mkUpdateDirect ent new (CheckUpdate up l)
   | let newval = new ^. l
   , let entval = ent ^. fieldLensVal up
   , newval /= entval
     = Just (up =. newval)
+mkUpdateDirect ent new (CheckUpdateMay up l)
+  | let newval = new ^. l
+  , let entval = ent ^. fieldLensVal up
+  , newval /= entval
+    = Just (up =. newval)
 mkUpdateDirect ent new (CheckUpdateOpt up l)
   | Just newval <- new ^? l
   , let entval = ent ^. fieldLensVal up
@@ -402,6 +421,10 @@ updateRecord ent new (CheckUpdate up l) =
   let newval  = new ^. l
       lensRec = fieldLensVal up
   in  ent & lensRec .~ newval
+updateRecord ent new (CheckUpdateMay up l) =
+  let newval  = new ^. l
+      lensRec = fieldLensVal up
+  in  ent & lensRec .~ newval
 updateRecord ent new (CheckUpdateOpt up l)
   | Just newval <- new ^? l
     = ent & fieldLensVal up .~ newval
@@ -412,7 +435,6 @@ updateRecord ent new (CheckUpdateOpt up l)
 -- mkUpdateCheckUnique' :: PersistEntity record => record -> iraw -> Maybe iraw -> CheckUpdate record iraw -> DB (Maybe (Update record))
 mkUpdateCheckUnique' :: (MonadIO m, PersistQueryRead backend, PersistEntity record, PersistEntityBackend record ~ BaseBackend backend)
                     => record -> a -> Maybe a -> CheckUpdate record a -> ReaderT backend m (Maybe (Update record))
-
 mkUpdateCheckUnique' ent new Nothing (CheckUpdate up l)
   | let newval = new ^. l
   , let entval = ent ^. fieldLensVal up
@@ -420,6 +442,13 @@ mkUpdateCheckUnique' ent new Nothing (CheckUpdate up l)
     = do
         newval_exists <- exists [up ==. newval]
         return $ toMaybe (not newval_exists) (up =. newval)
+mkUpdateCheckUnique' ent new Nothing (CheckUpdateMay up l)
+  | let newval = new ^. l
+  , let entval = ent ^. fieldLensVal up
+  , newval /= entval
+    = do
+        newval_exists <- exists [up ==. newval]
+        return $ toMaybe (not newval_exists) (up =. newval)
 mkUpdateCheckUnique' ent new Nothing (CheckUpdateOpt up l)
   | Just newval <- new ^? l
   , let entval = ent ^. fieldLensVal up
@@ -436,6 +465,14 @@ mkUpdateCheckUnique' ent new (Just old) (CheckUpdate up l)
     = do
         newval_exists <- exists [up ==. newval]
         return $ toMaybe (not newval_exists) (up =. newval)
+mkUpdateCheckUnique' ent new (Just old) (CheckUpdateMay up l)
+  | let newval = new ^. l
+  , let oldval = old ^. l
+  , let entval = ent ^. fieldLensVal up
+  , (isNothing entval && isJust newval) || (newval /= entval && oldval == entval)
+    = do
+        newval_exists <- exists [up ==. newval]
+        return $ toMaybe (not newval_exists) (up =. newval)
 mkUpdateCheckUnique' ent new (Just old) (CheckUpdateOpt up l)
   | Just newval <- new ^? l
   , Just oldval <- old ^? l