Merge pull request #1088 from digitallyinduced/set-if-just

add setIfJust which ignores updates on Nothing

IHP/HaskellSupport.hs

@@ -12,6 +12,7 @@ module IHP.HaskellSupport
 , get
 , set
 , setJust
+, setMaybe
 , ifOrEmpty
 , modify
 , modifyJust
@@ -114,9 +115,9 @@ instance forall name name'. (KnownSymbol name, name' ~ name) => IsLabel name (Pr
 -- | Returns the field value for a field name
 --
 -- __Example:__
--- 
+--
 -- > data Project = Project { name :: Text, isPublic :: Bool }
--- > 
+-- >
 -- > let project = Project { name = "Hello World", isPublic = False }
 --
 -- >>> get #name project
@@ -131,9 +132,9 @@ get _ record = Record.getField @name record
 -- | Sets a field of a record and returns the new record.
 --
 -- __Example:__
--- 
+--
 -- > data Project = Project { name :: Text, isPublic :: Bool }
--- > 
+-- >
 -- > let project = Project { name = "Hello World", isPublic = False }
 --
 -- >>> set #name "New Name" project
@@ -145,12 +146,35 @@ set :: forall model name value. (KnownSymbol name, SetField name model value) =>
 set name value record = setField @name value record
 {-# INLINE set #-}
 
+
+-- | Like 'set' but doesn't set the value if it's 'Nothing'. Useful when you update NULL values
+-- | e.g. via a cron job and don't want to lose that work on subsequent updates.
+--
+-- __Example:__
+--
+-- > data Project = Project { name :: Maybe Text }
+-- >
+-- > let project = Project { name = Nothing }
+--
+-- >>> setMaybe #name (Just "New Name") project
+-- Project { name = Just "New Name" }
+--
+-- >>> setMaybe #name Nothing project
+-- Project { name = Just "New Name" } -- previous value is kept
+--
+setMaybe :: forall model name value. (KnownSymbol name, SetField name model (Maybe value)) => Proxy name -> Maybe value -> model -> model
+setMaybe name value record = case value of
+    Just value -> setField @name (Just value) record
+    Nothing    -> record
+{-# INLINE setMaybe #-}
+
+
 -- | Like 'set' but wraps the value with a 'Just'. Useful when you want to set a 'Maybe' field
 --
 -- __Example:__
--- 
+--
 -- > data Project = Project { name :: Maybe Text }
--- > 
+-- >
 -- > let project = Project { name = Nothing }
 --
 -- >>> setJust #name "New Name" project
@@ -184,9 +208,9 @@ modifyJust _ updateFunction model = case Record.getField @name model of
 -- | Plus @1@ on record field.
 --
 -- __Example:__
--- 
+--
 -- > data Project = Project { name :: Text, followersCount :: Int }
--- > 
+-- >
 -- > let project = Project { name = "Hello World", followersCount = 0 }
 --
 -- >>> project |> incrementField #followersCount
@@ -198,9 +222,9 @@ incrementField _ model = let value = Record.getField @name model in setField @na
 -- | Minus @1@ on a record field.
 --
 -- __Example:__
--- 
+--
 -- > data Project = Project { name :: Text, followersCount :: Int }
--- > 
+-- >
 -- > let project = Project { name = "Hello World", followersCount = 1337 }
 --
 -- >>> project |> decrementField #followersCount
@@ -258,7 +282,7 @@ forEach elements function = forM_ elements function
 --
 -- > printUser :: (Int, User) -> IO ()
 -- > printUser (index, user) = putStrLn (tshow index <> ": " <> tshow user)
--- > 
+-- >
 -- > forEachWithIndex users printUser
 --
 -- __Example:__ Within HSX
@@ -410,4 +434,4 @@ instance (CopyFields rest destinationRecord sourceRecord
 --
 allEnumValues :: forall enumType. Enum enumType => [enumType]
 allEnumValues = enumFrom (toEnum 0)
-{-# INLINABLE allEnumValues #-}
+{-# INLINABLE allEnumValues #-}

Test/HaskellSupportSpec.hs

@@ -14,7 +14,7 @@ tests = do
             it "should deal with empty input" do
                 stripTags "" `shouldBe` ""
 
-            it "should strip html tags and return the plain text" do 
+            it "should strip html tags and return the plain text" do
                 stripTags "This is <b>Bold</b>" `shouldBe` "This is Bold"
 
         describe "copyFields" do
@@ -30,13 +30,31 @@ tests = do
             it "should return all enum values" do
                 (allEnumValues @Color) `shouldBe` [Yellow, Red, Blue]
 
+        describe "setMaybe" do
+            it "should set a Just value" do
+                let c = RecordC { field = Nothing }
+                let c' = c |> setMaybe #field (Just 1)
+
+                c' `shouldBe` RecordC { field = Just 1 }
+
+            it "should not set a Nothing value" do
+                let c = RecordC { field = Just 1 }
+                let c' = c |> setMaybe #field Nothing
+
+                c' `shouldBe` RecordC { field = Just 1 }
+
+
 data RecordA = RecordA { fieldA :: Int, fieldB :: Text } deriving (Eq, Show)
-data RecordB = RecordB { fieldA :: Int, fieldB :: Text} deriving (Eq, Show)
+data RecordB = RecordB { fieldA :: Int, fieldB :: Text } deriving (Eq, Show)
+data RecordC = RecordC { field :: Maybe Int } deriving (Eq, Show)
 
 instance SetField "fieldA" RecordB Int where
     setField value record = record { fieldA = value }
 
 instance SetField "fieldB" RecordB Text where
     setField value record = record { fieldB = value }
 
-data Color = Yellow | Red | Blue deriving (Enum, Show, Eq)
+instance SetField "field" RecordC (Maybe Int) where
+    setField value record = record { field = value }
+
+data Color = Yellow | Red | Blue deriving (Enum, Show, Eq)