aeson-diff-1.1.0.13/0000755000000000000000000000000007346545000012137 5ustar0000000000000000aeson-diff-1.1.0.13/CHANGELOG.md0000644000000000000000000000232207346545000013747 0ustar0000000000000000aeson-diff 1.1.0.5 * Support GHC-8.4.x in recent Stackage releases. aeson-diff 1.1.0.4 * Support GHC-8.4.x in recent Stackage releases. aeson-diff 1.1.0.4 * Resolve name clash that prevents building against aeson>=1.2 in Stackage Nightly. aeson-diff 1.1.0.3 * Relax upper bound on base dependency for Stackage LTS-9. 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. * Remove the 'Value' which was carried by the 'Rem' operation constructor. * Move 'Pointer' and 'Patch' types and operations into separate modules. aeson-diff 1.0 * aeson-diff now supports the operations and patch format described in RFC 6902. * The `patch` function now returns in the 'Result' monad from the aeson package. * Add a `patch'` function throws an exception instead. * The command line applications no longer pretend to support a non-JSON patch format. aeson-diff 0.1 * Initial release. aeson-diff-1.1.0.13/LICENSE0000644000000000000000000000242707346545000013151 0ustar0000000000000000Copyright (c) 2014, Thomas Sutton All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. aeson-diff-1.1.0.13/README.md0000644000000000000000000000560307346545000013422 0ustar0000000000000000Aeson Diff ========== [![Build Status][badge]][status] [![Hackage](https://img.shields.io/hackage/v/aeson-diff.svg?maxAge=2592000)](https://hackage.haskell.org/package/aeson-diff) [![Hackage-Deps](https://img.shields.io/hackage-deps/v/aeson-diff.svg?maxAge=2592000)]() This is a small library for working with changes to JSON documents. It includes a library and two executables in the style of diff(1) and patch(1). Patches are themselves JSON Patch documents as specified in [RFC 6902][3]. Installing ---------- The `aeson-diff` package is written in Haskell and can be installed using the [Cabal][1] package management tool, [stack][2], or something similar. ````bash stack install aeson-diff ```` The command-line tools can then be executed using stack: ```` stack exec json-diff -- .... stack exec json-patch -- .... ```` If you prefer to use Cabal, something like this might do the trick: ````bash cd aeson-diff/ cabal sandbox init cabal install --dependencies-only cabal build sudo mkdir -p /usr/local/bin sudo cp dist/build/json-*/json-{diff,patch} /usr/local/bin/ ```` Usage ----- ### Patch format `aeson-diff` supports the JSON Patch format described in [RFC 6902][3]. ### json-diff command The `json-diff` command compares two JSON documents and extracts a patch describing the differences between the first document and the second. ```` 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 The `json-patch` command applies a patch describing changes to be made to a JSON document. ```` Usage: json-patch [-o|--output OUTPUT] PATCH FROM Generate a patch between two JSON documents. Available options: -h,--help Show this help text -o,--output OUTPUT Destination for patched JSON. PATCH Patch to apply. FROM JSON file to patch. ```` ### aeson-diff library The `aeson-diff` library exports as single module: `Data.Aeson.Diff`. This exports `diff` and `patch` functions which do exactly what might be expected: - `diff :: Value -> Value -> Patch` examines source and target JSON `Value`s and constructs a new `Patch` describing the changes. - `patch :: Patch -> Value -> Result Value` applies the changes in a `Patch` to a JSON `Value`. If an error results then an exception is thrown. For more complete information, see the [documentation][docs]. [badge]: https://travis-ci.org/thsutton/aeson-diff.svg?branch=master [status]: https://travis-ci.org/thsutton/aeson-diff [docs]: https://hackage.haskell.org/package/aeson-diff/docs/Data-Aeson-Diff.html [1]: https://wiki.haskell.org/Cabal-Install [2]: http://haskellstack.org/ [3]: http://tools.ietf.org/html/rfc6902 aeson-diff-1.1.0.13/Setup.hs0000644000000000000000000000017407346545000013575 0ustar0000000000000000import Distribution.Extra.Doctest (defaultMainWithDoctests) main :: IO () main = defaultMainWithDoctests "doctests" aeson-diff-1.1.0.13/aeson-diff.cabal0000644000000000000000000000661607346545000015147 0ustar0000000000000000name: aeson-diff version: 1.1.0.13 synopsis: Extract and apply patches to JSON documents. description: . This is a small library for working with changes to JSON documents. It includes a library and two command-line executables in the style of the diff(1) and patch(1) commands available on many systems. . homepage: https://github.com/ysangkok/aeson-diff license: BSD3 license-file: LICENSE author: Thomas Sutton maintainer: Janus Troelsen copyright: (c) 2015 Thomas Sutton and others. category: JSON, Web, Algorithms build-type: Custom cabal-version: 2.0 extra-source-files: README.md , CHANGELOG.md , stack.yaml , test/data/rfc6902/*.json , test/data/rfc6902/*.txt , test/data/cases/*.json , test/data/cases/*.txt source-repository HEAD type: git location: https://github.com/ysangkok/aeson-diff library default-language: Haskell2010 hs-source-dirs: lib exposed-modules: Data.Aeson.Diff , Data.Aeson.Patch , Data.Aeson.Pointer build-depends: base >=4.11.1 && <4.17 , aeson >= 2.0.3 , bytestring >= 0.10 , edit-distance-vector , scientific , text , vector executable json-diff default-language: Haskell2010 hs-source-dirs: src main-is: diff.hs other-modules: Codec build-depends: base , aeson >= 2.0.3 , aeson-diff , bytestring , optparse-applicative , yaml executable json-patch default-language: Haskell2010 hs-source-dirs: src main-is: patch.hs other-modules: Codec build-depends: base , aeson >= 2.0.3 , aeson-diff , bytestring , optparse-applicative , yaml test-suite properties default-language: Haskell2010 type: exitcode-stdio-1.0 hs-source-dirs: test main-is: properties.hs build-depends: base , QuickCheck , aeson >= 2.0.3 , aeson-diff , bytestring , vector test-suite examples default-language: Haskell2010 type: exitcode-stdio-1.0 hs-source-dirs: test main-is: examples.hs build-depends: base , Glob , aeson >= 2.0.3 , aeson-diff , bytestring , directory , filepath test-suite doctests default-language: Haskell2010 hs-source-dirs: test type: exitcode-stdio-1.0 ghc-options: -threaded main-is: doctests.hs build-depends: base , doctest >= 0.18.2 other-modules: Build_doctests autogen-modules: Build_doctests custom-setup setup-depends: base >= 4 && <5, cabal-doctest >= 1 && <1.1, Cabal < 4 aeson-diff-1.1.0.13/lib/Data/Aeson/0000755000000000000000000000000007346545000014623 5ustar0000000000000000aeson-diff-1.1.0.13/lib/Data/Aeson/Diff.hs0000644000000000000000000003447207346545000016041 0ustar0000000000000000{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} -- | Description: Extract and apply patches on JSON documents. -- -- This module implements data types and operations to represent the -- differences between JSON documents (i.e. a patch), to compare JSON documents -- and extract such a patch, and to apply such a patch to a JSON document. module Data.Aeson.Diff ( -- * Patches Patch(..), Pointer, Key(..), Operation(..), Config(..), -- * Functions diff, diff', patch, applyOperation, ) where import Control.Monad (unless) import Data.Aeson (Array, Object, Result(Success, Error), Value(Array, Object, String, Null, Bool, Number)) import qualified Data.Aeson.Key as AesonKey import qualified Data.Aeson.KeyMap as HM import Data.Foldable (foldlM) import Data.List (groupBy) import Data.Maybe (fromJust) import Data.Monoid (Sum(Sum)) import qualified Data.Text as T import Data.Vector (Vector) import qualified Data.Vector as V import Data.Vector.Distance (Params(Params, equivalent, positionOffset, substitute, insert, delete, cost), leastChanges) import Data.Aeson.Patch (Operation(Add, Cpy, Mov, Rem, Rep, Tst), Patch(Patch), changePointer, changeValue, modifyPointer) import Data.Aeson.Pointer (Key(AKey, OKey), Pointer(Pointer), formatPointer, get, pointerFailure, pointerPath) -- * Configuration -- | Configuration for the diff algorithm. newtype Config = Config { configTstBeforeRem :: Bool } defaultConfig :: Config defaultConfig = Config False -- * Costs -- | Calculate the cost of an operation. operationCost :: Operation -> Int operationCost op = case op of Add{} -> valueSize (changeValue op) Rem{} -> 1 Rep{} -> valueSize (changeValue op) Mov{} -> 1 Cpy{} -> 1 Tst{} -> valueSize (changeValue op) -- | Estimate the size of a JSON 'Value'. valueSize :: Value -> Int valueSize val = case val of Object o -> sum . fmap valueSize . HM.elems $ o Array a -> V.sum $ V.map valueSize a _ -> 1 -- * Atomic patches -- | Construct a patch with a single 'Add' operation. ins :: Config -> Pointer -> Value -> [Operation] ins _cfg p v = [Add p v] -- | Construct a patch with a single 'Rem' operation. del :: Config -> Pointer -> Value -> [Operation] del Config{configTstBeforeRem} p v = if configTstBeforeRem then [Tst p v, Rem p] else [Rem p] -- | Construct a patch which changes 'Rep' operation. rep :: Config -> Pointer -> Value -> [Operation] rep _cfg p v = [Rep p v] -- * Diff -- | Compare two JSON documents and generate a patch describing the differences. -- -- Uses the 'defaultConfig'. diff :: Value -> Value -> Patch diff = diff' defaultConfig -- | Compare two JSON documents and generate a patch describing the differences. diff' :: Config -> Value -> Value -> Patch diff' cfg v v' = Patch (worker mempty v v') where check :: Monoid m => Bool -> m -> m check b v = if b then mempty else v worker :: Pointer -> 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 (Bool b1, Bool b2) -> check (b1 == b2) $ rep cfg p v2 (Number n1, Number n2) -> check (n1 == n2) $ rep cfg p v2 (String s1, String s2) -> check (s1 == s2) $ rep cfg p v2 -- For structured values of the same type, walk them. (Array a1, Array a2) -> check (a1 == a2) $ workArray p a1 a2 (Object o1, Object o2) -> check (o1 == o2) $ workObject p o1 o2 -- For values of different types, replace v1 with v2. _ -> rep cfg p v2 -- Walk the keys in two objects, producing a 'Patch'. workObject :: Pointer -> Object -> Object -> [Operation] workObject path o1 o2 = let k1 = HM.keys o1 k2 = HM.keys o2 -- Deletions del_keys :: [AesonKey.Key] del_keys = filter (not . (`elem` k2)) k1 deletions :: [Operation] deletions = concatMap (\k -> del cfg (Pointer [OKey k]) (fromJust $ HM.lookup k o1)) del_keys -- Insertions ins_keys = filter (not . (`elem` k1)) k2 insertions :: [Operation] insertions = concatMap (\k -> ins cfg (Pointer [OKey k]) (fromJust $ HM.lookup k o2)) ins_keys -- Changes chg_keys = filter (`elem` k2) k1 changes :: [Operation] changes = concatMap (\k -> worker (Pointer [OKey k]) (fromJust $ HM.lookup k o1) (fromJust $ HM.lookup k o2)) chg_keys in modifyPointer (path <>) <$> (deletions <> insertions <> changes) -- Use an adaption of the Wagner-Fischer algorithm to find the shortest -- sequence of changes between two JSON arrays. workArray :: Pointer -> Array -> Array -> [Operation] workArray path ss tt = fmap (modifyPointer (path <>)) . snd . fmap concat $ leastChanges params ss tt where params :: Params Value [Operation] (Sum Int) params = Params{equivalent, delete, insert, substitute, cost, positionOffset} equivalent :: Value -> Value -> Bool equivalent = (==) delete i = del cfg (Pointer [AKey i]) insert i = ins cfg (Pointer [AKey i]) substitute i = worker (Pointer [AKey i]) cost :: [Operation] -> Sum Int cost = Sum . sum . fmap operationCost -- Position is advanced by grouping operations with same "head" index: -- + groups of many operations advance one -- + singletons with |pointer|>1 advance one -- + other singletons advance according to 'pos' positionOffset = sum . fmap adv . groupBy related related :: Operation -> Operation -> Bool related o1 o2 = let p1 = pointerPath (changePointer o1) p2 = pointerPath (changePointer o2) in case (p1, p2) of ([_], [_]) -> False (i1:_, i2:_) | i1 == i2 -> True | otherwise -> False -- A group of operations has a peculiar (i.e. given by 'pos') advance -- when it's a single op and |changePointer| = 1; otherwise it's a -- bunch of changes inside the head key. adv :: [Operation] -> Int adv [op] | (length . pointerPath . changePointer $ op) == 1 = pos op adv _ = 1 pos :: Operation -> Int pos Rem{changePointer=Pointer path} | length path == 1 = 0 | otherwise = 0 pos Add{changePointer=Pointer path} | length path == 1 = 1 | otherwise = 0 pos Rep{changePointer=Pointer path} | length path == 1 = 1 | otherwise = 0 pos Cpy{changePointer=Pointer path} | length path == 1 = 1 | otherwise = 0 pos Mov{changePointer=Pointer path} | length path == 1 = 1 | otherwise = 0 pos Tst{changePointer=Pointer _path} = 0 -- * Patching -- | Apply a patch to a JSON document. patch :: Patch -> Value -> Result Value patch (Patch []) val = return val patch (Patch ops) val = foldlM (flip applyOperation) val ops -- | Apply an 'Operation' to a 'Value'. applyOperation :: Operation -> Value -> Result Value applyOperation op json = case op of Add path v' -> applyAdd path v' json Rem path -> applyRem path json Rep path v' -> applyRep path v' json Tst path v -> applyTst path v json Cpy path from -> applyCpy path from json Mov path from -> applyMov path from json -- | Apply an 'Add' operation to a document. -- -- http://tools.ietf.org/html/rfc6902#section-4.1 -- -- - An empty 'Path' replaces the document. -- - A single 'OKey' inserts or replaces the corresponding member in an object. -- - A single 'AKey' inserts at the corresponding location. -- - Longer 'Paths' traverse if they can and fail otherwise. applyAdd :: Pointer -> Value -> Value -> Result Value applyAdd pointer = go pointer where go (Pointer []) val _ = return val go (Pointer [AKey i]) v' (Array v) = return (Array $ vInsert i v' v) go (Pointer (AKey i : path)) v' (Array v) = let fn :: Maybe Value -> Result (Maybe Value) fn Nothing = cannot "insert" "array" i pointer fn (Just d) = Just <$> go (Pointer path) v' d in Array <$> vModify i fn v go (Pointer [OKey n]) v' (Object m) = return . Object $ HM.insert n v' m go (Pointer (OKey n : path)) v' (Object o) = let fn :: Maybe Value -> Result (Maybe Value) fn Nothing = cannot "insert" "object" n pointer fn (Just d) = Just <$> go (Pointer path) v' d in Object <$> hmModify n fn o go (Pointer (OKey n : path)) v' array@(Array v) | n == "-" = go (Pointer (AKey (V.length v) : path)) v' array go path _ v = pointerFailure path v -- | Apply a 'Rem' operation to a document. -- -- http://tools.ietf.org/html/rfc6902#section-4.2 -- -- - The target location MUST exist. applyRem :: Pointer -> Value -> Result Value applyRem from@(Pointer path) = go path where go [] _ = return Null go [AKey i] (Array v) = let fn :: Maybe Value -> Result (Maybe Value) fn Nothing = cannot "delete" "array" i from fn (Just _) = return Nothing in Array <$> vModify i fn v go (AKey i : path) (Array v) = let fn :: Maybe Value -> Result (Maybe Value) fn Nothing = cannot "traverse" "array" i from fn (Just o) = Just <$> go path o in Array <$> vModify i fn v go [OKey n] (Object m) = let fn :: Maybe Value -> Result (Maybe Value) fn Nothing = cannot "delete" "object" n from fn (Just _) = return Nothing in Object <$> hmModify n fn m go (OKey n : path) (Object m) = let fn :: Maybe Value -> Result (Maybe Value) fn Nothing = cannot "traverse" "object" n from fn (Just o) = Just <$> go path o in Object <$> hmModify n fn m -- Dodgy hack for "-" key which means "the end of the array". go (OKey n : path) array@(Array v) | n == "-" = go (AKey (V.length v) : path) array -- Type mismatch: clearly the thing we're deleting isn't here. go _path value = pointerFailure from value -- | Apply a 'Rep' operation to a document. -- -- http://tools.ietf.org/html/rfc6902#section-4.3 -- -- - Functionally identical to a 'Rem' followed by an 'Add'. applyRep :: Pointer -> Value -> Value -> Result Value applyRep from v doc = applyRem from doc >>= applyAdd from v -- | Apply a 'Mov' operation to a document. -- -- http://tools.ietf.org/html/rfc6902#section-4.4 applyMov :: Pointer -> Pointer -> Value -> Result Value applyMov path from doc = do v <- get from doc applyRem from doc >>= applyAdd path v -- | Apply a 'Cpy' operation to a document. -- -- http://tools.ietf.org/html/rfc6902#section-4.5 -- -- - The location must exist. -- - Identical to an add with the appropriate value. applyCpy :: Pointer -> Pointer -> Value -> Result Value applyCpy path from doc = do v <- get from doc applyAdd path v doc -- | Apply a 'Tst' operation to a document. -- -- http://tools.ietf.org/html/rfc6902#section-4.6 -- -- - The location must exist. -- - The value must be equal to the supplied value. applyTst :: Pointer -> Value -> Value -> Result Value applyTst path v doc = do v' <- get path doc unless (v == v') (Error . T.unpack $ "Element at \"" <> formatPointer path <> "\" fails test.") return doc -- * Utilities -- $ These are some utility functions used in the functions defined -- above. Mostly they just fill gaps in the APIs of the "Data.Vector" -- and "Data.Aeson.KeyMap" modules. -- | Delete an element in a vector. vDelete :: Int -> Vector a -> Vector a vDelete i v = let l = V.length v in V.slice 0 i v <> V.slice (i + 1) (l - i - 1) v -- | Insert an element into a vector. vInsert :: Int -> a -> Vector a -> Vector a vInsert i a v | i <= 0 = V.cons a v | V.length v <= i = V.snoc v a | otherwise = V.slice 0 i v <> V.singleton a <> V.slice i (V.length v - i) v -- | Modify the element at an index in a 'Vector'. -- -- The function is passed the value at index @i@, or 'Nothing' if there is no -- such element. The function should return 'Nothing' if it wants to have no -- value corresponding to the index, or 'Just' if it wants a value. -- -- Depending on the vector and the function, we will either: -- -- - leave the vector unchanged; -- - delete an existing element; -- - insert a new element; or -- - replace an existing element. vModify :: Int -> (Maybe a -> Result (Maybe a)) -> Vector a -> Result (Vector a) vModify i f v = let a = v V.!? i a' = f a in case (a, a') of (Nothing, Success Nothing ) -> return v (Just _ , Success Nothing ) -> return (vDelete i v) (Nothing, Success (Just n)) -> return (vInsert i n v) (Just _ , Success (Just n)) -> return (V.update v (V.singleton (i, n))) (_ , Error e ) -> Error e -- | Modify the value associated with a key in a 'KeyMap'. -- -- The function is passed the value defined for @k@, or 'Nothing'. If the -- function returns 'Nothing', the key and value are deleted from the map; -- otherwise the value replaces the existing value in the returned map. hmModify :: AesonKey.Key -> (Maybe v -> Result (Maybe v)) -> HM.KeyMap v -> Result (HM.KeyMap v) hmModify k f m = case f (HM.lookup k m) of Error e -> Error e Success Nothing -> return $ HM.delete k m Success (Just v) -> return $ HM.insert k v m -- | Report an error about being able to use a pointer key. cannot :: (Show ix) => String -- ^ Use to be made "delete", "traverse", etc. -> String -- ^ Type "array" "object" -> ix -> Pointer -> Result a cannot op ty ix p = Error ("Cannot " <> op <> " missing " <> ty <> " member at index " <> show ix <> " in pointer \"" <> T.unpack (formatPointer p) <> "\".") aeson-diff-1.1.0.13/lib/Data/Aeson/Patch.hs0000644000000000000000000001161707346545000016224 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} -- | Description: Represent RFC 6902 patches. module Data.Aeson.Patch ( Patch(..), Operation(..), -- * Modification modifyPointer, modifyPointers, -- * Predicates isAdd, isRem, isRep, isMov, isCpy, isTst, ) where import Control.Applicative ((<|>)) import Control.Monad (mzero) import Data.Aeson ((.:), (.=), FromJSON(parseJSON), ToJSON(toJSON), encode) import Data.Aeson.Types (Value(Array, Object, String), modifyFailure, object, typeMismatch) import qualified Data.ByteString.Lazy.Char8 as BS import qualified Data.Vector as V import GHC.Generics (Generic) import Data.Aeson.Pointer (Pointer) -- * Patches -- | Describes the changes between two JSON documents. newtype Patch = Patch { patchOperations :: [Operation] } deriving (Eq, Show, Semigroup, Monoid, Generic) instance ToJSON Patch where toJSON (Patch ops) = toJSON ops instance FromJSON Patch where parseJSON = modifyFailure ("Could not parse patch: " <> ) . parsePatch where parsePatch (Array v) = Patch <$> mapM parseJSON (V.toList v) parsePatch v = typeMismatch "Array" v -- | Modify the pointers in the 'Operation's of a 'Patch'. -- -- See 'modifyPointer' for details. modifyPointers :: (Pointer -> Pointer) -> Patch -> Patch modifyPointers f (Patch ops) = Patch (map (modifyPointer f) ops) -- * Operations -- | An 'Operation' describes the operations which can appear as part of a JSON -- Patch. -- -- See RFC 6902 Section 4 . data Operation = Add { changePointer :: Pointer, changeValue :: Value } -- ^ http://tools.ietf.org/html/rfc6902#section-4.1 | Cpy { changePointer :: Pointer, fromPointer :: Pointer } -- ^ http://tools.ietf.org/html/rfc6902#section-4.5 | Mov { changePointer :: Pointer, fromPointer :: Pointer } -- ^ http://tools.ietf.org/html/rfc6902#section-4.4 | Rem { changePointer :: Pointer } -- ^ http://tools.ietf.org/html/rfc6902#section-4.2 | Rep { changePointer :: Pointer, changeValue :: Value } -- ^ http://tools.ietf.org/html/rfc6902#section-4.3 | Tst { changePointer :: Pointer, changeValue :: Value } -- ^ http://tools.ietf.org/html/rfc6902#section-4.6 deriving (Eq, Show, Generic) instance ToJSON Operation where toJSON (Add p v) = object [ ("op", "add") , "path" .= p , "value" .= v ] toJSON (Cpy p f) = object [ ("op", "copy") , "path" .= p , "from" .= f ] toJSON (Mov p f) = object [ ("op", "move") , "path" .= p , "from" .= f ] toJSON (Rem p) = object [ ("op", "remove") , "path" .= p ] toJSON (Rep p v) = object [ ("op", "replace") , "path" .= p , "value" .= v ] toJSON (Tst p v) = object [ ("op", "test") , "path" .= p , "value" .= v ] instance FromJSON Operation where parseJSON = parse where parse o@(Object v) = (op v "add" *> (Add <$> v .: "path" <*> v .: "value")) <|> (op v "copy" *> (Cpy <$> v .: "path" <*> v .: "from")) <|> (op v "move" *> (Mov <$> v .: "path" <*> v .: "from")) <|> (op v "remove" *> (Rem <$> v .: "path")) <|> (op v "replace" *> (Rep <$> v .: "path" <*> v .: "value")) <|> (op v "test" *> (Tst <$> v .: "path" <*> v .: "value")) <|> fail ("Expected a JSON patch operation, encountered: " <> BS.unpack (encode o)) parse v = typeMismatch "Operation" v op v n = fixed v "op" (String n) fixed o n val = do v' <- o .: n if v' == val then return v' else mzero -- | Modify the 'Pointer's in an 'Operation'. -- -- If the operation contains multiple pointers (i.e. a 'Mov' or 'Cpy') -- then both will be modified. modifyPointer :: (Pointer -> Pointer) -> Operation -> Operation modifyPointer f op = case op of Add{..} -> op{ changePointer = f changePointer } Cpy{..} -> op{ changePointer = f changePointer, fromPointer = f fromPointer } Mov{..} -> op{ changePointer = f changePointer, fromPointer = f fromPointer } Rem{..} -> op{ changePointer = f changePointer } Rep{..} -> op{ changePointer = f changePointer } Tst{..} -> op{ changePointer = f changePointer } isAdd :: Operation -> Bool isAdd Add{} = True isAdd _ = False isCpy :: Operation -> Bool isCpy Cpy{} = True isCpy _ = False isMov :: Operation -> Bool isMov Mov{} = True isMov _ = False isRem :: Operation -> Bool isRem Rem{} = True isRem _ = False isRep :: Operation -> Bool isRep Rep{} = True isRep _ = False isTst :: Operation -> Bool isTst Tst{} = True isTst _ = False aeson-diff-1.1.0.13/lib/Data/Aeson/Pointer.hs0000644000000000000000000001173407346545000016605 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} -- | Description: JSON Pointers as described in RFC 6901. module Data.Aeson.Pointer ( Pointer(..), Key(..), Path, -- * Representing pointers formatPointer, parsePointer, -- * Using pointers get, pointerFailure, ) where import Data.Aeson (encode) import qualified Data.Aeson.Key (Key) import Data.Aeson.Key (fromText, toText) import qualified Data.Aeson.KeyMap as HM import Data.Aeson.Types (FromJSON(parseJSON), Parser, Result(Error), ToJSON(toJSON), Value(Array, Object, Number, String), modifyFailure) import qualified Data.ByteString.Lazy.Char8 as BS import Data.Char (isNumber) import Data.Scientific (toBoundedInteger) import Data.Text (Text) import qualified Data.Text as T import qualified Data.Vector as V import GHC.Generics (Generic) -- * Patch components -- | Path components to traverse a single layer of a JSON document. data Key = OKey Data.Aeson.Key.Key -- ^ Traverse a 'Value' with an 'Object' constructor. | AKey Int -- ^ Traverse a 'Value' with an 'Array' constructor. deriving (Eq, Ord, Show, Generic) instance ToJSON Key where toJSON (OKey t) = toJSON t toJSON (AKey a) = Number . fromInteger . toInteger $ a instance FromJSON Key where parseJSON (String t) = return . OKey . fromText $ t parseJSON (Number n) = case toBoundedInteger n of Nothing -> fail "A numeric key must be a positive whole number." Just n' -> return $ AKey n' parseJSON _ = fail "A key element must be a number or a string." formatKey :: Key -> Text formatKey (AKey i) = T.pack (show i) formatKey (OKey t) = T.concatMap esc $ toText t where esc :: Char -> Text esc '~' = "~0" esc '/' = "~1" esc c = T.singleton c -- * Pointers -- | A sequence of 'Key's forms a path through a JSON document. type Path = [Key] -- | Pointer to a location in a JSON document. -- -- Defined in RFC 6901 newtype Pointer = Pointer { pointerPath :: Path } deriving (Eq, Ord, Show, Semigroup, Monoid, Generic) -- | Format a 'Pointer' as described in RFC 6901. -- -- >>> formatPointer (Pointer []) -- "" -- >>> formatPointer (Pointer [OKey ""]) -- "/" -- >>> formatPointer (Pointer [OKey " "]) -- "/ " -- >>> formatPointer (Pointer [OKey "foo"]) -- "/foo" -- >>> formatPointer (Pointer [OKey "foo", AKey 0]) -- "/foo/0" -- >>> formatPointer (Pointer [OKey "a/b"]) -- "/a~1b" -- >>> formatPointer (Pointer [OKey "c%d"]) -- "/c%d" -- >>> formatPointer (Pointer [OKey "e^f"]) -- "/e^f" -- >>> formatPointer (Pointer [OKey "g|h"]) -- "/g|h" -- >>> formatPointer (Pointer [OKey "i\\j"]) -- "/i\\j" -- >>> formatPointer (Pointer [OKey "k\"l"]) -- "/k\"l" -- >>> formatPointer (Pointer [OKey "m~n"]) -- "/m~0n" formatPointer :: Pointer -> Text formatPointer (Pointer []) = "" formatPointer (Pointer path) = "/" <> T.intercalate "/" (formatKey <$> path) -- | Parse a 'Pointer' as described in RFC 6901. parsePointer :: Text -> Parser Pointer parsePointer t | T.null t = return (Pointer []) | otherwise = Pointer <$> mapM key (drop 1 $ T.splitOn "/" t) where step t | "0" `T.isPrefixOf` t = T.cons '~' (T.tail t) | "1" `T.isPrefixOf` t = T.cons '/' (T.tail t) | otherwise = T.cons '~' t unesc :: Text -> Text unesc t = let l = T.split (== '~') t in T.concat $ take 1 l <> fmap step (tail l) key t | T.null t = fail "JSON components must not be empty." | T.all isNumber t = return (AKey (read $ T.unpack t)) | otherwise = return . OKey . fromText $ unesc t instance ToJSON Pointer where toJSON pointer = String (formatPointer pointer) instance FromJSON Pointer where parseJSON = modifyFailure ("Could not parse JSON pointer: " <>) . parse where parse (String t) = parsePointer t parse _ = fail "A JSON pointer must be a string." -- | Follow a 'Pointer' through a JSON document as described in RFC 6901. get :: Pointer -> Value -> Result Value get (Pointer []) v = return v get (Pointer (AKey i : path)) (Array v) = maybe (fail "") return (v V.!? i) >>= get (Pointer path) get (Pointer (OKey n : path)) (Object v) = maybe (fail "") return (HM.lookup n v) >>= get (Pointer path) get pointer value = pointerFailure pointer value -- | Report an error while following a pointer. pointerFailure :: Pointer -> Value -> Result a pointerFailure (Pointer []) _value = Error "Cannot follow empty pointer. This is impossible." pointerFailure (Pointer path@(key:_)) value = Error . BS.unpack $ "Cannot follow pointer " <> pt <> ". Expected " <> ty <> " but got " <> doc where doc = encode value pt = encode path ty = case key of (AKey _) -> "array" (OKey _) -> "object" -- $setup -- >>> :set -XOverloadedStrings aeson-diff-1.1.0.13/src/0000755000000000000000000000000007346545000012726 5ustar0000000000000000aeson-diff-1.1.0.13/src/Codec.hs0000644000000000000000000000300007346545000014270 0ustar0000000000000000module Codec (encode, decode, ForceFormat (..)) where import qualified Data.Aeson as Aeson import qualified Data.Yaml as Yaml import qualified Data.ByteString.Lazy as BL import Control.Applicative ((<|>)) import Data.Char (toLower) import Data.List (isSuffixOf) data ForceFormat = ForceYaml | AutodetectFormat deriving (Show, Eq) isYamlPath :: [Char] -> Bool isYamlPath fn = ".yaml" `isSuffixOf` map toLower fn || ".yml" `isSuffixOf` map toLower fn isJsonPath :: [Char] -> Bool isJsonPath fn = ".json" `isSuffixOf` map toLower fn decode :: Aeson.FromJSON a => ForceFormat -> Maybe FilePath -> BL.ByteString -> Maybe a decode ForceYaml _ = decodeYamlFirst decode AutodetectFormat (Just fn) | isYamlPath fn = decodeYamlFirst decode AutodetectFormat (Just fn) | isJsonPath fn = Aeson.decode decode AutodetectFormat _ = decodeJsonFirst decodeYamlFirst :: Aeson.FromJSON a => BL.ByteString -> Maybe a decodeYamlFirst s = Yaml.decodeThrow (BL.toStrict s) <|> Aeson.decode s decodeJsonFirst :: Aeson.FromJSON a => BL.ByteString -> Maybe a decodeJsonFirst s = Aeson.decode s <|> Yaml.decodeThrow (BL.toStrict s) encode :: Aeson.ToJSON a => ForceFormat -> Maybe FilePath -> a -> BL.ByteString encode ForceYaml _ = BL.fromStrict . Yaml.encode encode AutodetectFormat (Just fn) | isYamlPath fn = BL.fromStrict . Yaml.encode encode AutodetectFormat _ = Aeson.encode aeson-diff-1.1.0.13/src/diff.hs0000644000000000000000000000671007346545000014176 0ustar0000000000000000{-# LANGUAGE RecordWildCards #-} module Main (main) where import Control.Exception (bracket) import Codec (encode, decode, ForceFormat(..)) import Data.Aeson (Value) import Data.Aeson.Diff (Config(Config), diff') import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy as BSL import Options.Applicative (fullDesc, info, execParser, helper, metavar, progDesc, argument, help, value, long, option, short, switch) import Options.Applicative.Types (Parser, readerAsk) import System.IO (Handle, IOMode(ReadMode, WriteMode), hClose, openFile, stdin, stdout) type File = Maybe FilePath -- | Command-line options. data DiffOptions = DiffOptions { optionTst :: Bool , optionOut :: File , optionFrom :: File , optionTo :: File , optionYaml :: Bool } data Configuration = Configuration { cfgOptions :: DiffOptions , cfgTst :: Bool , cfgOut :: Handle , cfgFrom :: Handle , cfgTo :: Handle } optionParser :: Parser DiffOptions optionParser = DiffOptions <$> switch ( long "test-before-remove" <> short 'T' <> help "Include a test before each remove." ) <*> option fileP ( long "output" <> short 'o' <> metavar "OUTPUT" <> help "Write patch to file OUTPUT." <> value Nothing ) <*> argument fileP ( metavar "FROM" ) <*> argument fileP ( metavar "TO" ) <*> switch ( long "yaml" <> help "Use yaml decoding and encoding." ) where fileP = do s <- readerAsk return $ case s of "-" -> Nothing _ -> Just s jsonFile :: Handle -> ForceFormat -> File -> IO Value jsonFile fp mformat mfilepath = do s <- BS.hGetContents fp case decode mformat mfilepath (BSL.fromStrict s) of Nothing -> case mformat of ForceYaml -> error "Could not parse as YAML" AutodetectFormat -> error "Could not parse file. Make sure the file contents and the extension correspond: i.e. use '.json' for JSON files." Just v -> return v run :: DiffOptions -> IO () run opt = bracket (load opt) close process where openr :: Maybe FilePath -> IO Handle openr Nothing = return stdin openr (Just p) = openFile p ReadMode openw :: Maybe FilePath -> IO Handle openw Nothing = return stdout openw (Just p) = openFile p WriteMode load :: DiffOptions -> IO Configuration load options@DiffOptions{..} = Configuration <$> pure options <*> pure optionTst <*> openw optionOut <*> openr optionFrom <*> openr optionTo close :: Configuration -> IO () close Configuration{..} = do hClose cfgOut hClose cfgFrom hClose cfgTo process :: Configuration -> IO () process Configuration{..} = do let mformat = if optionYaml cfgOptions then ForceYaml else AutodetectFormat json_from <- jsonFile cfgFrom mformat (optionFrom cfgOptions) json_to <- jsonFile cfgTo mformat (optionTo cfgOptions) let c = Config cfgTst let p = diff' c json_from json_to BS.hPutStrLn cfgOut $ BSL.toStrict (encode mformat (optionOut cfgOptions) p) main :: IO () main = execParser opts >>= run where opts = info (helper <*> optionParser) ( fullDesc <> progDesc "Generate a patch between two JSON documents.") aeson-diff-1.1.0.13/src/patch.hs0000644000000000000000000000635107346545000014366 0ustar0000000000000000{-# LANGUAGE RecordWildCards #-} module Main (main) where import Control.Exception (bracket) import Codec (decode, encode, ForceFormat(..)) import Data.Aeson (Result(Error, Success), Value, fromJSON) import Data.Aeson.Diff (patch) import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy as BSL import Options.Applicative (fullDesc, info, execParser, helper, metavar, progDesc, argument, help, value, long, option, short, switch) import Options.Applicative.Types (Parser, readerAsk) import System.IO (Handle, IOMode(ReadMode, WriteMode), hClose, openFile, stdin, stdout) type File = Maybe FilePath -- | Command-line options. data PatchOptions = PatchOptions { optionOut :: File -- ^ JSON destination , optionPatch :: File -- ^ Patch input , optionFrom :: File -- ^ JSON source , optionYaml :: Bool } data Configuration = Configuration { cfgOptions :: PatchOptions , cfgOut :: Handle , cfgPatch :: Handle , cfgFrom :: Handle } optionParser :: Parser PatchOptions optionParser = PatchOptions <$> option fileP ( long "output" <> short 'o' <> metavar "OUTPUT" <> help "Destination for patched JSON." <> value Nothing ) <*> argument fileP ( metavar "PATCH" <> help "Patch to apply." ) <*> argument fileP ( metavar "FROM" <> help "JSON file to patch." ) <*> switch ( long "yaml" <> help "Use yaml decoding and encoding." ) where fileP = do s <- readerAsk return $ case s of "-" -> Nothing _ -> Just s jsonRead :: Handle -> ForceFormat -> File -> IO Value jsonRead fp mformat mfilename = do s <- BS.hGetContents fp case decode mformat mfilename (BSL.fromStrict s) of Nothing -> error "Could not parse as JSON" Just v -> return v run :: PatchOptions -> IO () run opt = bracket (load opt) close process where openr :: Maybe FilePath -> IO Handle openr Nothing = return stdin openr (Just p) = openFile p ReadMode openw :: Maybe FilePath -> IO Handle openw Nothing = return stdout openw (Just p) = openFile p WriteMode load :: PatchOptions -> IO Configuration load PatchOptions{..} = Configuration <$> pure opt <*> openw optionOut <*> openr optionPatch <*> openr optionFrom close :: Configuration -> IO () close Configuration{..} = do hClose cfgPatch hClose cfgFrom hClose cfgOut process :: Configuration -> IO () process Configuration{..} = do let mformat = if optionYaml cfgOptions then ForceYaml else AutodetectFormat json_patch <- jsonRead cfgPatch mformat (optionPatch cfgOptions) json_from <- jsonRead cfgFrom mformat (optionFrom cfgOptions) case fromJSON json_patch >>= flip patch json_from of Error e -> error e Success d -> BS.hPutStrLn cfgOut $ BSL.toStrict (encode mformat (optionOut cfgOptions) d) main :: IO () main = execParser opts >>= run where opts = info (helper <*> optionParser) ( fullDesc <> progDesc "Generate a patch between two JSON documents.") aeson-diff-1.1.0.13/stack.yaml0000644000000000000000000000010207346545000014121 0ustar0000000000000000resolver: lts-19.1 extra-deps: [] flags: {} extra-package-dbs: [] aeson-diff-1.1.0.13/test/data/cases/0000755000000000000000000000000007346545000015125 5ustar0000000000000000aeson-diff-1.1.0.13/test/data/cases/case1-original.json0000644000000000000000000000013407346545000020614 0ustar0000000000000000[ [ 0, 1, 2, 3 ], [ "a", "b", "c" ] ] aeson-diff-1.1.0.13/test/data/cases/case1-patch.json0000644000000000000000000000040707346545000020112 0ustar0000000000000000[ { "path" : "/0/0", "op" : "remove" }, { "path" : "/0/0", "op" : "remove" }, { "value" : null, "path" : "/0/0", "op" : "add" }, { "path" : "/1", "value" : true, "op" : "add" } ] aeson-diff-1.1.0.13/test/data/cases/case1-result.json0000644000000000000000000000013707346545000020331 0ustar0000000000000000[ [ null, 2, 3 ], true, [ "a", "b", "c" ] ] aeson-diff-1.1.0.13/test/data/cases/case2-original.json0000644000000000000000000000007607346545000020622 0ustar0000000000000000[ [[null], []], {"":[-1]}, {"wut":{"":-1}} ] aeson-diff-1.1.0.13/test/data/cases/case2-patch.json0000644000000000000000000000035007346545000020110 0ustar0000000000000000[ {"op":"replace","path":"/0/0","value":{}}, {"op":"remove","path":"/0/1"}, {"op":"replace","path":"/1","value":[]}, {"op":"add","path":"/2/hello","value":[0]}, {"op":"replace","path":"/2/wut","value":[false]} ] aeson-diff-1.1.0.13/test/data/cases/case2-result.json0000644000000000000000000000004607346545000020331 0ustar0000000000000000[[{}],[],{"wut":[false],"hello":[0]}] aeson-diff-1.1.0.13/test/data/cases/case3-error.txt0000644000000000000000000000033307346545000020012 0ustar0000000000000000Could not parse patch: when expecting a Array, encountered Object instead Error in $: Could not parse patch: expected Array, encountered Object Error in $: Could not parse patch: expected Array, but encountered Object aeson-diff-1.1.0.13/test/data/cases/case3-original.json0000644000000000000000000000000307346545000020611 0ustar0000000000000000{} aeson-diff-1.1.0.13/test/data/cases/case3-patch.json0000644000000000000000000000003207346545000020106 0ustar0000000000000000{ "name" : "Hello" } aeson-diff-1.1.0.13/test/data/cases/case4-error.txt0000644000000000000000000000011607346545000020012 0ustar0000000000000000Cannot delete missing object member at index "missing" in pointer "/missing". aeson-diff-1.1.0.13/test/data/cases/case4-original.json0000644000000000000000000000001707346545000020617 0ustar0000000000000000{ "a": 1 } aeson-diff-1.1.0.13/test/data/cases/case4-patch.json0000644000000000000000000000005107346545000020110 0ustar0000000000000000[ {"op": "remove", "path": "/missing"} ] aeson-diff-1.1.0.13/test/data/cases/case5-error.txt0000644000000000000000000000007707346545000020021 0ustar0000000000000000Cannot delete missing array member at index 1 in pointer "/1". aeson-diff-1.1.0.13/test/data/cases/case5-original.json0000644000000000000000000000001407346545000020615 0ustar0000000000000000[ "hello" ] aeson-diff-1.1.0.13/test/data/cases/case5-patch.json0000644000000000000000000000004307346545000020112 0ustar0000000000000000[ {"op": "remove", "path": "/1"} ] aeson-diff-1.1.0.13/test/data/rfc6902/0000755000000000000000000000000007346545000015122 5ustar0000000000000000aeson-diff-1.1.0.13/test/data/rfc6902/a1-original.json0000644000000000000000000000002507346545000020115 0ustar0000000000000000{ "foo": "bar" } aeson-diff-1.1.0.13/test/data/rfc6902/a1-patch.json0000644000000000000000000000012407346545000017410 0ustar0000000000000000[ { "op": "add", "path": "/baz", "value": "qux" } ] aeson-diff-1.1.0.13/test/data/rfc6902/a1-result.json0000644000000000000000000000004707346545000017633 0ustar0000000000000000{ "baz": "qux", "foo": "bar" } aeson-diff-1.1.0.13/test/data/rfc6902/a10-original.json0000644000000000000000000000002507346545000020175 0ustar0000000000000000{ "foo": "bar" } aeson-diff-1.1.0.13/test/data/rfc6902/a10-patch.json0000644000000000000000000000017107346545000017472 0ustar0000000000000000[ { "op": "add", "path": "/child", "value": { "grandchild": {} } } ] aeson-diff-1.1.0.13/test/data/rfc6902/a10-result.json0000644000000000000000000000010407346545000017705 0ustar0000000000000000{ "child": { "grandchild": {} }, "foo": "bar" } aeson-diff-1.1.0.13/test/data/rfc6902/a11-original.json0000644000000000000000000000002507346545000020176 0ustar0000000000000000{ "foo": "bar" } aeson-diff-1.1.0.13/test/data/rfc6902/a11-patch.json0000644000000000000000000000015007346545000017470 0ustar0000000000000000[ { "op": "add", "path": "/baz", "value": "qux", "xyz": 123 } ] aeson-diff-1.1.0.13/test/data/rfc6902/a11-result.json0000644000000000000000000000004707346545000017714 0ustar0000000000000000{ "baz": "qux", "foo": "bar" } aeson-diff-1.1.0.13/test/data/rfc6902/a12-error.txt0000644000000000000000000000011207346545000017367 0ustar0000000000000000Cannot insert missing object member at index "baz" in pointer "/baz/bat". aeson-diff-1.1.0.13/test/data/rfc6902/a12-original.json0000644000000000000000000000002507346545000020177 0ustar0000000000000000{ "foo": "bar" } aeson-diff-1.1.0.13/test/data/rfc6902/a12-patch.json0000644000000000000000000000013007346545000017467 0ustar0000000000000000[ { "op": "add", "path": "/baz/bat", "value": "qux" } ] aeson-diff-1.1.0.13/test/data/rfc6902/a14-original.json0000644000000000000000000000003507346545000020202 0ustar0000000000000000{ "/": 9, "~1": 10 } aeson-diff-1.1.0.13/test/data/rfc6902/a14-patch.json0000644000000000000000000000012207346545000017472 0ustar0000000000000000[ { "op": "test", "path": "/~01", "value": 10 } ] aeson-diff-1.1.0.13/test/data/rfc6902/a14-result.json0000644000000000000000000000003507346545000017714 0ustar0000000000000000{ "/": 9, "~1": 10 } aeson-diff-1.1.0.13/test/data/rfc6902/a15-error.txt0000644000000000000000000000003607346545000017377 0ustar0000000000000000Element at "/~01" fails test. aeson-diff-1.1.0.13/test/data/rfc6902/a15-original.json0000644000000000000000000000003507346545000020203 0ustar0000000000000000{ "/": 9, "~1": 10 } aeson-diff-1.1.0.13/test/data/rfc6902/a15-patch.json0000644000000000000000000000012407346545000017475 0ustar0000000000000000[ { "op": "test", "path": "/~01", "value": "10" } ] aeson-diff-1.1.0.13/test/data/rfc6902/a16-original.json0000644000000000000000000000004507346545000020205 0ustar0000000000000000{ "foo": [ "bar" ] } aeson-diff-1.1.0.13/test/data/rfc6902/a16-patch.json0000644000000000000000000000020107346545000017472 0ustar0000000000000000[ { "op": "add", "path": "/foo/-", "value": [ "abc", "def" ] } ] aeson-diff-1.1.0.13/test/data/rfc6902/a16-result.json0000644000000000000000000000013707346545000017721 0ustar0000000000000000{ "foo": [ "bar", [ "abc", "def" ] ] } aeson-diff-1.1.0.13/test/data/rfc6902/a2-original.json0000644000000000000000000000006407346545000020121 0ustar0000000000000000{ "foo": [ "bar", "baz" ] } aeson-diff-1.1.0.13/test/data/rfc6902/a2-patch.json0000644000000000000000000000012607346545000017413 0ustar0000000000000000[ { "op": "add", "path": "/foo/1", "value": "qux" } ] aeson-diff-1.1.0.13/test/data/rfc6902/a2-result.json0000644000000000000000000000010307346545000017625 0ustar0000000000000000{ "foo": [ "bar", "qux", "baz" ] } aeson-diff-1.1.0.13/test/data/rfc6902/a3-original.json0000644000000000000000000000004707346545000020123 0ustar0000000000000000{ "baz": "qux", "foo": "bar" } aeson-diff-1.1.0.13/test/data/rfc6902/a3-patch.json0000644000000000000000000000007707346545000017421 0ustar0000000000000000[ { "op": "remove", "path": "/baz" } ] aeson-diff-1.1.0.13/test/data/rfc6902/a3-result.json0000644000000000000000000000002507346545000017631 0ustar0000000000000000{ "foo": "bar" } aeson-diff-1.1.0.13/test/data/rfc6902/a4-original.json0000644000000000000000000000010307346545000020115 0ustar0000000000000000{ "foo": [ "bar", "qux", "baz" ] } aeson-diff-1.1.0.13/test/data/rfc6902/a4-patch.json0000644000000000000000000000010107346545000017406 0ustar0000000000000000[ { "op": "remove", "path": "/foo/1" } ] aeson-diff-1.1.0.13/test/data/rfc6902/a4-result.json0000644000000000000000000000006407346545000017635 0ustar0000000000000000{ "foo": [ "bar", "baz" ] } aeson-diff-1.1.0.13/test/data/rfc6902/a5-original.json0000644000000000000000000000004707346545000020125 0ustar0000000000000000{ "baz": "qux", "foo": "bar" } aeson-diff-1.1.0.13/test/data/rfc6902/a5-patch.json0000644000000000000000000000013007346545000017411 0ustar0000000000000000[ { "op": "replace", "path": "/baz", "value": "boo" } ] aeson-diff-1.1.0.13/test/data/rfc6902/a5-result.json0000644000000000000000000000004707346545000017637 0ustar0000000000000000{ "baz": "boo", "foo": "bar" } aeson-diff-1.1.0.13/test/data/rfc6902/a6-original.json0000644000000000000000000000016307346545000020125 0ustar0000000000000000{ "foo": { "bar": "baz", "waldo": "fred" }, "qux": { "corge": "grault" } } aeson-diff-1.1.0.13/test/data/rfc6902/a6-patch.json0000644000000000000000000000014007346545000017413 0ustar0000000000000000[ { "from": "/foo/waldo", "op": "move", "path": "/qux/thud" } ] aeson-diff-1.1.0.13/test/data/rfc6902/a6-result.json0000644000000000000000000000016207346545000017636 0ustar0000000000000000{ "foo": { "bar": "baz" }, "qux": { "corge": "grault", "thud": "fred" } } aeson-diff-1.1.0.13/test/data/rfc6902/a7-original.json0000644000000000000000000000012507346545000020124 0ustar0000000000000000{ "foo": [ "all", "grass", "cows", "eat" ] } aeson-diff-1.1.0.13/test/data/rfc6902/a7-patch.json0000644000000000000000000000013107346545000017414 0ustar0000000000000000[ { "from": "/foo/1", "op": "move", "path": "/foo/3" } ] aeson-diff-1.1.0.13/test/data/rfc6902/a7-result.json0000644000000000000000000000012507346545000017636 0ustar0000000000000000{ "foo": [ "all", "cows", "eat", "grass" ] } aeson-diff-1.1.0.13/test/data/rfc6902/a8-original.json0000644000000000000000000000011507346545000020124 0ustar0000000000000000{ "baz": "qux", "foo": [ "a", 2, "c" ] } aeson-diff-1.1.0.13/test/data/rfc6902/a8-patch.json0000644000000000000000000000024507346545000017423 0ustar0000000000000000[ { "op": "test", "path": "/baz", "value": "qux" }, { "op": "test", "path": "/foo/1", "value": 2 } ] aeson-diff-1.1.0.13/test/data/rfc6902/a8-result.json0000644000000000000000000000011507346545000017636 0ustar0000000000000000{ "baz": "qux", "foo": [ "a", 2, "c" ] } aeson-diff-1.1.0.13/test/data/rfc6902/a9-error.txt0000644000000000000000000000003607346545000017322 0ustar0000000000000000Element at "/baz" fails test. aeson-diff-1.1.0.13/test/data/rfc6902/a9-original.json0000644000000000000000000000002507346545000020125 0ustar0000000000000000{ "baz": "qux" } aeson-diff-1.1.0.13/test/data/rfc6902/a9-patch.json0000644000000000000000000000012507346545000017421 0ustar0000000000000000[ { "op": "test", "path": "/baz", "value": "bar" } ] aeson-diff-1.1.0.13/test/0000755000000000000000000000000007346545000013116 5ustar0000000000000000aeson-diff-1.1.0.13/test/doctests.hs0000644000000000000000000000021007346545000015273 0ustar0000000000000000import Build_doctests (flags, pkgs, module_sources) import Test.DocTest main :: IO () main = doctest $ flags ++ pkgs ++ module_sources aeson-diff-1.1.0.13/test/examples.hs0000644000000000000000000001155407346545000015276 0ustar0000000000000000{-# LANGUAGE TupleSections #-} -- | Test examples from RFC 6902 sections A.1 to A.16. module Main (main) where import Control.Exception (AssertionFailed(AssertionFailed), IOException, catch, try, throw) import Control.Monad (when) import Data.Aeson (Result(Success, Error), Value, decodeStrict, eitherDecodeStrict, encode) import Data.Aeson.Diff (Patch, patch) import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BC import qualified Data.ByteString.Lazy.Char8 as BL import Data.Char (isSpace) import Data.List (isInfixOf, nub) import Data.Maybe (isJust) import System.Directory (getDirectoryContents) import System.Environment (getArgs) import System.Exit (exitFailure) import System.FilePath (()) import System.FilePath.Glob (compile, match, simplify) roots :: [FilePath] roots = ["test/data/rfc6902", "test/data/cases"] globPattern :: FilePath globPattern = "*.*" derp :: String -> a derp msg = throw (AssertionFailed $ " " <> msg) readDocument :: FilePath -> FilePath -> IO Value readDocument root name = do let file = root name <> "-original.json" doc <- eitherDecodeStrict <$> BS.readFile file return $ either (\e -> derp $ "Could not decode document: " <> e) id doc readPatch :: FilePath -> FilePath -> IO (Either String Patch) readPatch root name = do let file = root name <> "-patch.json" eitherDecodeStrict <$> BS.readFile file readResult :: FilePath -> FilePath -> IO (Either String Value) readResult root name = do let err_path = root name <> "-error.txt" let doc_path = root name <> "-result.json" err <- catch (Just . BC.unpack . BC.dropWhile isSpace . fst . BC.spanEnd isSpace <$> BS.readFile err_path) handle doc <- catch (decodeStrict <$> BS.readFile doc_path) handle case (err, doc) of (Nothing, Just d) -> return (Right d) (Just er, Nothing) -> return (Left er) (Just _er, Just _) -> derp "Expecting both error and success" (Nothing, Nothing) -> derp "No result defined; add `*-error.txt' or `*-result.json'" where handle :: IOException -> IO (Maybe a) handle _ = return Nothing readExample :: FilePath -> FilePath -> IO (Value, Either String Patch, Either String Value) readExample root name = (,,) <$> readDocument root name <*> readPatch root name <*> readResult root name -- | Check example and, if it fails, return an error message. runExample :: (Value, Either String Patch, Either String Value) -> Maybe String runExample (doc, diff, res) = case (diff, res) of (Left perr, Left err) | err `isInfixOf` perr -> success "Patch has expected error." | perr `isInfixOf` err -> success "Patch has expected error." | otherwise -> failure ("Unexpected error `" <> perr <> "' was not '" <> err <> "'.") (Left err, Right _) -> failure ("Couldn't load patch: " <> err) (Right diff, Right res) -> case patch diff doc of Success dest | dest == res -> success "Result matches target" | otherwise -> failure ("Result document did not match: " <> BL.unpack (encode dest)) Error dest -> failure ("Couldn't apply patch " <> dest) (Right diff, Left err) -> case patch diff doc of Success _ -> Just "Test Fails - Expected a failure but patch succeeded." Error msg | msg /= err -> Just $ "Test Fails - Got: " <> msg <> "\nExpected: " <> err | otherwise -> Nothing where success _ = Nothing failure n = Just ("Test Fails - " <> n) testExample :: FilePath -> FilePath -> IO (Maybe String) testExample root name = do r <- try (runExample <$> readExample root name) return $ either err id r where err :: AssertionFailed -> Maybe String err e = Just ("Error: " <> show e) runSuite :: FilePath -> IO [(FilePath, Maybe String)] runSuite root = do -- Gather directories in test/data let p = simplify (compile globPattern) examples <- nub . fmap (takeWhile (/= '-')) . filter (match p) <$> getDirectoryContents root -- Test each of them mapM (\nom -> (nom,) <$> testExample root nom) examples main :: IO () main = do args <- getArgs results <- concat <$> mapM runSuite (if null args then roots else args) mapM_ display results -- Failure. when (any (isJust . snd) results) exitFailure where display :: (FilePath, Maybe String) -> IO () display (name, Nothing) = putStrLn $ "SUCCESS: " <> name display (name, Just err) = putStrLn $ "FAILURE: " <> name <> ": " <> err aeson-diff-1.1.0.13/test/properties.hs0000644000000000000000000000720407346545000015651 0ustar0000000000000000{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Main (main) where import Control.Monad (unless) import Data.Aeson (Result(Success), Value(Array, Object), encode) import qualified Data.ByteString.Lazy.Char8 as BL import qualified Data.Aeson.KeyMap as HM import qualified Data.Vector as V import System.Exit (exitFailure) import Test.QuickCheck (Arbitrary, Gen, arbitrary, oneof, quickCheckAll, resize, sized) import Data.Aeson.Diff (Config(Config), diff, diff', patch) import Data.Aeson.Patch (isRem, isTst, patchOperations) showIt :: Value -> String showIt = BL.unpack . encode newtype Wellformed a = Wellformed { wellformed :: a } newtype AnObject a = AnObject { anObject :: a } newtype AnArray a = AnArray { anArray :: a } instance Show (Wellformed Value) where show = showIt . wellformed instance Show (AnObject Value) where show = showIt . anObject instance Show (AnArray Value) where show = showIt . anArray -- | QuickCheck doesn't have scale in LTS-2 so copy it in. scaleSize :: (Int -> Int) -> Gen a -> Gen a scaleSize f g = sized (\s -> resize (f s) g) instance Arbitrary (Wellformed Value) where arbitrary = Wellformed <$> oneof [ Array . V.fromList <$> scaleSize (`div` 2) arbitrary , Object . HM.fromList <$> scaleSize (`div` 2) arbitrary ] instance Arbitrary (AnObject Value) where arbitrary = AnObject . Object . HM.fromList <$> scaleSize (`div` 2) arbitrary instance Arbitrary (AnArray Value) where arbitrary = AnArray . Array . V.fromList <$> scaleSize (`div` 2) arbitrary -- | Extracting and applying a patch is an identity. diffApply :: Value -> Value -> Bool diffApply f t = let p = diff f t in (Success t == patch p f) || error ("BAD PATCH\n" <> BL.unpack (encode p) <> "\n" <> result "" (BL.unpack . encode <$> patch p f)) result :: a -> Result a -> a result _ (Success a) = a result a _ = a -- | Patch extracted from identical documents should be mempty. prop_diff_id :: Wellformed Value -> Bool prop_diff_id (Wellformed v) = diff v v == mempty -- | Extract and apply a patch (between wellformed JSON documents). prop_diff_documents :: Wellformed Value -> Wellformed Value -> Bool prop_diff_documents (Wellformed f) (Wellformed t) = diffApply f t -- | Extract and apply a patch (specialised to JSON arrays). prop_diff_arrays :: AnArray Value -> AnArray Value -> Bool prop_diff_arrays (AnArray v1) (AnArray v2) = diffApply v1 v2 -- | Extract and apply a patch (specialised to JSON objects). prop_diff_objects :: AnObject Value -> AnObject Value -> 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 minusOneInTs :: Integer -> Bool minusOneInTs r = (r - 1) `elem` ts in (length rs <= length ts) && all minusOneInTs rs -- -- Use Template Haskell to automatically run all of the properties above. -- return [] runTests :: IO Bool runTests = $quickCheckAll main :: IO () main = do result <- runTests unless result exitFailure