aeson-diff 1.1.0.10 → 1.1.0.11
raw patch · 10 files changed
+120/−176 lines, 10 filesdep −hashabledep −mtldep −quickcheck-instancesdep ~aesondep ~basedep ~bytestringbuild-type:Customsetup-changednew-uploader
Dependencies removed: hashable, mtl, quickcheck-instances, semigroups, unordered-containers
Dependency ranges changed: aeson, base, bytestring, doctest
Files
- Setup.hs +5/−2
- aeson-diff.cabal +22/−40
- lib/Data/Aeson/Diff.hs +30/−41
- lib/Data/Aeson/Patch.hs +5/−9
- lib/Data/Aeson/Pointer.hs +13/−14
- src/diff.hs +7/−11
- src/patch.hs +7/−9
- test/doctests.hs +2/−1
- test/examples.hs +15/−19
- test/properties.hs +14/−30
Setup.hs view
@@ -1,2 +1,5 @@-import Distribution.Simple-main = defaultMain+import Distribution.Extra.Doctest+ (defaultMainWithDoctests)++main :: IO ()+main = defaultMainWithDoctests "doctests"
aeson-diff.cabal view
@@ -1,5 +1,5 @@ name: aeson-diff-version: 1.1.0.10+version: 1.1.0.11 synopsis: Extract and apply patches to JSON documents. description: .@@ -7,15 +7,15 @@ 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/thsutton/aeson-diff+homepage: https://github.com/ysangkok/aeson-diff license: BSD3 license-file: LICENSE author: Thomas Sutton-maintainer: me@thomas-sutton.id.au+maintainer: Janus Troelsen <ysangkok@gmail.com> copyright: (c) 2015 Thomas Sutton and others. category: JSON, Web, Algorithms-build-type: Simple-cabal-version: >=1.10+build-type: Custom+cabal-version: 2.0 extra-source-files: README.md , CHANGELOG.md , stack.yaml@@ -26,7 +26,7 @@ source-repository HEAD type: git- location: https://github.com/thsutton/aeson-diff+ location: https://github.com/ysangkok/aeson-diff library default-language: Haskell2010@@ -34,37 +34,30 @@ exposed-modules: Data.Aeson.Diff , Data.Aeson.Patch , Data.Aeson.Pointer- build-depends: base >=4.9 && <4.16- , aeson+ build-depends: base >=4.11.1 && <4.17+ , aeson >= 2.0.3 , bytestring >= 0.10 , edit-distance-vector- , hashable- , mtl , scientific , text- , unordered-containers , vector- if impl(ghc < 8.0)- build-depends:- semigroups < 0.19 executable json-diff default-language: Haskell2010 hs-source-dirs: src main-is: diff.hs build-depends: base- , aeson+ , aeson >= 2.0.3 , aeson-diff , bytestring , optparse-applicative- , text executable json-patch default-language: Haskell2010 hs-source-dirs: src main-is: patch.hs build-depends: base- , aeson+ , aeson >= 2.0.3 , aeson-diff , bytestring , optparse-applicative@@ -76,12 +69,9 @@ main-is: properties.hs build-depends: base , QuickCheck- , aeson+ , aeson >= 2.0.3 , aeson-diff , bytestring- , quickcheck-instances- , text- , unordered-containers , vector test-suite examples@@ -91,37 +81,24 @@ main-is: examples.hs build-depends: base , Glob- , QuickCheck- , aeson+ , aeson >= 2.0.3 , aeson-diff , bytestring , directory , filepath- , quickcheck-instances- , text- , unordered-containers- , vector -test-suite doctests+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- , aeson- , aeson-diff- , bytestring- , directory- , doctest >= 0.9- , filepath- , Glob- , QuickCheck- , quickcheck-instances- , text- , unordered-containers- , vector+ , doctest >= 0.20+ other-modules: Build_doctests+ autogen-modules: Build_doctests + test-suite hlint-check buildable: False default-language: Haskell2010@@ -130,3 +107,8 @@ main-is: hlint-check.hs build-depends: base , hlint++custom-setup+ setup-depends:+ base >= 4 && <5,+ cabal-doctest >= 1 && <1.1
lib/Data/Aeson/Diff.hs view
@@ -1,6 +1,5 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-} -- | Description: Extract and apply patches on JSON documents. --@@ -21,28 +20,21 @@ applyOperation, ) where -import Control.Applicative-import Control.Monad-import Control.Monad.Error.Class-import Data.Aeson-import Data.Aeson.Types (modifyFailure, typeMismatch)-import qualified Data.ByteString.Lazy.Char8 as BS+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.Hashable-import Data.HashMap.Strict (HashMap)-import qualified Data.HashMap.Strict as HM-import Data.List (groupBy, intercalate)-import Data.Maybe-import Data.Monoid-import Data.Scientific-import Data.Text (Text)+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+import Data.Vector.Distance (Params(Params, equivalent, positionOffset, substitute, insert, delete, cost), leastChanges) -import Data.Aeson.Patch-import Data.Aeson.Pointer+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 @@ -78,18 +70,18 @@ -- | Construct a patch with a single 'Add' operation. ins :: Config -> Pointer -> Value -> [Operation]-ins cfg p v = [Add p v]+ins _cfg p v = [Add p v] -- | Construct a patch with a single 'Rem' operation. del :: Config -> Pointer -> Value -> [Operation]-del Config{..} p v =+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 Config{..} p v = [Rep p v]+rep _cfg p v = [Rep p v] -- * Diff @@ -108,7 +100,7 @@ -> Value -> Value -> Patch-diff' cfg@Config{..} v v' = Patch (worker mempty v v')+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@@ -134,7 +126,7 @@ let k1 = HM.keys o1 k2 = HM.keys o2 -- Deletions- del_keys :: [Text]+ del_keys :: [AesonKey.Key] del_keys = filter (not . (`elem` k2)) k1 deletions :: [Operation] deletions = concatMap@@ -162,11 +154,13 @@ workArray path ss tt = fmap (modifyPointer (path <>)) . snd . fmap concat $ leastChanges params ss tt where params :: Params Value [Operation] (Sum Int)- params = Params{..}+ 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@@ -178,7 +172,7 @@ let p1 = pointerPath (changePointer o1) p2 = pointerPath (changePointer o2) in case (p1, p2) of- ([i1], [i2]) -> False+ ([_], [_]) -> False (i1:_, i2:_) | i1 == i2 -> True | otherwise -> False -- A group of operations has a peculiar (i.e. given by 'pos') advance@@ -204,7 +198,7 @@ pos Mov{changePointer=Pointer path} | length path == 1 = 1 | otherwise = 0- pos Tst{changePointer=Pointer path} = 0+ pos Tst{changePointer=Pointer _path} = 0 -- * Patching @@ -227,9 +221,7 @@ Rep path v' -> applyRep path v' json Tst path v -> applyTst path v json Cpy path from -> applyCpy path from json- Mov path from -> do- v' <- get from json- applyRem from json >>= applyAdd path v'+ Mov path from -> applyMov path from json -- | Apply an 'Add' operation to a document. --@@ -245,9 +237,7 @@ go (Pointer []) val _ = return val go (Pointer [AKey i]) v' (Array v) =- let fn :: Maybe Value -> Result (Maybe Value)- fn _ = return (Just v')- in return (Array $ vInsert i v' 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@@ -273,10 +263,10 @@ applyRem from@(Pointer path) = go path where go [] _ = return Null- go [AKey i] d@(Array v) =+ go [AKey i] (Array v) = let fn :: Maybe Value -> Result (Maybe Value) fn Nothing = cannot "delete" "array" i from- fn (Just v) = return Nothing+ fn (Just _) = return Nothing in Array <$> vModify i fn v go (AKey i : path) (Array v) = let fn :: Maybe Value -> Result (Maybe Value)@@ -297,7 +287,7 @@ 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+ go _path value = pointerFailure from value -- | Apply a 'Rep' operation to a document. --@@ -342,7 +332,7 @@ -- $ 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.HashMap.Strict" modules.+-- and "Data.Aeson.KeyMap" modules. -- | Delete an element in a vector. vDelete :: Int -> Vector a -> Vector a@@ -386,17 +376,16 @@ (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 'HashMap'.+-- | 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- :: (Eq k, Hashable k)- => k+ :: AesonKey.Key -> (Maybe v -> Result (Maybe v))- -> HashMap k v- -> Result (HashMap k 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
lib/Data/Aeson/Patch.hs view
@@ -18,18 +18,15 @@ isTst, ) where -import Control.Applicative-import Control.Monad-import Data.Aeson-import Data.Aeson.Types+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 Data.Monoid-import Data.Semigroup (Semigroup)-import Data.Vector (Vector) import qualified Data.Vector as V import GHC.Generics (Generic) -import Data.Aeson.Pointer+import Data.Aeson.Pointer (Pointer) -- * Patches @@ -123,7 +120,6 @@ if v' == val then return v' else mzero- fixed' o n val = (o .: n) >>= \v -> guard (v == n) -- | Modify the 'Pointer's in an 'Operation'. --
lib/Data/Aeson/Pointer.hs view
@@ -14,15 +14,14 @@ pointerFailure, ) where -import Control.Applicative-import Data.Aeson-import Data.Aeson.Types+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 qualified Data.HashMap.Strict as HM-import Data.Monoid-import Data.Scientific-import Data.Semigroup (Semigroup)+import Data.Scientific (toBoundedInteger) import Data.Text (Text) import qualified Data.Text as T import qualified Data.Vector as V@@ -32,16 +31,16 @@ -- | Path components to traverse a single layer of a JSON document. data Key- = OKey Text -- ^ Traverse a 'Value' with an 'Object' constructor.- | AKey Int -- ^ Traverse a 'Value' with an 'Array' constructor.+ = 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) = String t+ toJSON (OKey t) = toJSON t toJSON (AKey a) = Number . fromInteger . toInteger $ a instance FromJSON Key where- parseJSON (String t) = return $ OKey t+ 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."@@ -50,7 +49,7 @@ formatKey :: Key -> Text formatKey (AKey i) = T.pack (show i)-formatKey (OKey t) = T.concatMap esc t+formatKey (OKey t) = T.concatMap esc $ toText t where esc :: Char -> Text esc '~' = "~0"@@ -115,7 +114,7 @@ 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 (unesc t)+ | otherwise = return . OKey . fromText $ unesc t instance ToJSON Pointer where toJSON pointer =@@ -138,7 +137,7 @@ -- | 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 []) _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
src/diff.hs view
@@ -1,19 +1,15 @@-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} -module Main where+module Main (main) where -import Control.Applicative-import Control.Exception-import Data.Aeson-import Data.Aeson.Diff+import Control.Exception (bracket)+import Data.Aeson (Value, encode, decode)+import Data.Aeson.Diff (Config(Config), diff') import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy as BSL-import Data.Monoid-import qualified Data.Text.IO as T-import Options.Applicative-import Options.Applicative.Types-import System.IO+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
src/patch.hs view
@@ -1,17 +1,15 @@ {-# LANGUAGE RecordWildCards #-} -module Main where+module Main (main) where -import Control.Applicative-import Control.Exception-import Data.Aeson-import Data.Aeson.Diff+import Control.Exception (bracket)+import Data.Aeson (Result(Error, Success), Value, decode, encode, fromJSON)+import Data.Aeson.Diff (patch) import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy as BSL-import Data.Monoid-import Options.Applicative hiding (Success)-import Options.Applicative.Types hiding (Success)-import System.IO+import Options.Applicative (fullDesc, info, execParser, helper, metavar, progDesc, argument, help, value, long, option, short)+import Options.Applicative.Types (Parser, readerAsk)+import System.IO (Handle, IOMode(ReadMode, WriteMode), hClose, openFile, stdin, stdout) type File = Maybe FilePath
test/doctests.hs view
@@ -1,4 +1,5 @@+import Build_doctests (flags, pkgs, module_sources) import Test.DocTest main :: IO ()-main = doctest ["-ilib", "lib"]+main = doctest $ flags ++ pkgs ++ module_sources
test/examples.hs view
@@ -2,27 +2,23 @@ -- | Test examples from RFC 6902 sections A.1 to A.16. -module Main where+module Main (main) where -import Control.Applicative-import Control.Exception-import Control.Monad-import Data.Aeson-import Data.Aeson.Diff+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-import Data.Either-import Data.Functor+import Data.Char (isSpace) import Data.List (isInfixOf, nub)-import Data.Maybe-import Data.Monoid-import System.Directory-import System.Environment-import System.Exit-import System.FilePath-import System.FilePath.Glob+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"]@@ -60,11 +56,11 @@ case (err, doc) of (Nothing, Just d) -> return (Right d) (Just er, Nothing) -> return (Left er)- (Just er, Just d) -> derp "Expecting both error and success"+ (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 e = return Nothing+ handle _ = return Nothing readExample :: FilePath -> FilePath -> IO (Value, Either String Patch, Either String Value) readExample root name =@@ -95,7 +91,7 @@ | msg /= err -> Just $ "Test Fails - Got: " <> msg <> "\nExpected: " <> err | otherwise -> Nothing where- success n = Nothing+ success _ = Nothing failure n = Just ("Test Fails - " <> n) testExample :: FilePath -> FilePath -> IO (Maybe String)
test/properties.hs view
@@ -4,24 +4,18 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} -module Main where+module Main (main) where -import Control.Applicative-import Control.Monad-import Data.Aeson as A+import Control.Monad (unless)+import Data.Aeson (Result(Success), Value(Array, Object), encode) import qualified Data.ByteString.Lazy.Char8 as BL-import Data.Functor-import Data.HashMap.Strict (HashMap)-import qualified Data.HashMap.Strict as HM-import Data.Monoid-import Data.Text (Text)+import qualified Data.Aeson.KeyMap as HM import qualified Data.Vector as V-import System.Exit-import Test.QuickCheck-import Test.QuickCheck.Instances ()+import System.Exit (exitFailure)+import Test.QuickCheck (Arbitrary, Gen, arbitrary, oneof, quickCheckAll, resize, sized) -import Data.Aeson.Diff-import Data.Aeson.Patch+import Data.Aeson.Diff (Config(Config), diff, diff', patch)+import Data.Aeson.Patch (isRem, isTst, patchOperations) showIt :: Value -> String showIt = BL.unpack . encode@@ -57,19 +51,7 @@ instance Arbitrary (AnArray Value) where arbitrary = AnArray . Array . V.fromList <$> scaleSize (`div` 2) arbitrary -instance Arbitrary Value where- arbitrary = sized vals- where vals :: Int -> Gen Value- vals n- | n <= 1 = oneof- [ pure Null- , Bool <$> arbitrary- , Number . fromIntegral <$> (arbitrary :: Gen Int)- , String <$> arbitrary- ]- | otherwise = wellformed <$> arbitrary - -- | Extracting and applying a patch is an identity. diffApply :: Value@@ -77,12 +59,12 @@ -> Bool diffApply f t = let p = diff f t- in (A.Success t == patch p f) ||+ in (Success t == patch p f) || error ("BAD PATCH\n" <> BL.unpack (encode p) <> "\n" <> result "<failure>" (BL.unpack . encode <$> patch p f)) -result :: a -> A.Result a -> a-result _ (A.Success a) = a+result :: a -> Result a -> a+result _ (Success a) = a result a _ = a -- | Patch extracted from identical documents should be mempty.@@ -125,7 +107,9 @@ 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+ 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.