aeson-diff 1.0.0.1 → 1.1.0.0

raw patch · 8 files changed

+87/−29 lines, 8 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +9/−0
• README.md +3/−1
• aeson-diff.cabal +1/−1
• lib/Data/Aeson/Diff.hs +47/−24
• lib/Data/Aeson/Patch.hs +10/−0
• src/diff.hs +3/−1
• stack.yaml +2/−2
• test/properties.hs +12/−0

@@ -1,3 +1,12 @@+aeson-diff 1.1.0.0++    * aeson-diff can now, optionally, generate a test operation before each+      remove.++    * Add '--test-before-remove' option to 'json-diff' command.++    * Add 'Config' type and 'diff'' to allow optional behaviours.+ aeson-diff 1.0.0.1      * Remove the `patch'` function before anyone gets attached to it.

@@ -50,11 +50,13 @@ describing the differences between the first document and the second.  ````-Usage: json-diff [-o|--output OUTPUT] FROM TO+Usage: json-diff [-T|--test-before-remove] [-o|--output OUTPUT] FROM TO Generate a patch between two JSON documents.  Available options:     -h,--help                Show this help text+    -T,--test-before-remove  Include a test before each remove.+    -o,--output OUTPUT       Write patch to file OUTPUT. ````  ### json-patch command

@@ -1,5 +1,5 @@ name:                aeson-diff-version:             1.0.0.1+version:             1.1.0.0 synopsis:            Extract and apply patches to JSON documents. description:   .

@@ -13,9 +13,11 @@     Pointer,     Key(..),     Operation(..),+    Config(..),      -- * Functions     diff,+    diff',     patch,     applyOperation, ) where@@ -44,7 +46,14 @@ import Data.Aeson.Patch import Data.Aeson.Pointer +data Config = Config+  { configTstBeforeRem :: Bool+  } +defaultConfig :: Config+defaultConfig = Config False++-- | Calculate the cost of an operation. operationCost :: Operation -> Int operationCost op =     case op of@@ -74,30 +83,43 @@ -- * Atomic patches  -- | Construct a patch with a single 'Add' operation.-ins :: Path -> Value -> Patch-ins p v = Patch [Add (Pointer p) v]+ins :: Config -> Path -> Value -> [Operation]+ins cfg p v = [Add (Pointer p) v]  -- | Construct a patch with a single 'Rem' operation.-del :: Path -> Value -> Patch-del p v = Patch [Rem (Pointer p)]+del :: Config -> Path -> Value -> [Operation]+del Config{..} p v =+  if configTstBeforeRem+  then [Tst (Pointer p) v, Rem (Pointer p)]+  else [Rem (Pointer p)]  -- | Construct a patch which changes 'Rep' operation.-rep :: Path -> Value -> Patch-rep p v = Patch [Rep (Pointer p) v]+rep :: Path -> Value -> [Operation]+rep p v = [Rep (Pointer p) v]  -- * Operations  -- | Compare two JSON documents and generate a patch describing the differences.+--+-- Uses the 'defaultConfig'. diff-    :: Value+  :: Value+  -> Value+  -> Patch+diff = diff' defaultConfig++-- | Compare two JSON documents and generate a patch describing the differences.+diff'+    :: Config     -> Value+    -> Value     -> Patch-diff = worker []+diff' cfg@Config{..} v v' = Patch (worker [] v v')   where     check :: Monoid m => Bool -> m -> m     check b v = if b then mempty else v -    worker :: Path -> Value -> Value -> Patch+    worker :: Path -> Value -> Value -> [Operation]     worker p v1 v2 = case (v1, v2) of         -- For atomic values of the same type, emit changes iff they differ.         (Null,      Null)      -> mempty@@ -113,43 +135,44 @@         _                      -> rep p v2      -- Walk the keys in two objects, producing a 'Patch'.-    workObject :: Path -> Object -> Object -> Patch+    workObject :: Path -> Object -> Object -> [Operation]     workObject path o1 o2 =         let k1 = HM.keys o1             k2 = HM.keys o2             -- Deletions+            del_keys :: [Text]             del_keys = filter (not . (`elem` k2)) k1-            deletions = Patch $ fmap-                (\k -> Rem (Pointer [OKey k]))+            deletions :: [Operation]+            deletions = concatMap+                (\k -> del cfg [OKey k] (fromJust $ HM.lookup k o1))                 del_keys             -- Insertions             ins_keys = filter (not . (`elem` k1)) k2-            insertions = Patch $ fmap-                (\k -> Add (Pointer [OKey k]) . fromJust $ HM.lookup k o2)+            insertions :: [Operation]+            insertions = concatMap+                (\k -> ins cfg [OKey k] (fromJust $ HM.lookup k o2))                 ins_keys             -- Changes             chg_keys = filter (`elem` k2) k1-            changes = fmap+            changes :: [Operation]+            changes = concatMap                 (\k -> worker [OKey k]                     (fromJust $ HM.lookup k o1)                     (fromJust $ HM.lookup k o2))                 chg_keys-        in Patch . fmap (modifyPath (path <>)) . patchOperations $ (deletions <> insertions <> mconcat changes)+        in modifyPath (path <>) <$> (deletions <> insertions <> changes)      -- Use an adaption of the Wagner-Fischer algorithm to find the shortest     -- sequence of changes between two JSON arrays.-    workArray :: Path -> Array -> Array -> Patch-    workArray path ss tt = Patch . fmap (modifyPath (path <>)) . snd . fmap concat $ leastChanges params ss tt+    workArray :: Path -> Array -> Array -> [Operation]+    workArray path ss tt = fmap (modifyPath (path <>)) . snd . fmap concat $ leastChanges params ss tt       where         params :: Params Value [Operation] (Sum Int)         params = Params{..}         equivalent = (==)-        delete i v = [Rem (Pointer [AKey i])]-        insert i v = [Add (Pointer [AKey i]) v]-        substitute i v v' =-            let p = [AKey i]-                Patch ops = diff v v'-            in fmap (modifyPath (p <>)) ops+        delete i = del cfg [AKey i]+        insert i = ins cfg [AKey i]+        substitute i = worker [AKey i]         cost = Sum . sum . fmap operationCost         -- Position is advanced by grouping operations with same "head" index:         -- + groups of many operations advance one

@@ -5,6 +5,8 @@ module Data.Aeson.Patch (   Patch(..),   Operation(..),+  isRem,+  isTst, ) where  import           Control.Applicative@@ -54,6 +56,14 @@     | Tst { changePointer :: Pointer, changeValue :: Value }     -- ^ http://tools.ietf.org/html/rfc6902#section-4.6   deriving (Eq, Show)++isRem :: Operation -> Bool+isRem Rem{} = True+isRem _ = False++isTst :: Operation -> Bool+isTst Tst{} = True+isTst _ = False  instance ToJSON Operation where     toJSON (Add p v) = object

@@ -43,6 +43,7 @@         (  long "output"         <> short 'o'         <> metavar "OUTPUT"+        <> help "Write patch to file OUTPUT."         <> value Nothing         )     <*> argument fileP@@ -94,7 +95,8 @@ process Configuration{..} = do     json_from <- jsonFile cfgFrom     json_to <- jsonFile cfgTo-    let p = diff json_from json_to+    let c = Config cfgTst+    let p = diff' c json_from json_to     BS.hPutStrLn cfgOut $ BSL.toStrict (encode p)  main :: IO ()

@@ -1,5 +1,5 @@-resolver: lts-5.11+resolver: lts-6.7 extra-deps:-- edit-distance-vector-1.0.0.3+- edit-distance-vector-1.0.0.4 flags: {} extra-package-dbs: []

@@ -21,6 +21,7 @@ import           Test.QuickCheck.Instances  ()  import Data.Aeson.Diff+import Data.Aeson.Patch  showIt :: Value -> String showIt = BL.unpack . encode@@ -114,6 +115,17 @@     -> Bool prop_diff_objects (AnObject m1) (AnObject m2) =     diffApply m1 m2++-- | Check that 'Rem' always preceded by a 'Tst'.+prop_tst_before_rem+  :: Wellformed Value+  -> Wellformed Value+  -> Bool+prop_tst_before_rem (Wellformed f) (Wellformed t) =+  let ops = zip [1..] (patchOperations $ diff' (Config True) f t)+      rs = map fst . filter (isRem . snd) $ ops+      ts = map fst . filter (isTst . snd) $ ops+  in (length rs <= length ts) && all (\r -> (r - 1) `elem` ts) rs  -- -- Use Template Haskell to automatically run all of the properties above.