aeson-diff 1.1.0.0 → 1.1.0.2

raw patch · 10 files changed

+228/−143 lines, 10 filesdep +doctestdep ~basedep ~optparse-applicativePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: doctest

Dependency ranges changed: base, optparse-applicative

API changes (from Hackage documentation)

Files

• README.md +2/−0
• aeson-diff.cabal +13/−3
• lib/Data/Aeson/Diff.hs +58/−71
• lib/Data/Aeson/Patch.hs +70/−26
• lib/Data/Aeson/Pointer.hs +71/−35
• stack.yaml +1/−1
• test/data/cases/case3-error.txt +1/−0
• test/doctests.hs +4/−0
• test/examples.hs +4/−3
• test/properties.hs +4/−4

@@ -2,6 +2,8 @@ ==========  [![Build Status][badge]][status]+[![Hackage](https://img.shields.io/hackage/v/aeson-diff.svg?maxAge=2592000)]()+[![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

@@ -1,5 +1,5 @@ name:                aeson-diff-version:             1.1.0.0+version:             1.1.0.2 synopsis:            Extract and apply patches to JSON documents. description:   .@@ -53,7 +53,7 @@                      , aeson                      , aeson-diff                      , bytestring-                     , optparse-applicative >=0.11 && < 0.13+                     , optparse-applicative                      , text  executable             json-patch@@ -64,7 +64,7 @@                      , aeson                      , aeson-diff                      , bytestring-                     , optparse-applicative >=0.11 && < 0.13+                     , optparse-applicative  test-suite             properties   default-language:    Haskell2010@@ -98,6 +98,16 @@                      , text                      , unordered-containers                      , vector++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+                     , QuickCheck+                     , doctest >= 0.9  test-suite             hlint-check   default-language:    Haskell2010

@@ -14,7 +14,6 @@     Key(..),     Operation(..),     Config(..),-     -- * Functions     diff,     diff',@@ -40,19 +39,23 @@ import qualified Data.Text                  as T import           Data.Vector                (Vector) import qualified Data.Vector                as V--import Data.Vector.Distance+import           Data.Vector.Distance  import Data.Aeson.Patch import Data.Aeson.Pointer -data Config = Config+-- * 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 =@@ -64,40 +67,31 @@       Cpy{} -> 1       Tst{} -> valueSize (changeValue op) --- | Modify the 'Pointer's of an 'Operation'.------ This is typically used to add a prefix to the 'Pointer's in an-modifyPath :: ([Key] -> [Key]) -> Operation -> Operation-modifyPath f op = from (change op)-  where-    fn :: Pointer -> Pointer-    fn (Pointer p) = Pointer (f p)-    change op = op { changePointer = fn (changePointer op) }-    from op =-        case op of-          Mov{} -> op { fromPointer = fn (fromPointer op) }-          Cpy{} -> op { fromPointer = fn (fromPointer op) }-          _     -> 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 -> Path -> Value -> [Operation]-ins cfg p v = [Add (Pointer p) v]+ins :: Config -> Pointer -> Value -> [Operation]+ins cfg p v = [Add p v]  -- | Construct a patch with a single 'Rem' operation.-del :: Config -> Path -> Value -> [Operation]+del :: Config -> Pointer -> Value -> [Operation] del Config{..} p v =   if configTstBeforeRem-  then [Tst (Pointer p) v, Rem (Pointer p)]-  else [Rem (Pointer p)]+  then [Tst p v, Rem p]+  else [Rem p]  -- | Construct a patch which changes 'Rep' operation.-rep :: Path -> Value -> [Operation]-rep p v = [Rep (Pointer p) v]+rep :: Config -> Pointer -> Value -> [Operation]+rep Config{..} p v = [Rep p v] --- * Operations+-- * Diff  -- | Compare two JSON documents and generate a patch describing the differences. --@@ -114,28 +108,28 @@     -> Value     -> Value     -> Patch-diff' cfg@Config{..} v v' = Patch (worker [] v v')+diff' cfg@Config{..} v v' = Patch (worker mempty v v')   where     check :: Monoid m => Bool -> m -> m     check b v = if b then mempty else v -    worker :: Path -> Value -> Value -> [Operation]+    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 p v2-        (Number n1, Number n2) -> check (n1 == n2) $ rep p v2-        (String s1, String s2) -> check (s1 == s2) $ rep p v2+        (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 p v2+        _                      -> rep cfg p v2      -- Walk the keys in two objects, producing a 'Patch'.-    workObject :: Path -> Object -> Object -> [Operation]+    workObject :: Pointer -> Object -> Object -> [Operation]     workObject path o1 o2 =         let k1 = HM.keys o1             k2 = HM.keys o2@@ -144,35 +138,35 @@             del_keys = filter (not . (`elem` k2)) k1             deletions :: [Operation]             deletions = concatMap-                (\k -> del cfg [OKey k] (fromJust $ HM.lookup k o1))+                (\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 [OKey k] (fromJust $ HM.lookup k o2))+                (\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 [OKey k]+                (\k -> worker (Pointer [OKey k])                     (fromJust $ HM.lookup k o1)                     (fromJust $ HM.lookup k o2))                 chg_keys-        in modifyPath (path <>) <$> (deletions <> insertions <> changes)+        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 :: Path -> Array -> Array -> [Operation]-    workArray path ss tt = fmap (modifyPath (path <>)) . snd . fmap concat $ leastChanges params ss tt+    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 i = del cfg [AKey i]-        insert i = ins cfg [AKey i]-        substitute i = worker [AKey i]+        delete i = del cfg (Pointer [AKey i])+        insert i = ins cfg (Pointer [AKey i])+        substitute i = worker (Pointer [AKey i])         cost = Sum . sum . fmap operationCost         -- Position is advanced by grouping operations with same "head" index:         -- + groups of many operations advance one@@ -212,12 +206,14 @@             | 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 []) val  = return val patch (Patch ops) val = foldlM (flip applyOperation) val ops  -- | Apply an 'Operation' to a 'Value'.@@ -244,28 +240,28 @@ -- - A single 'AKey' inserts at the corresponding location. -- - Longer 'Paths' traverse if they can and fail otherwise. applyAdd :: Pointer -> Value -> Value -> Result Value-applyAdd from@(Pointer path) = go path+applyAdd pointer = go pointer   where-    go [] val _ =+    go (Pointer []) val _ =         return val-    go [AKey i] v' (Array v) =+    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)-    go (AKey i : path) v' (Array v) =+    go (Pointer (AKey i : path)) v' (Array v) =         let fn :: Maybe Value -> Result (Maybe Value)-            fn Nothing = cannot "insert" "array" i from-            fn (Just d) = Just <$> go path v' d+            fn Nothing  = cannot "insert" "array" i pointer+            fn (Just d) = Just <$> go (Pointer path) v' d         in Array <$> vModify i fn v-    go [OKey n] v' (Object m) =+    go (Pointer [OKey n]) v' (Object m) =         return . Object $ HM.insert n v' m-    go (OKey n : path) v' (Object o) =+    go (Pointer (OKey n : path)) v' (Object o) =         let fn :: Maybe Value -> Result (Maybe Value)-            fn Nothing = cannot "insert" "object" n from-            fn (Just d) = Just <$> go path v' d+            fn Nothing  = cannot "insert" "object" n pointer+            fn (Just d) = Just <$> go (Pointer path) v' d         in Object <$> hmModify n fn o-    go (OKey n : path) v' array@(Array v)-        | n == "-" = go (AKey (V.length v) : path) v' array+    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.@@ -279,29 +275,29 @@     go [] _ = return Null     go [AKey i] d@(Array v) =         let fn :: Maybe Value -> Result (Maybe Value)-            fn Nothing = cannot "delete" "array" i from+            fn Nothing  = cannot "delete" "array" i from             fn (Just v) = 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 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 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 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 path value+    go path value = pointerFailure from value  -- | Apply a 'Rep' operation to a document. --@@ -348,15 +344,6 @@ -- above. Mostly they just fill gaps in the APIs of the "Data.Vector" -- and "Data.HashMap.Strict" modules. --- | Estimate the size of a JSON 'Value'.------ This is used in the diff cost metric function.-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- -- | Delete an element in a vector. vDelete :: Int -> Vector a -> Vector a vDelete i v =@@ -411,7 +398,7 @@     -> HashMap k v     -> Result (HashMap k v) hmModify k f m = case f (HM.lookup k m) of-    Error e -> Error e+    Error e          -> Error e     Success Nothing  -> return $ HM.delete k m     Success (Just v) -> return $ HM.insert k v m 

@@ -1,11 +1,19 @@ {-# 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 @@ -36,6 +44,12 @@         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@@ -45,51 +59,43 @@ 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-    | Mov { changePointer :: Pointer, fromPointer :: Pointer }-    -- ^ http://tools.ietf.org/html/rfc6902#section-4.4-    | Cpy { changePointer :: Pointer, fromPointer :: Pointer }-    -- ^ http://tools.ietf.org/html/rfc6902#section-4.5     | 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         [ ("op", "add")         , "path"  .= p         , "value" .= v         ]-    toJSON (Rem p) = object-        [ ("op", "remove")+    toJSON (Cpy p f) = object+        [ ("op", "copy")         , "path" .= p-        ]-    toJSON (Rep p v) = object-        [ ("op", "replace")-        , "path"  .= p-        , "value" .= v+        , "from" .= f         ]     toJSON (Mov p f) = object         [ ("op", "move")         , "path" .= p         , "from" .= f         ]-    toJSON (Cpy p f) = object-        [ ("op", "copy")+    toJSON (Rem p) = object+        [ ("op", "remove")         , "path" .= p-        , "from" .= f         ]+    toJSON (Rep p v) = object+        [ ("op", "replace")+        , "path"  .= p+        , "value" .= v+        ]     toJSON (Tst p v) = object         [ ("op", "test")         , "path" .= p@@ -101,11 +107,11 @@       where         parse o@(Object v)             =   (op v "add"     *> (Add <$> v .: "path" <*> v .: "value"))-            <|> (op v "replace" *> (Rep <$> v .: "path" <*> v .: "value"))-            <|> (op v "move"    *> (Mov <$> v .: "path" <*> v .: "from"))             <|> (op v "copy"    *> (Cpy <$> v .: "path" <*> v .: "from"))-            <|> (op v "test"    *> (Tst <$> v .: "path" <*> v .: "value"))+            <|> (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)@@ -115,3 +121,41 @@               then return v'               else mzero         fixed' o n val = (o .: n) >>= \v -> guard (v == n)++-- | 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

@@ -1,14 +1,15 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings          #-} -- | Description: JSON Pointers as described in RFC 6901.- module Data.Aeson.Pointer (   Pointer(..),   Key(..),-  pointerFailure,-  Path,+  -- * Representing pointers   formatPointer,+  parsePointer,+  -- * Using pointers   get,+  pointerFailure, ) where  import           Control.Applicative@@ -25,7 +26,7 @@  -- * Patch components --- | Traverse a single layer of a JSON document.+-- | 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.@@ -64,20 +65,53 @@   deriving (Eq, Show, Monoid)  -- | 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) --- | Report an error following a pointer.-pointerFailure :: Path -> Value -> Result a-pointerFailure [] value = Error ("UNPOSSIBLE!" <> show value)-pointerFailure path@(key:rest) value =-    fail . BS.unpack $ "Cannot follow pointer " <> pt <> ". Expected " <> ty <> " but got " <> doc+-- | 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-    doc = encode value-    pt = encode (Pointer path)-    ty = case key of-           (AKey _) -> "array"-           (OKey _) -> "object"+    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 (unesc t)  instance ToJSON Pointer where     toJSON pointer =@@ -86,28 +120,30 @@ instance FromJSON Pointer where     parseJSON = modifyFailure ("Could not parse JSON pointer: " <>) . parse       where-        parse (String t) = Pointer <$> mapM key (drop 1 $ T.splitOn "/" t)+        parse (String t) = parsePointer t         parse _ = fail "A JSON pointer must be a string."-        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 (unesc t) --- | Get the value at a 'Path'.+-- | Follow a 'Pointer' through a JSON document as described in RFC 6901. get :: Pointer -> Value -> Result Value-get (Pointer p) = get' p+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-    get' [] v = return v-    get' (AKey i : path) (Array v) =-        maybe (fail "") return (v V.!? i) >>= get' path-    get' (OKey n : path) (Object v) =-        maybe (fail "") return (HM.lookup n v) >>= get' path-    get' path value = pointerFailure path value+    doc = encode value+    pt = encode path+    ty = case key of+           (AKey _) -> "array"+           (OKey _) -> "object"+++-- $setup+-- >>> :set -XOverloadedStrings

@@ -1,4 +1,4 @@-resolver: lts-6.7+resolver: lts-8.2 extra-deps: - edit-distance-vector-1.0.0.4 flags: {}

@@ -1,1 +1,2 @@ Could not parse patch: when expecting a Array, encountered Object instead+Error in $: Could not parse patch: expected Array, encountered Object

@@ -0,0 +1,4 @@+import Test.DocTest++main :: IO ()+main = doctest ["-ilib", "lib"]

@@ -15,7 +15,7 @@ import           Data.Char import           Data.Either import           Data.Functor-import           Data.List                  (nub)+import           Data.List                  (isInfixOf, nub) import           Data.Maybe import           Data.Monoid import           System.Directory@@ -77,8 +77,9 @@ runExample (doc, diff, res) =     case (diff, res) of         (Left perr, Left err)-            | perr == err -> success "Patch has expected error."-            | otherwise   -> failure ("Unexpected error `" <> perr <> "'.")+            | 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) ->

@@ -26,11 +26,11 @@ showIt :: Value -> String showIt = BL.unpack . encode -data Wellformed a = Wellformed { wellformed :: a }+newtype Wellformed a = Wellformed { wellformed :: a } -data AnObject a = AnObject { anObject :: a }+newtype AnObject a = AnObject { anObject :: a } -data AnArray a = AnArray { anArray :: a }+newtype AnArray a = AnArray { anArray :: a }  instance Show (Wellformed Value) where     show = showIt . wellformed@@ -83,7 +83,7 @@  result :: a -> A.Result a -> a result _ (A.Success a) = a-result a _ = a+result a _             = a  -- | Patch extracted from identical documents should be mempty. prop_diff_id