jsonpatch 0.2.0.0 → 0.2.1.0

raw patch · 11 files changed

+113/−20 lines, 11 files

Files

README.lhs +1/−1
README.md +1/−1
jsonpatch.cabal +2/−1
src/Data/JSON/Patch.hs +3/−1
src/Data/JSON/Patch/Apply.hs +14/−13
src/Data/JSON/Patch/Apply/AsValue.hs +64/−0
src/Data/JSON/Patch/Prelude.hs +8/−0
src/Data/JSON/Patch/Type.hs +2/−0
src/Data/JSON/Pointer.hs +9/−0
test/Data/JSON/PatchSpec.hs +1/−3
test/Data/JSON/Pointer/TokenSpec.hs +8/−0

README.lhs view

@@ -63,7 +63,7 @@  ```haskell result :: Either PatchError Value-result = applyPatches patch [aesonQQ|+result = patchValue patch [aesonQQ|   {     "baz": "qux",     "foo": "bar"

README.md view

@@ -63,7 +63,7 @@  ```haskell result :: Either PatchError Value-result = applyPatches patch [aesonQQ|+result = patchValue patch [aesonQQ|   {     "baz": "qux",     "foo": "bar"

jsonpatch.cabal view

@@ -1,6 +1,6 @@ cabal-version:      1.18 name:               jsonpatch-version:            0.2.0.0+version:            0.2.1.0 license:            AGPL-3 license-file:       COPYING maintainer:         Patrick Brisbin@@ -38,6 +38,7 @@         Data.Aeson.Optics.Ext         Data.JSON.Patch         Data.JSON.Patch.Apply+        Data.JSON.Patch.Apply.AsValue         Data.JSON.Patch.Error         Data.JSON.Patch.Prelude         Data.JSON.Patch.Type

src/Data/JSON/Patch.hs view

@@ -9,8 +9,10 @@ module Data.JSON.Patch   ( Patch   , PatchError-  , applyPatches+  , patchValue+  , patchAsValue   ) where  import Data.JSON.Patch.Apply+import Data.JSON.Patch.Apply.AsValue import Data.JSON.Patch.Type

src/Data/JSON/Patch/Apply.hs view

@@ -7,8 +7,8 @@ -- Stability   : experimental -- Portability : POSIX module Data.JSON.Patch.Apply-  ( applyPatches-  , PatchError (..)+  ( PatchError (..)+  , patchValue   ) where  import Data.JSON.Patch.Prelude@@ -21,17 +21,18 @@ import Data.Vector qualified as V import Optics.Core -applyPatches :: [Patch] -> Value -> Either PatchError Value-applyPatches ps v = foldM applyPatch v ps--applyPatch :: Value -> Patch -> Either PatchError Value-applyPatch val = \case-  Add op -> add op.value op.path val-  Remove op -> remove op.path val-  Replace op -> remove op.path val >>= add op.value op.path-  Move op -> get op.from val >>= \v -> remove op.from val >>= add v op.path-  Copy op -> get op.from val >>= \v -> add v op.path val-  Test op -> get op.path val >>= \v -> test v op.value op.path val+-- | Apply the given 'Patch'es to the given 'Value'+patchValue :: [Patch] -> Value -> Either PatchError Value+patchValue patches target = foldM go target patches+ where+  go :: Value -> Patch -> Either PatchError Value+  go val = \case+    Add op -> add op.value op.path val+    Remove op -> remove op.path val+    Replace op -> remove op.path val >>= add op.value op.path+    Move op -> get op.from val >>= \v -> remove op.from val >>= add v op.path+    Copy op -> get op.from val >>= \v -> add v op.path val+    Test op -> get op.path val >>= \v -> test v op.value op.path val  get :: Pointer -> Value -> Either PatchError Value get p val = note (PointerNotFound p Nothing) $ val ^? pointerL p

+ src/Data/JSON/Patch/Apply/AsValue.hs view

@@ -0,0 +1,64 @@+-- |+--+-- Module      : Data.JSON.Patch.Apply.AsValue+-- Copyright   : (c) 2025 Patrick Brisbin+-- License     : AGPL-3+-- Maintainer  : pbrisbin@gmail.com+-- Stability   : experimental+-- Portability : POSIX+module Data.JSON.Patch.Apply.AsValue+  ( PatchError (..)+  , patchAsValue+  ) where++import Data.JSON.Patch.Prelude++import Data.Aeson (FromJSON, Result (..), ToJSON (..), Value (..), fromJSON)+import Data.Aeson.Optics (AsValue (..))+import Data.JSON.Patch.Apply+import Optics.Core++-- | A polymorphic version of 'patchValue'+--+-- The @patch@ input uses 'AsValue' from @aeson-optics@, meaning you can supply+-- a variety of types such as 'ByteString' or 'Value' and it will be parsed into+-- @['Patches']@ (capturing failure as a 'PatchError').+--+-- The @v@ input can be any domain type with JSON instances. We don't use+-- 'AsValue' here as well, even though it provides the same functionality,+-- because it's unlikely your types will have this instance.+--+-- @+-- data Person = Person+--   { name :: Text+--   , age :: Int+--   }+--   deriving stock Generic+--   deriving anyclass (FromJSON, ToJSON)+--+-- patchPersonR :: PersonId -> Handler Person+-- patchPersonR id = do+--   person <- runDB $ get id           -- Person "pat" 19+--   bytes <- getRequestBody            -- "[{op:replace, path:/age, value:21}]"+--+--   case patchAsValue bytes person of+--     Left err -> sendResponse 400 $ displayException err+--     Right updated -> do+--       runDB $ update id updated+--       sendResponse 200 updated       -- Person "pat" 21+-- @+--+-- If the patch creates a value that can't parse back to your domain type, that+-- will also be normalized to 'PatchError'.+patchAsValue+  :: (AsValue patch, FromJSON v, ToJSON v) => patch -> v -> Either PatchError v+patchAsValue p target = do+  pVal <- note (ParseError Null "not JSON") $ p ^? _Value+  patches <- fromJSONEither pVal+  result <- patchValue patches $ toJSON target+  fromJSONEither result++fromJSONEither :: FromJSON a => Value -> Either PatchError a+fromJSONEither v = case fromJSON v of+  Error e -> Left $ ParseError v e+  Success a -> Right a

src/Data/JSON/Patch/Prelude.hs view

@@ -1,3 +1,11 @@+-- |+--+-- Module      : Data.JSON.Patch.Prelude+-- Copyright   : (c) 2025 Patrick Brisbin+-- License     : AGPL-3+-- Maintainer  : pbrisbin@gmail.com+-- Stability   : experimental+-- Portability : POSIX module Data.JSON.Patch.Prelude   ( module X   , note

src/Data/JSON/Patch/Type.hs view

@@ -6,6 +6,8 @@ -- Maintainer  : pbrisbin@gmail.com -- Stability   : experimental -- Portability : POSIX+--+-- <https://datatracker.ietf.org/doc/html/rfc6902> module Data.JSON.Patch.Type   ( Patch (..)   , AddOp (..)

src/Data/JSON/Pointer.hs view

@@ -1,3 +1,12 @@+-- |+--+-- Module      : Data.JSON.Pointer+-- Copyright   : (c) 2025 Patrick Brisbin+-- License     : AGPL-3+-- Maintainer  : pbrisbin@gmail.com+-- Stability   : experimental+-- Portability : POSIX+-- -- <https://datatracker.ietf.org/doc/html/rfc6901/> module Data.JSON.Pointer   ( Pointer (..)

test/Data/JSON/PatchSpec.hs view

@@ -70,9 +70,7 @@       | otherwise = it      comment = fromMaybe ("test #" <> show n) t.comment-    result = case fromJSON t.patch of-      Error err -> Left $ ParseError t.patch err-      Success patches -> applyPatches patches t.doc+    result = patchAsValue t.patch t.doc    it' comment $ case (result, t.expected) of     (Left ex, Left e) -> do

test/Data/JSON/Pointer/TokenSpec.hs view

@@ -1,3 +1,11 @@+-- |+--+-- Module      : Data.JSON.Pointer.TokenSpec+-- Copyright   : (c) 2025 Patrick Brisbin+-- License     : AGPL-3+-- Maintainer  : pbrisbin@gmail.com+-- Stability   : experimental+-- Portability : POSIX module Data.JSON.Pointer.TokenSpec   ( spec   ) where