    {-# LANGUAGE DeriveGeneric              #-}
    {-# 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

    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 qualified Data.Vector                as V
    import           GHC.Generics               (Generic)

    import Data.Aeson.Pointer (Pointer)

    -- * Patches

    -- | Describes the changes between two JSON documents.
    newtype Patch = Patch
        { Patch -> [Operation]
    patchOperations :: [Operation] }
      deriving (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, NonEmpty Patch -> Patch
    Patch -> Patch -> Patch
    (Patch -> Patch -> Patch)
    -> (NonEmpty Patch -> Patch)
    -> (forall b. Integral b => b -> Patch -> Patch)
    -> Semigroup Patch
    forall b. Integral b => b -> Patch -> Patch
    forall a.
    (a -> a -> a)
    -> (NonEmpty a -> a)
    -> (forall b. Integral b => b -> a -> a)
    -> Semigroup a
    $c<> :: Patch -> Patch -> Patch
    <> :: Patch -> Patch -> Patch
    $csconcat :: NonEmpty Patch -> Patch
    sconcat :: NonEmpty Patch -> Patch
    $cstimes :: forall b. Integral b => b -> Patch -> Patch
    stimes :: forall b. Integral b => b -> Patch -> Patch
    Semigroup, Semigroup Patch
    Patch
    Semigroup Patch =>
    Patch
    -> (Patch -> Patch -> Patch) -> ([Patch] -> Patch) -> Monoid Patch
    [Patch] -> Patch
    Patch -> Patch -> Patch
    forall a.
    Semigroup a =>
    a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
    $cmempty :: Patch
    mempty :: Patch
    $cmappend :: Patch -> Patch -> Patch
    mappend :: Patch -> Patch -> Patch
    $cmconcat :: [Patch] -> Patch
    mconcat :: [Patch] -> Patch
    Monoid, (forall x. Patch -> Rep Patch x)
    -> (forall x. Rep Patch x -> Patch) -> Generic Patch
    forall x. Rep Patch x -> Patch
    forall x. Patch -> Rep Patch x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    $cfrom :: forall x. Patch -> Rep Patch x
    from :: forall x. Patch -> Rep Patch x
    $cto :: forall x. Rep Patch x -> Patch
    to :: forall x. Rep Patch x -> Patch
    Generic)

    instance ToJSON Patch where
        toJSON :: Patch -> Value
    toJSON (Patch [Operation]
    ops) = [Operation] -> Value
    forall a. ToJSON a => a -> Value
    toJSON [Operation]
    ops

    instance FromJSON Patch where
        parseJSON :: Value -> Parser Patch
    parseJSON = ShowS -> Parser Patch -> Parser Patch
    forall a. ShowS -> Parser a -> Parser a
    modifyFailure (String
    "Could not parse patch: " String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> ) (Parser Patch -> Parser Patch)
    -> (Value -> Parser Patch) -> Value -> Parser Patch
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Value -> Parser Patch
    parsePatch
          where
            parsePatch :: Value -> Parser Patch
    parsePatch (Array Array
    v) = [Operation] -> Patch
    Patch ([Operation] -> Patch) -> Parser [Operation] -> Parser Patch
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Value -> Parser Operation) -> [Value] -> Parser [Operation]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Value -> Parser Operation
    forall a. FromJSON a => Value -> Parser a
    parseJSON (Array -> [Value]
    forall a. Vector a -> [a]
    V.toList Array
    v)
            parsePatch Value
    v = String -> Value -> Parser Patch
    forall a. String -> Value -> Parser a
    typeMismatch String
    "Array" Value
    v

    -- | Modify the pointers in the 'Operation's of a 'Patch'.
    --
    -- See 'modifyPointer' for details.
    modifyPointers :: (Pointer -> Pointer) -> Patch -> Patch
    modifyPointers :: (Pointer -> Pointer) -> Patch -> Patch
    modifyPointers Pointer -> Pointer
    f (Patch [Operation]
    ops) = [Operation] -> Patch
    Patch ((Operation -> Operation) -> [Operation] -> [Operation]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Pointer -> Pointer) -> Operation -> Operation
    modifyPointer Pointer -> Pointer
    f) [Operation]
    ops)

    -- * Operations

    -- | An 'Operation' describes the operations which can appear as part of a JSON
    -- Patch.
    --
    -- See RFC 6902 Section 4 <http://tools.ietf.org/html/rfc6902#section-4>.
    data Operation
        = Add { Operation -> Pointer
    changePointer :: Pointer, Operation -> Value
    changeValue :: Value }
        -- ^ http://tools.ietf.org/html/rfc6902#section-4.1
        | Cpy { changePointer :: Pointer, Operation -> 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
        | Tst { changePointer :: Pointer, changeValue :: Value }
        -- ^ http://tools.ietf.org/html/rfc6902#section-4.6
      deriving (Operation -> Operation -> Bool
    (Operation -> Operation -> Bool)
    -> (Operation -> Operation -> Bool) -> Eq Operation
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Operation -> Operation -> Bool
    == :: Operation -> Operation -> Bool
    $c/= :: Operation -> Operation -> Bool
    /= :: Operation -> Operation -> Bool
    Eq, Int -> Operation -> ShowS
    [Operation] -> ShowS
    Operation -> String
    (Int -> Operation -> ShowS)
    -> (Operation -> String)
    -> ([Operation] -> ShowS)
    -> Show Operation
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Operation -> ShowS
    showsPrec :: Int -> Operation -> ShowS
    $cshow :: Operation -> String
    show :: Operation -> String
    $cshowList :: [Operation] -> ShowS
    showList :: [Operation] -> ShowS
    Show, (forall x. Operation -> Rep Operation x)
    -> (forall x. Rep Operation x -> Operation) -> Generic Operation
    forall x. Rep Operation x -> Operation
    forall x. Operation -> Rep Operation x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    $cfrom :: forall x. Operation -> Rep Operation x
    from :: forall x. Operation -> Rep Operation x
    $cto :: forall x. Rep Operation x -> Operation
    to :: forall x. Rep Operation x -> Operation
    Generic)

    instance ToJSON Operation where
        toJSON :: Operation -> Value
    toJSON (Add Pointer
    p Value
    v) = [Pair] -> Value
    object
            [ (Key
    "op", Value
    "add")
            , Key
    "path"  Key -> Pointer -> Pair
    forall v. ToJSON v => Key -> v -> Pair
    forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
    .= Pointer
    p
            , Key
    "value" Key -> Value -> Pair
    forall v. ToJSON v => Key -> v -> Pair
    forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
    .= Value
    v
            ]
        toJSON (Cpy Pointer
    p Pointer
    f) = [Pair] -> Value
    object
            [ (Key
    "op", Value
    "copy")
            , Key
    "path" Key -> Pointer -> Pair
    forall v. ToJSON v => Key -> v -> Pair
    forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
    .= Pointer
    p
            , Key
    "from" Key -> Pointer -> Pair
    forall v. ToJSON v => Key -> v -> Pair
    forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
    .= Pointer
    f
            ]
        toJSON (Mov Pointer
    p Pointer
    f) = [Pair] -> Value
    object
            [ (Key
    "op", Value
    "move")
            , Key
    "path" Key -> Pointer -> Pair
    forall v. ToJSON v => Key -> v -> Pair
    forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
    .= Pointer
    p
            , Key
    "from" Key -> Pointer -> Pair
    forall v. ToJSON v => Key -> v -> Pair
    forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
    .= Pointer
    f
            ]
        toJSON (Rem Pointer
    p) = [Pair] -> Value
    object
            [ (Key
    "op", Value
    "remove")
            , Key
    "path" Key -> Pointer -> Pair
    forall v. ToJSON v => Key -> v -> Pair
    forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
    .= Pointer
    p
            ]
        toJSON (Rep Pointer
    p Value
    v) = [Pair] -> Value
    object
            [ (Key
    "op", Value
    "replace")
            , Key
    "path"  Key -> Pointer -> Pair
    forall v. ToJSON v => Key -> v -> Pair
    forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
    .= Pointer
    p
            , Key
    "value" Key -> Value -> Pair
    forall v. ToJSON v => Key -> v -> Pair
    forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
    .= Value
    v
            ]
        toJSON (Tst Pointer
    p Value
    v) = [Pair] -> Value
    object
            [ (Key
    "op", Value
    "test")
            , Key
    "path" Key -> Pointer -> Pair
    forall v. ToJSON v => Key -> v -> Pair
    forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
    .= Pointer
    p
            , Key
    "value" Key -> Value -> Pair
    forall v. ToJSON v => Key -> v -> Pair
    forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
    .= Value
    v
            ]

    instance FromJSON Operation where
        parseJSON :: Value -> Parser Operation
    parseJSON = Value -> Parser Operation
    parse
          where
            parse :: Value -> Parser Operation
    parse o :: Value
    o@(Object Object
    v)
                =   (Object -> Text -> Parser Value
    op Object
    v Text
    "add"     Parser Value -> Parser Operation -> Parser Operation
    forall a b. Parser a -> Parser b -> Parser b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> (Pointer -> Value -> Operation
    Add (Pointer -> Value -> Operation)
    -> Parser Pointer -> Parser (Value -> Operation)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Object
    v Object -> Key -> Parser Pointer
    forall a. FromJSON a => Object -> Key -> Parser a
    .: Key
    "path" Parser (Value -> Operation) -> Parser Value -> Parser Operation
    forall a b. Parser (a -> b) -> Parser a -> Parser b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Object
    v Object -> Key -> Parser Value
    forall a. FromJSON a => Object -> Key -> Parser a
    .: Key
    "value"))
                Parser Operation -> Parser Operation -> Parser Operation
    forall a. Parser a -> Parser a -> Parser a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> (Object -> Text -> Parser Value
    op Object
    v Text
    "copy"    Parser Value -> Parser Operation -> Parser Operation
    forall a b. Parser a -> Parser b -> Parser b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> (Pointer -> Pointer -> Operation
    Cpy (Pointer -> Pointer -> Operation)
    -> Parser Pointer -> Parser (Pointer -> Operation)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Object
    v Object -> Key -> Parser Pointer
    forall a. FromJSON a => Object -> Key -> Parser a
    .: Key
    "path" Parser (Pointer -> Operation) -> Parser Pointer -> Parser Operation
    forall a b. Parser (a -> b) -> Parser a -> Parser b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Object
    v Object -> Key -> Parser Pointer
    forall a. FromJSON a => Object -> Key -> Parser a
    .: Key
    "from"))
                Parser Operation -> Parser Operation -> Parser Operation
    forall a. Parser a -> Parser a -> Parser a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> (Object -> Text -> Parser Value
    op Object
    v Text
    "move"    Parser Value -> Parser Operation -> Parser Operation
    forall a b. Parser a -> Parser b -> Parser b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> (Pointer -> Pointer -> Operation
    Mov (Pointer -> Pointer -> Operation)
    -> Parser Pointer -> Parser (Pointer -> Operation)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Object
    v Object -> Key -> Parser Pointer
    forall a. FromJSON a => Object -> Key -> Parser a
    .: Key
    "path" Parser (Pointer -> Operation) -> Parser Pointer -> Parser Operation
    forall a b. Parser (a -> b) -> Parser a -> Parser b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Object
    v Object -> Key -> Parser Pointer
    forall a. FromJSON a => Object -> Key -> Parser a
    .: Key
    "from"))
                Parser Operation -> Parser Operation -> Parser Operation
    forall a. Parser a -> Parser a -> Parser a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> (Object -> Text -> Parser Value
    op Object
    v Text
    "remove"  Parser Value -> Parser Operation -> Parser Operation
    forall a b. Parser a -> Parser b -> Parser b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> (Pointer -> Operation
    Rem (Pointer -> Operation) -> Parser Pointer -> Parser Operation
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Object
    v Object -> Key -> Parser Pointer
    forall a. FromJSON a => Object -> Key -> Parser a
    .: Key
    "path"))
                Parser Operation -> Parser Operation -> Parser Operation
    forall a. Parser a -> Parser a -> Parser a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> (Object -> Text -> Parser Value
    op Object
    v Text
    "replace" Parser Value -> Parser Operation -> Parser Operation
    forall a b. Parser a -> Parser b -> Parser b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> (Pointer -> Value -> Operation
    Rep (Pointer -> Value -> Operation)
    -> Parser Pointer -> Parser (Value -> Operation)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Object
    v Object -> Key -> Parser Pointer
    forall a. FromJSON a => Object -> Key -> Parser a
    .: Key
    "path" Parser (Value -> Operation) -> Parser Value -> Parser Operation
    forall a b. Parser (a -> b) -> Parser a -> Parser b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Object
    v Object -> Key -> Parser Value
    forall a. FromJSON a => Object -> Key -> Parser a
    .: Key
    "value"))
                Parser Operation -> Parser Operation -> Parser Operation
    forall a. Parser a -> Parser a -> Parser a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> (Object -> Text -> Parser Value
    op Object
    v Text
    "test"    Parser Value -> Parser Operation -> Parser Operation
    forall a b. Parser a -> Parser b -> Parser b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> (Pointer -> Value -> Operation
    Tst (Pointer -> Value -> Operation)
    -> Parser Pointer -> Parser (Value -> Operation)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Object
    v Object -> Key -> Parser Pointer
    forall a. FromJSON a => Object -> Key -> Parser a
    .: Key
    "path" Parser (Value -> Operation) -> Parser Value -> Parser Operation
    forall a b. Parser (a -> b) -> Parser a -> Parser b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Object
    v Object -> Key -> Parser Value
    forall a. FromJSON a => Object -> Key -> Parser a
    .: Key
    "value"))
                Parser Operation -> Parser Operation -> Parser Operation
    forall a. Parser a -> Parser a -> Parser a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> String -> Parser Operation
    forall a. String -> Parser a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String
    "Expected a JSON patch operation, encountered: " String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> ByteString -> String
    BS.unpack (Value -> ByteString
    forall a. ToJSON a => a -> ByteString
    encode Value
    o))
            parse Value
    v = String -> Value -> Parser Operation
    forall a. String -> Value -> Parser a
    typeMismatch String
    "Operation" Value
    v
            op :: Object -> Text -> Parser Value
    op Object
    v Text
    n = Object -> Key -> Value -> Parser Value
    forall {b}. (FromJSON b, Eq b) => Object -> Key -> b -> Parser b
    fixed Object
    v Key
    "op" (Text -> Value
    String Text
    n)
            fixed :: Object -> Key -> b -> Parser b
    fixed Object
    o Key
    n b
    val = do
                v' <- Object
    o Object -> Key -> Parser b
    forall a. FromJSON a => Object -> Key -> Parser a
    .: Key
    n
                if v' == val
                  then return v'
                  else mzero

    -- | 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 :: (Pointer -> Pointer) -> Operation -> Operation
    modifyPointer Pointer -> Pointer
    f Operation
    op =
      case Operation
    op of
        Add{Value
    Pointer
    changePointer :: Operation -> Pointer
    changeValue :: Operation -> Value
    changePointer :: Pointer
    changeValue :: Value
    ..} -> Operation
    op{ changePointer = f changePointer }
        Cpy{Pointer
    changePointer :: Operation -> Pointer
    fromPointer :: Operation -> Pointer
    changePointer :: Pointer
    fromPointer :: Pointer
    ..} -> Operation
    op{ changePointer = f changePointer, fromPointer = f fromPointer }
        Mov{Pointer
    changePointer :: Operation -> Pointer
    fromPointer :: Operation -> Pointer
    changePointer :: Pointer
    fromPointer :: Pointer
    ..} -> Operation
    op{ changePointer = f changePointer, fromPointer = f fromPointer }
        Rem{Pointer
    changePointer :: Operation -> Pointer
    changePointer :: Pointer
    ..} -> Operation
    op{ changePointer = f changePointer }
        Rep{Value
    Pointer
    changePointer :: Operation -> Pointer
    changeValue :: Operation -> Value
    changePointer :: Pointer
    changeValue :: Value
    ..} -> Operation
    op{ changePointer = f changePointer }
        Tst{Value
    Pointer
    changePointer :: Operation -> Pointer
    changeValue :: Operation -> Value
    changePointer :: Pointer
    changeValue :: Value
    ..} -> Operation
    op{ changePointer = f changePointer }

    isAdd :: Operation -> Bool
    isAdd :: Operation -> Bool
    isAdd Add{} = Bool
    True
    isAdd Operation
    _ = Bool
    False

    isCpy :: Operation -> Bool
    isCpy :: Operation -> Bool
    isCpy Cpy{} = Bool
    True
    isCpy Operation
    _ = Bool
    False

    isMov :: Operation -> Bool
    isMov :: Operation -> Bool
    isMov Mov{} = Bool
    True
    isMov Operation
    _ = Bool
    False

    isRem :: Operation -> Bool
    isRem :: Operation -> Bool
    isRem Rem{} = Bool
    True
    isRem Operation
    _ = Bool
    False

    isRep :: Operation -> Bool
    isRep :: Operation -> Bool
    isRep Rep{} = Bool
    True
    isRep Operation
    _ = Bool
    False

    isTst :: Operation -> Bool
    isTst :: Operation -> Bool
    isTst Tst{} = Bool
    True
    isTst Operation
    _ = Bool
    False