    {-# LANGUAGE NamedFieldPuns    #-}
    {-# LANGUAGE OverloadedStrings #-}

    -- | Description: Extract and apply patches on JSON documents.
    --
    -- This module implements data types and operations to represent the
    -- differences between JSON documents (i.e. a patch), to compare JSON documents
    -- and extract such a patch, and to apply such a patch to a JSON document.
    module Data.Aeson.Diff (
        -- * Patches
        Patch(..),
        Pointer,
        Key(..),
        Operation(..),
        Config(..),
        -- * Functions
        diff,
        diff',
        patch,
        applyOperation,
    ) where

    import           Control.Monad              (unless)
    import           Data.Aeson                 (Array, Object, Result(Success, Error), Value(Array, Object, String, Null, Bool, Number))
    import qualified Data.Aeson.Key as AesonKey
    import qualified Data.Aeson.KeyMap as HM
    import           Data.Foldable              (foldlM)
    import           Data.List                  (groupBy)
    import           Data.Maybe                 (fromJust)
    import           Data.Monoid                (Sum(Sum))
    import qualified Data.Text                  as T
    import           Data.Vector                (Vector)
    import qualified Data.Vector                as V
    import           Data.Vector.Distance       (Params(Params, equivalent, positionOffset, substitute, insert, delete, cost), leastChanges)

    import Data.Aeson.Patch                     (Operation(Add, Cpy, Mov, Rem, Rep, Tst), Patch(Patch), changePointer, changeValue, modifyPointer)
    import Data.Aeson.Pointer                   (Key(AKey, OKey), Pointer(Pointer), formatPointer, get, pointerFailure, pointerPath)

    -- * Configuration

    -- | Configuration for the diff algorithm.
    newtype Config = Config
      { Config -> Bool
    configTstBeforeRem :: Bool
      }

    defaultConfig :: Config
    defaultConfig :: Config
    defaultConfig = Bool -> Config
    Config Bool
    False

    -- * Costs

    -- | Calculate the cost of an operation.
    operationCost :: Operation -> Int
    operationCost :: Operation -> Int
    operationCost Operation
    op =
        case Operation
    op of
          Add{} -> Value -> Int
    valueSize (Operation -> Value
    changeValue Operation
    op)
          Rem{} -> Int
    1
          Rep{} -> Value -> Int
    valueSize (Operation -> Value
    changeValue Operation
    op)
          Mov{} -> Int
    1
          Cpy{} -> Int
    1
          Tst{} -> Value -> Int
    valueSize (Operation -> Value
    changeValue Operation
    op)

    -- | Estimate the size of a JSON 'Value'.
    valueSize :: Value -> Int
    valueSize :: Value -> Int
    valueSize Value
    val = case Value
    val of
        Object Object
    o -> [Int] -> Int
    forall a. Num a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum ([Int] -> Int) -> (Object -> [Int]) -> Object -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Value -> Int) -> [Value] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Value -> Int
    valueSize ([Value] -> [Int]) -> (Object -> [Value]) -> Object -> [Int]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Object -> [Value]
    forall v. KeyMap v -> [v]
    HM.elems (Object -> Int) -> Object -> Int
    forall a b. (a -> b) -> a -> b
    $ Object
    o
        Array  Array
    a -> Vector Int -> Int
    forall a. Num a => Vector a -> a
    V.sum (Vector Int -> Int) -> Vector Int -> Int
    forall a b. (a -> b) -> a -> b
    $ (Value -> Int) -> Array -> Vector Int
    forall a b. (a -> b) -> Vector a -> Vector b
    V.map Value -> Int
    valueSize Array
    a
        Value
    _        -> Int
    1

    -- * Atomic patches

    -- | Construct a patch with a single 'Add' operation.
    ins :: Config -> Pointer -> Value -> [Operation]
    ins :: Config -> Pointer -> Value -> [Operation]
    ins Config
    _cfg Pointer
    p Value
    v = [Pointer -> Value -> Operation
    Add Pointer
    p Value
    v]

    -- | Construct a patch with a single 'Rem' operation.
    del :: Config -> Pointer -> Value -> [Operation]
    del :: Config -> Pointer -> Value -> [Operation]
    del Config{Bool
    configTstBeforeRem :: Config -> Bool
    configTstBeforeRem :: Bool
    configTstBeforeRem} Pointer
    p Value
    v =
      if Bool
    configTstBeforeRem
      then [Pointer -> Value -> Operation
    Tst Pointer
    p Value
    v, Pointer -> Operation
    Rem Pointer
    p]
      else [Pointer -> Operation
    Rem Pointer
    p]

    -- | Construct a patch which changes 'Rep' operation.
    rep :: Config -> Pointer -> Value -> [Operation]
    rep :: Config -> Pointer -> Value -> [Operation]
    rep Config
    _cfg Pointer
    p Value
    v = [Pointer -> Value -> Operation
    Rep Pointer
    p Value
    v]

    -- * Diff

    -- | Compare two JSON documents and generate a patch describing the differences.
    --
    -- Uses the 'defaultConfig'.
    diff
      :: Value
      -> Value
      -> Patch
    diff :: Value -> Value -> Patch
    diff = Config -> Value -> Value -> Patch
    diff' Config
    defaultConfig

    -- | Compare two JSON documents and generate a patch describing the differences.
    diff'
        :: Config
        -> Value
        -> Value
        -> Patch
    diff' :: Config -> Value -> Value -> Patch
    diff' Config
    cfg Value
    v Value
    v' = [Operation] -> Patch
    Patch (Pointer -> Value -> Value -> [Operation]
    worker Pointer
    forall a. Monoid a => a
    mempty Value
    v Value
    v')
      where
        check :: Monoid m => Bool -> m -> m
        check :: forall m. Monoid m => Bool -> m -> m
    check Bool
    b m
    v = if Bool
    b then m
    forall a. Monoid a => a
    mempty else m
    v

        worker :: Pointer -> Value -> Value -> [Operation]
        worker :: Pointer -> Value -> Value -> [Operation]
    worker Pointer
    p Value
    v1 Value
    v2 = case (Value
    v1, Value
    v2) of
            -- For atomic values of the same type, emit changes iff they differ.
            (Value
    Null,      Value
    Null)      -> [Operation]
    forall a. Monoid a => a
    mempty
            (Bool Bool
    b1,   Bool Bool
    b2)   -> Bool -> [Operation] -> [Operation]
    forall m. Monoid m => Bool -> m -> m
    check (Bool
    b1 Bool -> Bool -> Bool
    forall a. Eq a => a -> a -> Bool
    == Bool
    b2) ([Operation] -> [Operation]) -> [Operation] -> [Operation]
    forall a b. (a -> b) -> a -> b
    $ Config -> Pointer -> Value -> [Operation]
    rep Config
    cfg Pointer
    p Value
    v2
            (Number Scientific
    n1, Number Scientific
    n2) -> Bool -> [Operation] -> [Operation]
    forall m. Monoid m => Bool -> m -> m
    check (Scientific
    n1 Scientific -> Scientific -> Bool
    forall a. Eq a => a -> a -> Bool
    == Scientific
    n2) ([Operation] -> [Operation]) -> [Operation] -> [Operation]
    forall a b. (a -> b) -> a -> b
    $ Config -> Pointer -> Value -> [Operation]
    rep Config
    cfg Pointer
    p Value
    v2
            (String Text
    s1, String Text
    s2) -> Bool -> [Operation] -> [Operation]
    forall m. Monoid m => Bool -> m -> m
    check (Text
    s1 Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    s2) ([Operation] -> [Operation]) -> [Operation] -> [Operation]
    forall a b. (a -> b) -> a -> b
    $ Config -> Pointer -> Value -> [Operation]
    rep Config
    cfg Pointer
    p Value
    v2

            -- For structured values of the same type, walk them.
            (Array Array
    a1,  Array Array
    a2)  -> Bool -> [Operation] -> [Operation]
    forall m. Monoid m => Bool -> m -> m
    check (Array
    a1 Array -> Array -> Bool
    forall a. Eq a => a -> a -> Bool
    == Array
    a2) ([Operation] -> [Operation]) -> [Operation] -> [Operation]
    forall a b. (a -> b) -> a -> b
    $ Pointer -> Array -> Array -> [Operation]
    workArray  Pointer
    p Array
    a1 Array
    a2
            (Object Object
    o1, Object Object
    o2) -> Bool -> [Operation] -> [Operation]
    forall m. Monoid m => Bool -> m -> m
    check (Object
    o1 Object -> Object -> Bool
    forall a. Eq a => a -> a -> Bool
    == Object
    o2) ([Operation] -> [Operation]) -> [Operation] -> [Operation]
    forall a b. (a -> b) -> a -> b
    $ Pointer -> Object -> Object -> [Operation]
    workObject Pointer
    p Object
    o1 Object
    o2

            -- For values of different types, replace v1 with v2.
            (Value, Value)
    _                      -> Config -> Pointer -> Value -> [Operation]
    rep Config
    cfg Pointer
    p Value
    v2

        -- Walk the keys in two objects, producing a 'Patch'.
        workObject :: Pointer -> Object -> Object -> [Operation]
        workObject :: Pointer -> Object -> Object -> [Operation]
    workObject Pointer
    path Object
    o1 Object
    o2 =
            let k1 :: [Key]
    k1 = Object -> [Key]
    forall v. KeyMap v -> [Key]
    HM.keys Object
    o1
                k2 :: [Key]
    k2 = Object -> [Key]
    forall v. KeyMap v -> [Key]
    HM.keys Object
    o2
                -- Deletions
                del_keys :: [AesonKey.Key]
                del_keys :: [Key]
    del_keys = (Key -> Bool) -> [Key] -> [Key]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (Key -> Bool) -> Key -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Key -> [Key] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Key]
    k2)) [Key]
    k1
                deletions :: [Operation]
                deletions :: [Operation]
    deletions = (Key -> [Operation]) -> [Key] -> [Operation]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap
                    (\Key
    k -> Config -> Pointer -> Value -> [Operation]
    del Config
    cfg (Path -> Pointer
    Pointer [Key -> Key
    OKey Key
    k]) (Maybe Value -> Value
    forall a. HasCallStack => Maybe a -> a
    fromJust (Maybe Value -> Value) -> Maybe Value -> Value
    forall a b. (a -> b) -> a -> b
    $ Key -> Object -> Maybe Value
    forall v. Key -> KeyMap v -> Maybe v
    HM.lookup Key
    k Object
    o1))
                    [Key]
    del_keys
                -- Insertions
                ins_keys :: [Key]
    ins_keys = (Key -> Bool) -> [Key] -> [Key]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (Key -> Bool) -> Key -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Key -> [Key] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Key]
    k1)) [Key]
    k2
                insertions :: [Operation]
                insertions :: [Operation]
    insertions = (Key -> [Operation]) -> [Key] -> [Operation]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap
                    (\Key
    k -> Config -> Pointer -> Value -> [Operation]
    ins Config
    cfg (Path -> Pointer
    Pointer [Key -> Key
    OKey Key
    k]) (Maybe Value -> Value
    forall a. HasCallStack => Maybe a -> a
    fromJust (Maybe Value -> Value) -> Maybe Value -> Value
    forall a b. (a -> b) -> a -> b
    $ Key -> Object -> Maybe Value
    forall v. Key -> KeyMap v -> Maybe v
    HM.lookup Key
    k Object
    o2))
                    [Key]
    ins_keys
                -- Changes
                chg_keys :: [Key]
    chg_keys = (Key -> Bool) -> [Key] -> [Key]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Key -> [Key] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Key]
    k2) [Key]
    k1
                changes :: [Operation]
                changes :: [Operation]
    changes = (Key -> [Operation]) -> [Key] -> [Operation]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap
                    (\Key
    k -> Pointer -> Value -> Value -> [Operation]
    worker (Path -> Pointer
    Pointer [Key -> Key
    OKey Key
    k])
                        (Maybe Value -> Value
    forall a. HasCallStack => Maybe a -> a
    fromJust (Maybe Value -> Value) -> Maybe Value -> Value
    forall a b. (a -> b) -> a -> b
    $ Key -> Object -> Maybe Value
    forall v. Key -> KeyMap v -> Maybe v
    HM.lookup Key
    k Object
    o1)
                        (Maybe Value -> Value
    forall a. HasCallStack => Maybe a -> a
    fromJust (Maybe Value -> Value) -> Maybe Value -> Value
    forall a b. (a -> b) -> a -> b
    $ Key -> Object -> Maybe Value
    forall v. Key -> KeyMap v -> Maybe v
    HM.lookup Key
    k Object
    o2))
                    [Key]
    chg_keys
            in (Pointer -> Pointer) -> Operation -> Operation
    modifyPointer (Pointer
    path Pointer -> Pointer -> Pointer
    forall a. Semigroup a => a -> a -> a
    <>) (Operation -> Operation) -> [Operation] -> [Operation]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ([Operation]
    deletions [Operation] -> [Operation] -> [Operation]
    forall a. Semigroup a => a -> a -> a
    <> [Operation]
    insertions [Operation] -> [Operation] -> [Operation]
    forall a. Semigroup a => a -> a -> a
    <> [Operation]
    changes)

        -- Use an adaption of the Wagner-Fischer algorithm to find the shortest
        -- sequence of changes between two JSON arrays.
        workArray :: Pointer -> Array -> Array -> [Operation]
        workArray :: Pointer -> Array -> Array -> [Operation]
    workArray Pointer
    path Array
    ss Array
    tt = (Operation -> Operation) -> [Operation] -> [Operation]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Pointer -> Pointer) -> Operation -> Operation
    modifyPointer (Pointer
    path Pointer -> Pointer -> Pointer
    forall a. Semigroup a => a -> a -> a
    <>)) ([Operation] -> [Operation])
    -> ((Sum Int, [[Operation]]) -> [Operation])
    -> (Sum Int, [[Operation]])
    -> [Operation]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Sum Int, [Operation]) -> [Operation]
    forall a b. (a, b) -> b
    snd ((Sum Int, [Operation]) -> [Operation])
    -> ((Sum Int, [[Operation]]) -> (Sum Int, [Operation]))
    -> (Sum Int, [[Operation]])
    -> [Operation]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([[Operation]] -> [Operation])
    -> (Sum Int, [[Operation]]) -> (Sum Int, [Operation])
    forall a b. (a -> b) -> (Sum Int, a) -> (Sum Int, b)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [[Operation]] -> [Operation]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ((Sum Int, [[Operation]]) -> [Operation])
    -> (Sum Int, [[Operation]]) -> [Operation]
    forall a b. (a -> b) -> a -> b
    $ Params Value [Operation] (Sum Int)
    -> Array -> Array -> (Sum Int, [[Operation]])
    forall c v o.
    (Monoid c, Ord c) =>
    Params v o c -> Vector v -> Vector v -> (c, [o])
    leastChanges Params Value [Operation] (Sum Int)
    params Array
    ss Array
    tt
          where
            params :: Params Value [Operation] (Sum Int)
            params :: Params Value [Operation] (Sum Int)
    params = Params{Value -> Value -> Bool
    equivalent :: Value -> Value -> Bool
    equivalent :: Value -> Value -> Bool
    equivalent, Int -> Value -> [Operation]
    delete :: Int -> Value -> [Operation]
    delete :: Int -> Value -> [Operation]
    delete, Int -> Value -> [Operation]
    insert :: Int -> Value -> [Operation]
    insert :: Int -> Value -> [Operation]
    insert, Int -> Value -> Value -> [Operation]
    substitute :: Int -> Value -> Value -> [Operation]
    substitute :: Int -> Value -> Value -> [Operation]
    substitute, [Operation] -> Sum Int
    cost :: [Operation] -> Sum Int
    cost :: [Operation] -> Sum Int
    cost, [Operation] -> Int
    positionOffset :: [Operation] -> Int
    positionOffset :: [Operation] -> Int
    positionOffset}
            equivalent :: Value -> Value -> Bool
            equivalent :: Value -> Value -> Bool
    equivalent = Value -> Value -> Bool
    forall a. Eq a => a -> a -> Bool
    (==)
            delete :: Int -> Value -> [Operation]
    delete Int
    i = Config -> Pointer -> Value -> [Operation]
    del Config
    cfg (Path -> Pointer
    Pointer [Int -> Key
    AKey Int
    i])
            insert :: Int -> Value -> [Operation]
    insert Int
    i = Config -> Pointer -> Value -> [Operation]
    ins Config
    cfg (Path -> Pointer
    Pointer [Int -> Key
    AKey Int
    i])
            substitute :: Int -> Value -> Value -> [Operation]
    substitute Int
    i = Pointer -> Value -> Value -> [Operation]
    worker (Path -> Pointer
    Pointer [Int -> Key
    AKey Int
    i])
            cost :: [Operation] -> Sum Int
            cost :: [Operation] -> Sum Int
    cost = Int -> Sum Int
    forall a. a -> Sum a
    Sum (Int -> Sum Int) -> ([Operation] -> Int) -> [Operation] -> Sum Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Int] -> Int
    forall a. Num a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum ([Int] -> Int) -> ([Operation] -> [Int]) -> [Operation] -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Operation -> Int) -> [Operation] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Operation -> Int
    operationCost
            -- Position is advanced by grouping operations with same "head" index:
            -- + groups of many operations advance one
            -- + singletons with |pointer|>1 advance one
            -- + other singletons advance according to 'pos'
            positionOffset :: [Operation] -> Int
    positionOffset = [Int] -> Int
    forall a. Num a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum ([Int] -> Int) -> ([Operation] -> [Int]) -> [Operation] -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([Operation] -> Int) -> [[Operation]] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [Operation] -> Int
    adv ([[Operation]] -> [Int])
    -> ([Operation] -> [[Operation]]) -> [Operation] -> [Int]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Operation -> Operation -> Bool) -> [Operation] -> [[Operation]]
    forall a. (a -> a -> Bool) -> [a] -> [[a]]
    groupBy Operation -> Operation -> Bool
    related
            related :: Operation -> Operation -> Bool
            related :: Operation -> Operation -> Bool
    related Operation
    o1 Operation
    o2 =
                let p1 :: Path
    p1 = Pointer -> Path
    pointerPath (Operation -> Pointer
    changePointer Operation
    o1)
                    p2 :: Path
    p2 = Pointer -> Path
    pointerPath (Operation -> Pointer
    changePointer Operation
    o2)
                in case (Path
    p1, Path
    p2) of
                     ([Key
    _], [Key
    _]) -> Bool
    False
                     (Key
    i1:Path
    _, Key
    i2:Path
    _) | Key
    i1 Key -> Key -> Bool
    forall a. Eq a => a -> a -> Bool
    == Key
    i2  -> Bool
    True
                                  | Bool
    otherwise -> Bool
    False
            -- A group of operations has a peculiar (i.e. given by 'pos') advance
            -- when it's a single op and |changePointer| = 1; otherwise it's a
            -- bunch of changes inside the head key.
            adv :: [Operation] -> Int
            adv :: [Operation] -> Int
    adv [Operation
    op]
                | (Path -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (Path -> Int) -> (Operation -> Path) -> Operation -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Pointer -> Path
    pointerPath (Pointer -> Path) -> (Operation -> Pointer) -> Operation -> Path
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Operation -> Pointer
    changePointer (Operation -> Int) -> Operation -> Int
    forall a b. (a -> b) -> a -> b
    $ Operation
    op) Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    1 = Operation -> Int
    pos Operation
    op
            adv [Operation]
    _    = Int
    1
            pos :: Operation -> Int
            pos :: Operation -> Int
    pos Rem{changePointer :: Operation -> Pointer
    changePointer=Pointer Path
    path}
                | Path -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length Path
    path Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    1 = Int
    0
                | Bool
    otherwise        = Int
    0
            pos Add{changePointer :: Operation -> Pointer
    changePointer=Pointer Path
    path}
                | Path -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length Path
    path Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    1 = Int
    1
                | Bool
    otherwise        = Int
    0
            pos Rep{changePointer :: Operation -> Pointer
    changePointer=Pointer Path
    path}
                | Path -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length Path
    path Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    1 = Int
    1
                | Bool
    otherwise        = Int
    0
            pos Cpy{changePointer :: Operation -> Pointer
    changePointer=Pointer Path
    path}
                | Path -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length Path
    path Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    1 = Int
    1
                | Bool
    otherwise        = Int
    0
            pos Mov{changePointer :: Operation -> Pointer
    changePointer=Pointer Path
    path}
                | Path -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length Path
    path Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    1 = Int
    1
                | Bool
    otherwise        = Int
    0
            pos Tst{changePointer :: Operation -> Pointer
    changePointer=Pointer Path
    _path} = Int
    0

    -- * Patching

    -- | Apply a patch to a JSON document.
    patch
        :: Patch
        -> Value
        -> Result Value
    patch :: Patch -> Value -> Result Value
    patch (Patch []) Value
    val  = Value -> Result Value
    forall a. a -> Result a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Value
    val
    patch (Patch [Operation]
    ops) Value
    val = (Value -> Operation -> Result Value)
    -> Value -> [Operation] -> Result Value
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldlM ((Operation -> Value -> Result Value)
    -> Value -> Operation -> Result Value
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Operation -> Value -> Result Value
    applyOperation) Value
    val [Operation]
    ops

    -- | Apply an 'Operation' to a 'Value'.
    applyOperation
        :: Operation
        -> Value
        -> Result Value
    applyOperation :: Operation -> Value -> Result Value
    applyOperation Operation
    op Value
    json = case Operation
    op of
        Add Pointer
    path Value
    v'   -> Pointer -> Value -> Value -> Result Value
    applyAdd Pointer
    path Value
    v' Value
    json
        Rem Pointer
    path      -> Pointer -> Value -> Result Value
    applyRem Pointer
    path    Value
    json
        Rep Pointer
    path Value
    v'   -> Pointer -> Value -> Value -> Result Value
    applyRep Pointer
    path Value
    v' Value
    json
        Tst Pointer
    path Value
    v    -> Pointer -> Value -> Value -> Result Value
    applyTst Pointer
    path Value
    v  Value
    json
        Cpy Pointer
    path Pointer
    from -> Pointer -> Pointer -> Value -> Result Value
    applyCpy Pointer
    path Pointer
    from Value
    json
        Mov Pointer
    path Pointer
    from -> Pointer -> Pointer -> Value -> Result Value
    applyMov Pointer
    path Pointer
    from Value
    json

    -- | Apply an 'Add' operation to a document.
    --
    -- http://tools.ietf.org/html/rfc6902#section-4.1
    --
    -- - An empty 'Path' replaces the document.
    -- - A single 'OKey' inserts or replaces the corresponding member in an object.
    -- - A single 'AKey' inserts at the corresponding location.
    -- - Longer 'Paths' traverse if they can and fail otherwise.
    applyAdd :: Pointer -> Value -> Value -> Result Value
    applyAdd :: Pointer -> Value -> Value -> Result Value
    applyAdd Pointer
    pointer = Pointer -> Value -> Value -> Result Value
    go Pointer
    pointer
      where
        go :: Pointer -> Value -> Value -> Result Value
    go (Pointer []) Value
    val Value
    _ =
            Value -> Result Value
    forall a. a -> Result a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Value
    val
        go (Pointer [AKey Int
    i]) Value
    v' (Array Array
    v) =
            Value -> Result Value
    forall a. a -> Result a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Array -> Value
    Array (Array -> Value) -> Array -> Value
    forall a b. (a -> b) -> a -> b
    $ Int -> Value -> Array -> Array
    forall a. Int -> a -> Vector a -> Vector a
    vInsert Int
    i Value
    v' Array
    v)
        go (Pointer (AKey Int
    i : Path
    path)) Value
    v' (Array Array
    v) =
            let fn :: Maybe Value -> Result (Maybe Value)
                fn :: Maybe Value -> Result (Maybe Value)
    fn Maybe Value
    Nothing  = String -> String -> Int -> Pointer -> Result (Maybe Value)
    forall ix a.
    Show ix =>
    String -> String -> ix -> Pointer -> Result a
    cannot String
    "insert" String
    "array" Int
    i Pointer
    pointer
                fn (Just Value
    d) = Value -> Maybe Value
    forall a. a -> Maybe a
    Just (Value -> Maybe Value) -> Result Value -> Result (Maybe Value)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Pointer -> Value -> Value -> Result Value
    go (Path -> Pointer
    Pointer Path
    path) Value
    v' Value
    d
            in Array -> Value
    Array (Array -> Value) -> Result Array -> Result Value
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Int
    -> (Maybe Value -> Result (Maybe Value)) -> Array -> Result Array
    forall a.
    Int
    -> (Maybe a -> Result (Maybe a)) -> Vector a -> Result (Vector a)
    vModify Int
    i Maybe Value -> Result (Maybe Value)
    fn Array
    v
        go (Pointer [OKey Key
    n]) Value
    v' (Object Object
    m) =
            Value -> Result Value
    forall a. a -> Result a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Value -> Result Value)
    -> (Object -> Value) -> Object -> Result Value
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Object -> Value
    Object (Object -> Result Value) -> Object -> Result Value
    forall a b. (a -> b) -> a -> b
    $ Key -> Value -> Object -> Object
    forall v. Key -> v -> KeyMap v -> KeyMap v
    HM.insert Key
    n Value
    v' Object
    m
        go (Pointer (OKey Key
    n : Path
    path)) Value
    v' (Object Object
    o) =
            let fn :: Maybe Value -> Result (Maybe Value)
                fn :: Maybe Value -> Result (Maybe Value)
    fn Maybe Value
    Nothing  = String -> String -> Key -> Pointer -> Result (Maybe Value)
    forall ix a.
    Show ix =>
    String -> String -> ix -> Pointer -> Result a
    cannot String
    "insert" String
    "object" Key
    n Pointer
    pointer
                fn (Just Value
    d) = Value -> Maybe Value
    forall a. a -> Maybe a
    Just (Value -> Maybe Value) -> Result Value -> Result (Maybe Value)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Pointer -> Value -> Value -> Result Value
    go (Path -> Pointer
    Pointer Path
    path) Value
    v' Value
    d
            in Object -> Value
    Object (Object -> Value) -> Result Object -> Result Value
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Key
    -> (Maybe Value -> Result (Maybe Value)) -> Object -> Result Object
    forall v.
    Key
    -> (Maybe v -> Result (Maybe v)) -> KeyMap v -> Result (KeyMap v)
    hmModify Key
    n Maybe Value -> Result (Maybe Value)
    fn Object
    o
        go (Pointer (OKey Key
    n : Path
    path)) Value
    v' array :: Value
    array@(Array Array
    v)
            | Key
    n Key -> Key -> Bool
    forall a. Eq a => a -> a -> Bool
    == Key
    "-" = Pointer -> Value -> Value -> Result Value
    go (Path -> Pointer
    Pointer (Int -> Key
    AKey (Array -> Int
    forall a. Vector a -> Int
    V.length Array
    v) Key -> Path -> Path
    forall a. a -> [a] -> [a]
    : Path
    path)) Value
    v' Value
    array
        go Pointer
    path Value
    _ Value
    v = Pointer -> Value -> Result Value
    forall a. Pointer -> Value -> Result a
    pointerFailure Pointer
    path Value
    v

    -- | Apply a 'Rem' operation to a document.
    --
    -- http://tools.ietf.org/html/rfc6902#section-4.2
    --
    -- - The target location MUST exist.
    applyRem :: Pointer -> Value -> Result Value
    applyRem :: Pointer -> Value -> Result Value
    applyRem from :: Pointer
    from@(Pointer Path
    path) = Path -> Value -> Result Value
    go Path
    path
      where
        go :: Path -> Value -> Result Value
    go [] Value
    _ = Value -> Result Value
    forall a. a -> Result a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Value
    Null
        go [AKey Int
    i] (Array Array
    v) =
            let fn :: Maybe Value -> Result (Maybe Value)
                fn :: Maybe Value -> Result (Maybe Value)
    fn Maybe Value
    Nothing  = String -> String -> Int -> Pointer -> Result (Maybe Value)
    forall ix a.
    Show ix =>
    String -> String -> ix -> Pointer -> Result a
    cannot String
    "delete" String
    "array" Int
    i Pointer
    from
                fn (Just Value
    _) = Maybe Value -> Result (Maybe Value)
    forall a. a -> Result a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Value
    forall a. Maybe a
    Nothing
            in Array -> Value
    Array (Array -> Value) -> Result Array -> Result Value
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Int
    -> (Maybe Value -> Result (Maybe Value)) -> Array -> Result Array
    forall a.
    Int
    -> (Maybe a -> Result (Maybe a)) -> Vector a -> Result (Vector a)
    vModify Int
    i Maybe Value -> Result (Maybe Value)
    fn Array
    v
        go (AKey Int
    i : Path
    path) (Array Array
    v) =
            let fn :: Maybe Value -> Result (Maybe Value)
                fn :: Maybe Value -> Result (Maybe Value)
    fn Maybe Value
    Nothing  = String -> String -> Int -> Pointer -> Result (Maybe Value)
    forall ix a.
    Show ix =>
    String -> String -> ix -> Pointer -> Result a
    cannot String
    "traverse" String
    "array" Int
    i Pointer
    from
                fn (Just Value
    o) = Value -> Maybe Value
    forall a. a -> Maybe a
    Just (Value -> Maybe Value) -> Result Value -> Result (Maybe Value)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Path -> Value -> Result Value
    go Path
    path Value
    o
            in Array -> Value
    Array (Array -> Value) -> Result Array -> Result Value
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Int
    -> (Maybe Value -> Result (Maybe Value)) -> Array -> Result Array
    forall a.
    Int
    -> (Maybe a -> Result (Maybe a)) -> Vector a -> Result (Vector a)
    vModify Int
    i Maybe Value -> Result (Maybe Value)
    fn Array
    v
        go [OKey Key
    n] (Object Object
    m) =
            let fn :: Maybe Value -> Result (Maybe Value)
                fn :: Maybe Value -> Result (Maybe Value)
    fn Maybe Value
    Nothing  = String -> String -> Key -> Pointer -> Result (Maybe Value)
    forall ix a.
    Show ix =>
    String -> String -> ix -> Pointer -> Result a
    cannot String
    "delete" String
    "object" Key
    n Pointer
    from
                fn (Just Value
    _) = Maybe Value -> Result (Maybe Value)
    forall a. a -> Result a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Value
    forall a. Maybe a
    Nothing
            in Object -> Value
    Object (Object -> Value) -> Result Object -> Result Value
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Key
    -> (Maybe Value -> Result (Maybe Value)) -> Object -> Result Object
    forall v.
    Key
    -> (Maybe v -> Result (Maybe v)) -> KeyMap v -> Result (KeyMap v)
    hmModify Key
    n Maybe Value -> Result (Maybe Value)
    fn Object
    m
        go (OKey Key
    n : Path
    path) (Object Object
    m) =
            let fn :: Maybe Value -> Result (Maybe Value)
                fn :: Maybe Value -> Result (Maybe Value)
    fn Maybe Value
    Nothing  = String -> String -> Key -> Pointer -> Result (Maybe Value)
    forall ix a.
    Show ix =>
    String -> String -> ix -> Pointer -> Result a
    cannot String
    "traverse" String
    "object" Key
    n Pointer
    from
                fn (Just Value
    o) = Value -> Maybe Value
    forall a. a -> Maybe a
    Just (Value -> Maybe Value) -> Result Value -> Result (Maybe Value)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Path -> Value -> Result Value
    go Path
    path Value
    o
            in Object -> Value
    Object (Object -> Value) -> Result Object -> Result Value
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Key
    -> (Maybe Value -> Result (Maybe Value)) -> Object -> Result Object
    forall v.
    Key
    -> (Maybe v -> Result (Maybe v)) -> KeyMap v -> Result (KeyMap v)
    hmModify Key
    n Maybe Value -> Result (Maybe Value)
    fn Object
    m
        -- Dodgy hack for "-" key which means "the end of the array".
        go (OKey Key
    n : Path
    path) array :: Value
    array@(Array Array
    v)
            | Key
    n Key -> Key -> Bool
    forall a. Eq a => a -> a -> Bool
    == Key
    "-" = Path -> Value -> Result Value
    go (Int -> Key
    AKey (Array -> Int
    forall a. Vector a -> Int
    V.length Array
    v) Key -> Path -> Path
    forall a. a -> [a] -> [a]
    : Path
    path) Value
    array
        -- Type mismatch: clearly the thing we're deleting isn't here.
        go Path
    _path Value
    value = Pointer -> Value -> Result Value
    forall a. Pointer -> Value -> Result a
    pointerFailure Pointer
    from Value
    value

    -- | Apply a 'Rep' operation to a document.
    --
    -- http://tools.ietf.org/html/rfc6902#section-4.3
    --
    -- - Functionally identical to a 'Rem' followed by an 'Add'.
    applyRep :: Pointer -> Value -> Value -> Result Value
    applyRep :: Pointer -> Value -> Value -> Result Value
    applyRep Pointer
    from Value
    v Value
    doc = Pointer -> Value -> Result Value
    applyRem Pointer
    from Value
    doc Result Value -> (Value -> Result Value) -> Result Value
    forall a b. Result a -> (a -> Result b) -> Result b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Pointer -> Value -> Value -> Result Value
    applyAdd Pointer
    from Value
    v

    -- | Apply a 'Mov' operation to a document.
    --
    -- http://tools.ietf.org/html/rfc6902#section-4.4
    applyMov :: Pointer -> Pointer -> Value -> Result Value
    applyMov :: Pointer -> Pointer -> Value -> Result Value
    applyMov Pointer
    path Pointer
    from Value
    doc = do
      v <- Pointer -> Value -> Result Value
    get Pointer
    from Value
    doc
      applyRem from doc >>= applyAdd path v

    -- | Apply a 'Cpy' operation to a document.
    --
    -- http://tools.ietf.org/html/rfc6902#section-4.5
    --
    -- - The location must exist.
    -- - Identical to an add with the appropriate value.
    applyCpy :: Pointer -> Pointer -> Value -> Result Value
    applyCpy :: Pointer -> Pointer -> Value -> Result Value
    applyCpy Pointer
    path Pointer
    from Value
    doc = do
      v <- Pointer -> Value -> Result Value
    get Pointer
    from Value
    doc
      applyAdd path v doc

    -- | Apply a 'Tst' operation to a document.
    --
    -- http://tools.ietf.org/html/rfc6902#section-4.6
    --
    -- - The location must exist.
    -- - The value must be equal to the supplied value.
    applyTst :: Pointer -> Value -> Value -> Result Value
    applyTst :: Pointer -> Value -> Value -> Result Value
    applyTst Pointer
    path Value
    v Value
    doc = do
        v' <- Pointer -> Value -> Result Value
    get Pointer
    path Value
    doc
        unless (v == v') (Error . T.unpack $ "Element at \"" <> formatPointer path <> "\" fails test.")
        return doc

    -- * Utilities

    -- $ These are some utility functions used in the functions defined
    -- above. Mostly they just fill gaps in the APIs of the "Data.Vector"
    -- and "Data.Aeson.KeyMap" modules.

    -- | Delete an element in a vector.
    vDelete :: Int -> Vector a -> Vector a
    vDelete :: forall a. Int -> Vector a -> Vector a
    vDelete Int
    i Vector a
    v =
        let l :: Int
    l = Vector a -> Int
    forall a. Vector a -> Int
    V.length Vector a
    v
        in Int -> Int -> Vector a -> Vector a
    forall a. Int -> Int -> Vector a -> Vector a
    V.slice Int
    0 Int
    i Vector a
    v Vector a -> Vector a -> Vector a
    forall a. Semigroup a => a -> a -> a
    <> Int -> Int -> Vector a -> Vector a
    forall a. Int -> Int -> Vector a -> Vector a
    V.slice (Int
    i Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) (Int
    l Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    i Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) Vector a
    v

    -- | Insert an element into a vector.
    vInsert :: Int -> a -> Vector a -> Vector a
    vInsert :: forall a. Int -> a -> Vector a -> Vector a
    vInsert Int
    i a
    a Vector a
    v
        | Int
    i Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    0          = a -> Vector a -> Vector a
    forall a. a -> Vector a -> Vector a
    V.cons a
    a Vector a
    v
        | Vector a -> Int
    forall a. Vector a -> Int
    V.length Vector a
    v Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    i = Vector a -> a -> Vector a
    forall a. Vector a -> a -> Vector a
    V.snoc Vector a
    v a
    a
        | Bool
    otherwise       = Int -> Int -> Vector a -> Vector a
    forall a. Int -> Int -> Vector a -> Vector a
    V.slice Int
    0 Int
    i Vector a
    v
                          Vector a -> Vector a -> Vector a
    forall a. Semigroup a => a -> a -> a
    <> a -> Vector a
    forall a. a -> Vector a
    V.singleton a
    a
                          Vector a -> Vector a -> Vector a
    forall a. Semigroup a => a -> a -> a
    <> Int -> Int -> Vector a -> Vector a
    forall a. Int -> Int -> Vector a -> Vector a
    V.slice Int
    i (Vector a -> Int
    forall a. Vector a -> Int
    V.length Vector a
    v Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    i) Vector a
    v

    -- | Modify the element at an index in a 'Vector'.
    --
    -- The function is passed the value at index @i@, or 'Nothing' if there is no
    -- such element. The function should return 'Nothing' if it wants to have no
    -- value corresponding to the index, or 'Just' if it wants a value.
    --
    -- Depending on the vector and the function, we will either:
    --
    -- - leave the vector unchanged;
    -- - delete an existing element;
    -- - insert a new element; or
    -- - replace an existing element.
    vModify
        :: Int
        -> (Maybe a -> Result (Maybe a))
        -> Vector a
        -> Result (Vector a)
    vModify :: forall a.
    Int
    -> (Maybe a -> Result (Maybe a)) -> Vector a -> Result (Vector a)
    vModify Int
    i Maybe a -> Result (Maybe a)
    f Vector a
    v =
        let a :: Maybe a
    a = Vector a
    v Vector a -> Int -> Maybe a
    forall a. Vector a -> Int -> Maybe a
    V.!? Int
    i
            a' :: Result (Maybe a)
    a' = Maybe a -> Result (Maybe a)
    f Maybe a
    a
        in case (Maybe a
    a, Result (Maybe a)
    a') of
            (Maybe a
    Nothing, Success Maybe a
    Nothing ) -> Vector a -> Result (Vector a)
    forall a. a -> Result a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Vector a
    v
            (Just a
    _ , Success Maybe a
    Nothing ) -> Vector a -> Result (Vector a)
    forall a. a -> Result a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int -> Vector a -> Vector a
    forall a. Int -> Vector a -> Vector a
    vDelete Int
    i Vector a
    v)
            (Maybe a
    Nothing, Success (Just a
    n)) -> Vector a -> Result (Vector a)
    forall a. a -> Result a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int -> a -> Vector a -> Vector a
    forall a. Int -> a -> Vector a -> Vector a
    vInsert Int
    i a
    n Vector a
    v)
            (Just a
    _ , Success (Just a
    n)) -> Vector a -> Result (Vector a)
    forall a. a -> Result a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Vector a -> Vector (Int, a) -> Vector a
    forall a. Vector a -> Vector (Int, a) -> Vector a
    V.update Vector a
    v ((Int, a) -> Vector (Int, a)
    forall a. a -> Vector a
    V.singleton (Int
    i, a
    n)))
            (Maybe a
    _      , Error   String
    e       ) -> String -> Result (Vector a)
    forall a. String -> Result a
    Error String
    e

    -- | Modify the value associated with a key in a 'KeyMap'.
    --
    -- The function is passed the value defined for @k@, or 'Nothing'. If the
    -- function returns 'Nothing', the key and value are deleted from the map;
    -- otherwise the value replaces the existing value in the returned map.
    hmModify
        :: AesonKey.Key
        -> (Maybe v -> Result (Maybe v))
        -> HM.KeyMap v
        -> Result (HM.KeyMap v)
    hmModify :: forall v.
    Key
    -> (Maybe v -> Result (Maybe v)) -> KeyMap v -> Result (KeyMap v)
    hmModify Key
    k Maybe v -> Result (Maybe v)
    f KeyMap v
    m = case Maybe v -> Result (Maybe v)
    f (Key -> KeyMap v -> Maybe v
    forall v. Key -> KeyMap v -> Maybe v
    HM.lookup Key
    k KeyMap v
    m) of
        Error String
    e          -> String -> Result (KeyMap v)
    forall a. String -> Result a
    Error String
    e
        Success Maybe v
    Nothing  -> KeyMap v -> Result (KeyMap v)
    forall a. a -> Result a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (KeyMap v -> Result (KeyMap v)) -> KeyMap v -> Result (KeyMap v)
    forall a b. (a -> b) -> a -> b
    $ Key -> KeyMap v -> KeyMap v
    forall v. Key -> KeyMap v -> KeyMap v
    HM.delete Key
    k KeyMap v
    m
        Success (Just v
    v) -> KeyMap v -> Result (KeyMap v)
    forall a. a -> Result a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (KeyMap v -> Result (KeyMap v)) -> KeyMap v -> Result (KeyMap v)
    forall a b. (a -> b) -> a -> b
    $ Key -> v -> KeyMap v -> KeyMap v
    forall v. Key -> v -> KeyMap v -> KeyMap v
    HM.insert Key
    k v
    v KeyMap v
    m

    -- | Report an error about being able to use a pointer key.
    cannot
        :: (Show ix)
        => String -- ^ Use to be made "delete", "traverse", etc.
        -> String -- ^ Type "array" "object"
        -> ix
        -> Pointer
        -> Result a
    cannot :: forall ix a.
    Show ix =>
    String -> String -> ix -> Pointer -> Result a
    cannot String
    op String
    ty ix
    ix Pointer
    p =
        String -> Result a
    forall a. String -> Result a
    Error (String
    "Cannot " String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    op String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    " missing " String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    ty String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    " member at index "
              String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> ix -> String
    forall a. Show a => a -> String
    show ix
    ix String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    " in pointer \"" String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> Text -> String
    T.unpack (Pointer -> Text
    formatPointer Pointer
    p) String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    "\".")