-- |
--
-- Module      : Data.JSON.Patch.Apply
-- Copyright   : (c) 2025 Patrick Brisbin
-- License     : AGPL-3
-- Maintainer  : pbrisbin@gmail.com
-- Stability   : experimental
-- Portability : POSIX
module Data.JSON.Patch.Apply
  ( PatchError (..)
  , patchValue
  ) where

import Data.JSON.Patch.Prelude

import Data.Aeson (Value (..))
import Data.JSON.Patch.Error
import Data.JSON.Patch.Type
import Data.JSON.Pointer
import Data.JSON.Pointer.Token
import Data.Vector qualified as V
import Optics.Core

-- | Apply the given 'Patch'es to the given 'Value'
patchValue :: [Patch] -> Value -> Either PatchError Value
patchValue :: [Patch] -> Value -> Either PatchError Value
patchValue [Patch]
patches Value
target = (Value -> Patch -> Either PatchError Value)
-> Value -> [Patch] -> Either PatchError Value
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Value -> Patch -> Either PatchError Value
go Value
target [Patch]
patches
 where
  go :: Value -> Patch -> Either PatchError Value
  go :: Value -> Patch -> Either PatchError Value
go Value
val = \case
    Add AddOp
op -> Value -> Pointer -> Value -> Either PatchError Value
add AddOp
op.value AddOp
op.path Value
val
    Remove RemoveOp
op -> Pointer -> Value -> Either PatchError Value
remove RemoveOp
op.path Value
val
    Replace ReplaceOp
op -> Pointer -> Value -> Either PatchError Value
remove ReplaceOp
op.path Value
val Either PatchError Value
-> (Value -> Either PatchError Value) -> Either PatchError Value
forall a b.
Either PatchError a
-> (a -> Either PatchError b) -> Either PatchError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Pointer -> Value -> Either PatchError Value
add ReplaceOp
op.value ReplaceOp
op.path
    Move MoveOp
op -> Pointer -> Value -> Either PatchError Value
get MoveOp
op.from Value
val Either PatchError Value
-> (Value -> Either PatchError Value) -> Either PatchError Value
forall a b.
Either PatchError a
-> (a -> Either PatchError b) -> Either PatchError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Value
v -> Pointer -> Value -> Either PatchError Value
remove MoveOp
op.from Value
val Either PatchError Value
-> (Value -> Either PatchError Value) -> Either PatchError Value
forall a b.
Either PatchError a
-> (a -> Either PatchError b) -> Either PatchError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Pointer -> Value -> Either PatchError Value
add Value
v MoveOp
op.path
    Copy CopyOp
op -> Pointer -> Value -> Either PatchError Value
get CopyOp
op.from Value
val Either PatchError Value
-> (Value -> Either PatchError Value) -> Either PatchError Value
forall a b.
Either PatchError a
-> (a -> Either PatchError b) -> Either PatchError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Value
v -> Value -> Pointer -> Value -> Either PatchError Value
add Value
v CopyOp
op.path Value
val
    Test TestOp
op -> Pointer -> Value -> Either PatchError Value
get TestOp
op.path Value
val Either PatchError Value
-> (Value -> Either PatchError Value) -> Either PatchError Value
forall a b.
Either PatchError a
-> (a -> Either PatchError b) -> Either PatchError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Value
v -> Value -> Value -> Pointer -> Value -> Either PatchError Value
test Value
v TestOp
op.value TestOp
op.path Value
val

get :: Pointer -> Value -> Either PatchError Value
get :: Pointer -> Value -> Either PatchError Value
get Pointer
p Value
val = PatchError -> Maybe Value -> Either PatchError Value
forall e a. e -> Maybe a -> Either e a
note (Pointer -> Maybe String -> PatchError
PointerNotFound Pointer
p Maybe String
forall a. Maybe a
Nothing) (Maybe Value -> Either PatchError Value)
-> Maybe Value -> Either PatchError Value
forall a b. (a -> b) -> a -> b
$ Value
val Value -> Optic' An_AffineTraversal NoIx Value Value -> Maybe Value
forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Pointer -> Optic' An_AffineTraversal NoIx Value Value
pointerL Pointer
p

add :: Value -> Pointer -> Value -> Either PatchError Value
add :: Value -> Pointer -> Value -> Either PatchError Value
add Value
v Pointer
p Value
val = case Pointer -> Maybe (Pointer, Token)
splitPointer Pointer
p of
  Maybe (Pointer, Token)
Nothing -> Value -> Either PatchError Value
forall a b. b -> Either a b
Right Value
v
  Just (Pointer
parent, Token
t) -> do
    Pointer -> Token -> Value -> Either PatchError ()
validateAdd Pointer
parent Token
t Value
val
    Value -> Either PatchError Value
forall a b. b -> Either a b
Right (Value -> Either PatchError Value)
-> Value -> Either PatchError Value
forall a b. (a -> b) -> a -> b
$ Value
val Value -> (Value -> Value) -> Value
forall a b. a -> (a -> b) -> b
& Pointer -> AffineTraversal' Value (Maybe Value)
atPointerL Pointer
p AffineTraversal' Value (Maybe Value) -> Value -> Value -> Value
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a (Maybe b) -> b -> s -> t
?~ Value
v

remove :: Pointer -> Value -> Either PatchError Value
remove :: Pointer -> Value -> Either PatchError Value
remove Pointer
p Value
val = do
  Either PatchError Value -> Either PatchError ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Either PatchError Value -> Either PatchError ())
-> Either PatchError Value -> Either PatchError ()
forall a b. (a -> b) -> a -> b
$ Pointer -> Value -> Either PatchError Value
get Pointer
p Value
val
  Value -> Either PatchError Value
forall a b. b -> Either a b
Right (Value -> Either PatchError Value)
-> Value -> Either PatchError Value
forall a b. (a -> b) -> a -> b
$ Value
val Value -> (Value -> Value) -> Value
forall a b. a -> (a -> b) -> b
& Pointer -> AffineTraversal' Value (Maybe Value)
atPointerL Pointer
p AffineTraversal' Value (Maybe Value)
-> Maybe Value -> Value -> Value
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Maybe Value
forall a. Maybe a
Nothing

test :: Value -> Value -> Pointer -> Value -> Either PatchError Value
test :: Value -> Value -> Pointer -> Value -> Either PatchError Value
test Value
v Value
expected Pointer
p Value
val =
  PatchError -> Maybe Value -> Either PatchError Value
forall e a. e -> Maybe a -> Either e a
note (Pointer -> Value -> Value -> PatchError
TestFailed Pointer
p Value
v Value
expected) (Maybe Value -> Either PatchError Value)
-> Maybe Value -> Either PatchError Value
forall a b. (a -> b) -> a -> b
$ Value
val Value -> Maybe () -> Maybe Value
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Value
v Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value
expected)

validateAdd :: Pointer -> Token -> Value -> Either PatchError ()
validateAdd :: Pointer -> Token -> Value -> Either PatchError ()
validateAdd Pointer
parent Token
t Value
val = do
  Value
target <- Pointer -> Value -> Either PatchError Value
get Pointer
parent Value
val

  case (Token
t, Value
target) of
    (Token
_, Object Object
_) -> () -> Either PatchError ()
forall a b. b -> Either a b
Right () -- everything works on objects
    (K Key
_, Value
v) -> PatchError -> Either PatchError ()
forall a b. a -> Either a b
Left (PatchError -> Either PatchError ())
-> PatchError -> Either PatchError ()
forall a b. (a -> b) -> a -> b
$ Pointer -> Value -> PatchError
InvalidObjectOperation Pointer
parent Value
v
    (N Int
n, Array Array
vec) -> do
      Bool -> Either PatchError () -> Either PatchError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0) (Either PatchError () -> Either PatchError ())
-> Either PatchError () -> Either PatchError ()
forall a b. (a -> b) -> a -> b
$ PatchError -> Either PatchError ()
forall a b. a -> Either a b
Left (PatchError -> Either PatchError ())
-> PatchError -> Either PatchError ()
forall a b. (a -> b) -> a -> b
$ Pointer -> Int -> Array -> PatchError
IndexOutOfBounds Pointer
parent Int
n Array
vec
      Bool -> Either PatchError () -> Either PatchError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Array -> Int
forall a. Vector a -> Int
V.length Array
vec) (Either PatchError () -> Either PatchError ())
-> Either PatchError () -> Either PatchError ()
forall a b. (a -> b) -> a -> b
$ PatchError -> Either PatchError ()
forall a b. a -> Either a b
Left (PatchError -> Either PatchError ())
-> PatchError -> Either PatchError ()
forall a b. (a -> b) -> a -> b
$ Pointer -> Int -> Array -> PatchError
IndexOutOfBounds Pointer
parent Int
n Array
vec
    (N Int
_, Value
v) -> PatchError -> Either PatchError ()
forall a b. a -> Either a b
Left (PatchError -> Either PatchError ())
-> PatchError -> Either PatchError ()
forall a b. (a -> b) -> a -> b
$ Pointer -> Value -> PatchError
InvalidArrayOperation Pointer
parent Value
v
    (Token, Value)
_ -> () -> Either PatchError ()
forall a b. b -> Either a b
Right ()