Merge pull request #5 from garyb/more-migrations

Add some more migration codecs

Author: garyb

src/Data/Codec/Argonaut/Migration.purs

@@ -1,24 +1,35 @@
-module Data.Codec.Argonaut.Migration where
+module Data.Codec.Argonaut.Migration
+  ( addDefaultField
+  , updateField
+  , addDefaultOrUpdateField
+  , renameField
+  ) where
 
 import Prelude
 
 import Data.Argonaut.Core as J
 import Data.Codec (basicCodec)
 import Data.Codec.Argonaut (JsonCodec)
-import Data.Maybe (Maybe(..), maybe)
+import Data.Maybe (Maybe(..), maybe, fromMaybe)
 import Data.Tuple (uncurry)
 import Data.StrMap as SM
 
 -- | When dealing with a JSON object that may be missing a field, this codec
 -- | can be used to alter the JSON before parsing to ensure a default value is
 -- | present instead.
 addDefaultField ∷ String → J.Json → JsonCodec J.Json
-addDefaultField field defaultValue = basicCodec (pure <<< dec) id
-  where
-  dec ∷ J.Json → J.Json
-  dec j = J.foldJsonObject j (J.fromObject <<< setDefault) j
-  setDefault ∷ J.JObject → J.JObject
-  setDefault = SM.alter (maybe (Just defaultValue) Just) field
+addDefaultField field = addDefaultOrUpdateField field <<< fromMaybe
+
+-- | Re-maps the value of a field in a JSON object.
+updateField ∷ String → (J.Json → J.Json) → JsonCodec J.Json
+updateField field = alterField field <<< map
+
+-- | When dealing with a JSON object that may be missing a field, this codec
+-- | can be used to alter the JSON before parsing to ensure a default value is
+-- | present instead. Similar to `addDefaultField`, but allows existing values
+-- | to be modified also.
+addDefaultOrUpdateField ∷ String → (Maybe J.Json → J.Json) → JsonCodec J.Json
+addDefaultOrUpdateField field = alterField field <<< map Just
 
 -- | When dealing with a JSON object that has had a field name changed, this
 -- | codec can be used to alter the JSON before parsing to ensure the new field
@@ -30,3 +41,11 @@ renameField oldName newName = basicCodec (pure <<< dec) id
   dec j = J.foldJsonObject j (J.fromObject <<< rename) j
   rename ∷ J.JObject → J.JObject
   rename obj = maybe obj (uncurry (SM.insert newName)) (SM.pop oldName obj)
+
+alterField ∷ String → (Maybe J.Json → Maybe J.Json) → JsonCodec J.Json
+alterField field f = basicCodec (pure <<< dec) id
+  where
+  dec ∷ J.Json → J.Json
+  dec j = J.foldJsonObject j (J.fromObject <<< setDefault) j
+  setDefault ∷ J.JObject → J.JObject
+  setDefault = SM.alter f field

test/Test/Migration.purs

@@ -8,7 +8,7 @@ import Data.Codec ((<~<))
 import Data.Codec.Argonaut.Common as JA
 import Data.Codec.Argonaut.Migration as JAM
 import Data.Either (Either(..))
-import Data.Maybe (Maybe(..))
+import Data.Maybe (Maybe(..), fromMaybe, maybe)
 import Data.String.Gen (genAsciiString)
 import Data.StrMap as SM
 import Test.QuickCheck (Result(..), QC, quickCheck, (===))
@@ -23,6 +23,15 @@ main = do
   log "Checking addDefaultField preserves an existing value if it's already present"
   quickCheck propDefaultFieldPreservesOriginal
 
+  log "Checking updateField updates an existing value if it's already present"
+  quickCheck propUpdateFieldAltersOriginal
+
+  log "Checking addDefaultOrUpdateField adds a field if it is missing"
+  quickCheck propAddDefaultOrUpdateField
+
+  log "Checking addDefaultOrUpdateField updates an existing value if it's already present"
+  quickCheck propAddDefaultOrUpdateFieldAltersOriginal
+
   log "Checking renameField renames a field"
   quickCheck propDefaultFieldPreservesOriginal
 
@@ -43,6 +52,32 @@ propDefaultFieldPreservesOriginal = do
   pure $ testMigrationCodec { key: missingKey, expectedValue, input }
     $ JA.jobject <~< JAM.addDefaultField missingKey unexpectedValue
 
+propUpdateFieldAltersOriginal ∷ Gen Result
+propUpdateFieldAltersOriginal = do
+  let expectedValue = J.fromString "it's here"
+  let unexpectedValue = J.fromString "it shouldn't be here"
+  updateKey ← genAsciiString
+  input ← SM.insert updateKey unexpectedValue <$> genJObject
+  pure $ testMigrationCodec { key: updateKey, expectedValue, input }
+    $ JA.jobject <~< JAM.updateField updateKey (const expectedValue)
+
+propAddDefaultOrUpdateField ∷ Gen Result
+propAddDefaultOrUpdateField = do
+  let expectedValue = J.fromString "it's here"
+  missingKey ← genAsciiString
+  input ← SM.delete missingKey <$> genJObject
+  pure $ testMigrationCodec { key: missingKey, expectedValue, input }
+    $ JA.jobject <~< JAM.addDefaultOrUpdateField missingKey (fromMaybe expectedValue)
+
+propAddDefaultOrUpdateFieldAltersOriginal ∷ Gen Result
+propAddDefaultOrUpdateFieldAltersOriginal = do
+  let expectedValue = J.fromString "it's here"
+  let unexpectedValue = J.fromString "it shouldn't be here"
+  updateKey ← genAsciiString
+  input ← SM.insert updateKey unexpectedValue <$> genJObject
+  pure $ testMigrationCodec { key: updateKey, expectedValue, input }
+    $ JA.jobject <~< JAM.addDefaultOrUpdateField updateKey (maybe unexpectedValue (const expectedValue))
+
 propRenameField ∷ Gen Result
 propRenameField = do
   let expectedValue = J.fromString "it's here"