-- |
--
-- Module      : Data.JSON.Patch.Type
-- Copyright   : (c) 2025 Patrick Brisbin
-- License     : AGPL-3
-- Maintainer  : pbrisbin@gmail.com
-- Stability   : experimental
-- Portability : POSIX
module Data.JSON.Patch.Type
  ( Patch (..)
  , AddOp (..)
  , RemoveOp (..)
  , ReplaceOp (..)
  , CopyOp (..)
  , MoveOp (..)
  , TestOp (..)
  ) where

import Prelude

import Data.Aeson
import Data.JSON.Pointer
import Data.Text (Text)
import GHC.Generics (Generic)

data Patch
  = Add AddOp
  | Remove RemoveOp
  | Replace ReplaceOp
  | Copy CopyOp
  | Move MoveOp
  | Test TestOp
  deriving stock (Patch -> Patch -> Bool
(Patch -> Patch -> Bool) -> (Patch -> Patch -> Bool) -> Eq Patch
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Patch -> Patch -> Bool
== :: Patch -> Patch -> Bool
$c/= :: Patch -> Patch -> Bool
/= :: Patch -> Patch -> Bool
Eq, Int -> Patch -> ShowS
[Patch] -> ShowS
Patch -> String
(Int -> Patch -> ShowS)
-> (Patch -> String) -> ([Patch] -> ShowS) -> Show Patch
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Patch -> ShowS
showsPrec :: Int -> Patch -> ShowS
$cshow :: Patch -> String
show :: Patch -> String
$cshowList :: [Patch] -> ShowS
showList :: [Patch] -> ShowS
Show)

instance FromJSON Patch where
  parseJSON :: Value -> Parser Patch
parseJSON = String -> (Object -> Parser Patch) -> Value -> Parser Patch
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Operation" ((Object -> Parser Patch) -> Value -> Parser Patch)
-> (Object -> Parser Patch) -> Value -> Parser Patch
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Text
op <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"op"

    case (Text
op :: Text) of
      Text
"add" -> AddOp -> Patch
Add (AddOp -> Patch) -> Parser AddOp -> Parser Patch
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser AddOp
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
      Text
"remove" -> RemoveOp -> Patch
Remove (RemoveOp -> Patch) -> Parser RemoveOp -> Parser Patch
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser RemoveOp
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
      Text
"replace" -> ReplaceOp -> Patch
Replace (ReplaceOp -> Patch) -> Parser ReplaceOp -> Parser Patch
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ReplaceOp
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
      Text
"copy" -> CopyOp -> Patch
Copy (CopyOp -> Patch) -> Parser CopyOp -> Parser Patch
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser CopyOp
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
      Text
"move" -> MoveOp -> Patch
Move (MoveOp -> Patch) -> Parser MoveOp -> Parser Patch
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser MoveOp
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
      Text
"test" -> TestOp -> Patch
Test (TestOp -> Patch) -> Parser TestOp -> Parser Patch
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser TestOp
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
      Text
x ->
        String -> Parser Patch
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
          (String -> Parser Patch) -> String -> Parser Patch
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ String
"unexpected operation, "
            , Text -> String
forall a. Show a => a -> String
show Text
x
            , String
", must be one of add, remove, replace, copy, move, or test"
            ]

data AddOp = AddOp
  { AddOp -> Pointer
path :: Pointer
  , AddOp -> Value
value :: Value
  }
  deriving stock (AddOp -> AddOp -> Bool
(AddOp -> AddOp -> Bool) -> (AddOp -> AddOp -> Bool) -> Eq AddOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AddOp -> AddOp -> Bool
== :: AddOp -> AddOp -> Bool
$c/= :: AddOp -> AddOp -> Bool
/= :: AddOp -> AddOp -> Bool
Eq, (forall x. AddOp -> Rep AddOp x)
-> (forall x. Rep AddOp x -> AddOp) -> Generic AddOp
forall x. Rep AddOp x -> AddOp
forall x. AddOp -> Rep AddOp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AddOp -> Rep AddOp x
from :: forall x. AddOp -> Rep AddOp x
$cto :: forall x. Rep AddOp x -> AddOp
to :: forall x. Rep AddOp x -> AddOp
Generic, Int -> AddOp -> ShowS
[AddOp] -> ShowS
AddOp -> String
(Int -> AddOp -> ShowS)
-> (AddOp -> String) -> ([AddOp] -> ShowS) -> Show AddOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AddOp -> ShowS
showsPrec :: Int -> AddOp -> ShowS
$cshow :: AddOp -> String
show :: AddOp -> String
$cshowList :: [AddOp] -> ShowS
showList :: [AddOp] -> ShowS
Show)
  deriving anyclass (Maybe AddOp
Value -> Parser [AddOp]
Value -> Parser AddOp
(Value -> Parser AddOp)
-> (Value -> Parser [AddOp]) -> Maybe AddOp -> FromJSON AddOp
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser AddOp
parseJSON :: Value -> Parser AddOp
$cparseJSONList :: Value -> Parser [AddOp]
parseJSONList :: Value -> Parser [AddOp]
$comittedField :: Maybe AddOp
omittedField :: Maybe AddOp
FromJSON)

newtype RemoveOp = RemoveOp
  { RemoveOp -> Pointer
path :: Pointer
  }
  deriving stock (RemoveOp -> RemoveOp -> Bool
(RemoveOp -> RemoveOp -> Bool)
-> (RemoveOp -> RemoveOp -> Bool) -> Eq RemoveOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RemoveOp -> RemoveOp -> Bool
== :: RemoveOp -> RemoveOp -> Bool
$c/= :: RemoveOp -> RemoveOp -> Bool
/= :: RemoveOp -> RemoveOp -> Bool
Eq, (forall x. RemoveOp -> Rep RemoveOp x)
-> (forall x. Rep RemoveOp x -> RemoveOp) -> Generic RemoveOp
forall x. Rep RemoveOp x -> RemoveOp
forall x. RemoveOp -> Rep RemoveOp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RemoveOp -> Rep RemoveOp x
from :: forall x. RemoveOp -> Rep RemoveOp x
$cto :: forall x. Rep RemoveOp x -> RemoveOp
to :: forall x. Rep RemoveOp x -> RemoveOp
Generic, Int -> RemoveOp -> ShowS
[RemoveOp] -> ShowS
RemoveOp -> String
(Int -> RemoveOp -> ShowS)
-> (RemoveOp -> String) -> ([RemoveOp] -> ShowS) -> Show RemoveOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RemoveOp -> ShowS
showsPrec :: Int -> RemoveOp -> ShowS
$cshow :: RemoveOp -> String
show :: RemoveOp -> String
$cshowList :: [RemoveOp] -> ShowS
showList :: [RemoveOp] -> ShowS
Show)
  deriving anyclass (Maybe RemoveOp
Value -> Parser [RemoveOp]
Value -> Parser RemoveOp
(Value -> Parser RemoveOp)
-> (Value -> Parser [RemoveOp])
-> Maybe RemoveOp
-> FromJSON RemoveOp
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser RemoveOp
parseJSON :: Value -> Parser RemoveOp
$cparseJSONList :: Value -> Parser [RemoveOp]
parseJSONList :: Value -> Parser [RemoveOp]
$comittedField :: Maybe RemoveOp
omittedField :: Maybe RemoveOp
FromJSON)

data ReplaceOp = ReplaceOp
  { ReplaceOp -> Pointer
path :: Pointer
  , ReplaceOp -> Value
value :: Value
  }
  deriving stock (ReplaceOp -> ReplaceOp -> Bool
(ReplaceOp -> ReplaceOp -> Bool)
-> (ReplaceOp -> ReplaceOp -> Bool) -> Eq ReplaceOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ReplaceOp -> ReplaceOp -> Bool
== :: ReplaceOp -> ReplaceOp -> Bool
$c/= :: ReplaceOp -> ReplaceOp -> Bool
/= :: ReplaceOp -> ReplaceOp -> Bool
Eq, (forall x. ReplaceOp -> Rep ReplaceOp x)
-> (forall x. Rep ReplaceOp x -> ReplaceOp) -> Generic ReplaceOp
forall x. Rep ReplaceOp x -> ReplaceOp
forall x. ReplaceOp -> Rep ReplaceOp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ReplaceOp -> Rep ReplaceOp x
from :: forall x. ReplaceOp -> Rep ReplaceOp x
$cto :: forall x. Rep ReplaceOp x -> ReplaceOp
to :: forall x. Rep ReplaceOp x -> ReplaceOp
Generic, Int -> ReplaceOp -> ShowS
[ReplaceOp] -> ShowS
ReplaceOp -> String
(Int -> ReplaceOp -> ShowS)
-> (ReplaceOp -> String)
-> ([ReplaceOp] -> ShowS)
-> Show ReplaceOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReplaceOp -> ShowS
showsPrec :: Int -> ReplaceOp -> ShowS
$cshow :: ReplaceOp -> String
show :: ReplaceOp -> String
$cshowList :: [ReplaceOp] -> ShowS
showList :: [ReplaceOp] -> ShowS
Show)
  deriving anyclass (Maybe ReplaceOp
Value -> Parser [ReplaceOp]
Value -> Parser ReplaceOp
(Value -> Parser ReplaceOp)
-> (Value -> Parser [ReplaceOp])
-> Maybe ReplaceOp
-> FromJSON ReplaceOp
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser ReplaceOp
parseJSON :: Value -> Parser ReplaceOp
$cparseJSONList :: Value -> Parser [ReplaceOp]
parseJSONList :: Value -> Parser [ReplaceOp]
$comittedField :: Maybe ReplaceOp
omittedField :: Maybe ReplaceOp
FromJSON)

data CopyOp = CopyOp
  { CopyOp -> Pointer
from :: Pointer
  , CopyOp -> Pointer
path :: Pointer
  }
  deriving stock (CopyOp -> CopyOp -> Bool
(CopyOp -> CopyOp -> Bool)
-> (CopyOp -> CopyOp -> Bool) -> Eq CopyOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CopyOp -> CopyOp -> Bool
== :: CopyOp -> CopyOp -> Bool
$c/= :: CopyOp -> CopyOp -> Bool
/= :: CopyOp -> CopyOp -> Bool
Eq, (forall x. CopyOp -> Rep CopyOp x)
-> (forall x. Rep CopyOp x -> CopyOp) -> Generic CopyOp
forall x. Rep CopyOp x -> CopyOp
forall x. CopyOp -> Rep CopyOp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CopyOp -> Rep CopyOp x
from :: forall x. CopyOp -> Rep CopyOp x
$cto :: forall x. Rep CopyOp x -> CopyOp
to :: forall x. Rep CopyOp x -> CopyOp
Generic, Int -> CopyOp -> ShowS
[CopyOp] -> ShowS
CopyOp -> String
(Int -> CopyOp -> ShowS)
-> (CopyOp -> String) -> ([CopyOp] -> ShowS) -> Show CopyOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CopyOp -> ShowS
showsPrec :: Int -> CopyOp -> ShowS
$cshow :: CopyOp -> String
show :: CopyOp -> String
$cshowList :: [CopyOp] -> ShowS
showList :: [CopyOp] -> ShowS
Show)
  deriving anyclass (Maybe CopyOp
Value -> Parser [CopyOp]
Value -> Parser CopyOp
(Value -> Parser CopyOp)
-> (Value -> Parser [CopyOp]) -> Maybe CopyOp -> FromJSON CopyOp
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser CopyOp
parseJSON :: Value -> Parser CopyOp
$cparseJSONList :: Value -> Parser [CopyOp]
parseJSONList :: Value -> Parser [CopyOp]
$comittedField :: Maybe CopyOp
omittedField :: Maybe CopyOp
FromJSON)

data MoveOp = MoveOp
  { MoveOp -> Pointer
from :: Pointer
  , MoveOp -> Pointer
path :: Pointer
  }
  deriving stock (MoveOp -> MoveOp -> Bool
(MoveOp -> MoveOp -> Bool)
-> (MoveOp -> MoveOp -> Bool) -> Eq MoveOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MoveOp -> MoveOp -> Bool
== :: MoveOp -> MoveOp -> Bool
$c/= :: MoveOp -> MoveOp -> Bool
/= :: MoveOp -> MoveOp -> Bool
Eq, (forall x. MoveOp -> Rep MoveOp x)
-> (forall x. Rep MoveOp x -> MoveOp) -> Generic MoveOp
forall x. Rep MoveOp x -> MoveOp
forall x. MoveOp -> Rep MoveOp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MoveOp -> Rep MoveOp x
from :: forall x. MoveOp -> Rep MoveOp x
$cto :: forall x. Rep MoveOp x -> MoveOp
to :: forall x. Rep MoveOp x -> MoveOp
Generic, Int -> MoveOp -> ShowS
[MoveOp] -> ShowS
MoveOp -> String
(Int -> MoveOp -> ShowS)
-> (MoveOp -> String) -> ([MoveOp] -> ShowS) -> Show MoveOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MoveOp -> ShowS
showsPrec :: Int -> MoveOp -> ShowS
$cshow :: MoveOp -> String
show :: MoveOp -> String
$cshowList :: [MoveOp] -> ShowS
showList :: [MoveOp] -> ShowS
Show)
  deriving anyclass (Maybe MoveOp
Value -> Parser [MoveOp]
Value -> Parser MoveOp
(Value -> Parser MoveOp)
-> (Value -> Parser [MoveOp]) -> Maybe MoveOp -> FromJSON MoveOp
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser MoveOp
parseJSON :: Value -> Parser MoveOp
$cparseJSONList :: Value -> Parser [MoveOp]
parseJSONList :: Value -> Parser [MoveOp]
$comittedField :: Maybe MoveOp
omittedField :: Maybe MoveOp
FromJSON)

data TestOp = TestOp
  { TestOp -> Pointer
path :: Pointer
  , TestOp -> Value
value :: Value
  }
  deriving stock (TestOp -> TestOp -> Bool
(TestOp -> TestOp -> Bool)
-> (TestOp -> TestOp -> Bool) -> Eq TestOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TestOp -> TestOp -> Bool
== :: TestOp -> TestOp -> Bool
$c/= :: TestOp -> TestOp -> Bool
/= :: TestOp -> TestOp -> Bool
Eq, (forall x. TestOp -> Rep TestOp x)
-> (forall x. Rep TestOp x -> TestOp) -> Generic TestOp
forall x. Rep TestOp x -> TestOp
forall x. TestOp -> Rep TestOp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TestOp -> Rep TestOp x
from :: forall x. TestOp -> Rep TestOp x
$cto :: forall x. Rep TestOp x -> TestOp
to :: forall x. Rep TestOp x -> TestOp
Generic, Int -> TestOp -> ShowS
[TestOp] -> ShowS
TestOp -> String
(Int -> TestOp -> ShowS)
-> (TestOp -> String) -> ([TestOp] -> ShowS) -> Show TestOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TestOp -> ShowS
showsPrec :: Int -> TestOp -> ShowS
$cshow :: TestOp -> String
show :: TestOp -> String
$cshowList :: [TestOp] -> ShowS
showList :: [TestOp] -> ShowS
Show)
  deriving anyclass (Maybe TestOp
Value -> Parser [TestOp]
Value -> Parser TestOp
(Value -> Parser TestOp)
-> (Value -> Parser [TestOp]) -> Maybe TestOp -> FromJSON TestOp
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser TestOp
parseJSON :: Value -> Parser TestOp
$cparseJSONList :: Value -> Parser [TestOp]
parseJSONList :: Value -> Parser [TestOp]
$comittedField :: Maybe TestOp
omittedField :: Maybe TestOp
FromJSON)