1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
|
{-# 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
{ patchOperations :: [Operation] }
deriving (Eq, Show, Semigroup, Monoid, Generic)
instance ToJSON Patch where
toJSON (Patch ops) = toJSON ops
instance FromJSON Patch where
parseJSON = modifyFailure ("Could not parse patch: " <> ) . parsePatch
where
parsePatch (Array v) = Patch <$> mapM parseJSON (V.toList v)
parsePatch v = typeMismatch "Array" v
-- | Modify the pointers in the 'Operation's of a 'Patch'.
--
-- See 'modifyPointer' for details.
modifyPointers :: (Pointer -> Pointer) -> Patch -> Patch
modifyPointers f (Patch ops) = Patch (map (modifyPointer f) 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 { changePointer :: Pointer, changeValue :: Value }
-- ^ http://tools.ietf.org/html/rfc6902#section-4.1
| Cpy { changePointer :: 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 (Eq, Show, Generic)
instance ToJSON Operation where
toJSON (Add p v) = object
[ ("op", "add")
, "path" .= p
, "value" .= v
]
toJSON (Cpy p f) = object
[ ("op", "copy")
, "path" .= p
, "from" .= f
]
toJSON (Mov p f) = object
[ ("op", "move")
, "path" .= p
, "from" .= f
]
toJSON (Rem p) = object
[ ("op", "remove")
, "path" .= p
]
toJSON (Rep p v) = object
[ ("op", "replace")
, "path" .= p
, "value" .= v
]
toJSON (Tst p v) = object
[ ("op", "test")
, "path" .= p
, "value" .= v
]
instance FromJSON Operation where
parseJSON = parse
where
parse o@(Object v)
= (op v "add" *> (Add <$> v .: "path" <*> v .: "value"))
<|> (op v "copy" *> (Cpy <$> v .: "path" <*> v .: "from"))
<|> (op v "move" *> (Mov <$> v .: "path" <*> v .: "from"))
<|> (op v "remove" *> (Rem <$> v .: "path"))
<|> (op v "replace" *> (Rep <$> v .: "path" <*> v .: "value"))
<|> (op v "test" *> (Tst <$> v .: "path" <*> v .: "value"))
<|> fail ("Expected a JSON patch operation, encountered: " <> BS.unpack (encode o))
parse v = typeMismatch "Operation" v
op v n = fixed v "op" (String n)
fixed o n val = do
v' <- o .: 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 f op =
case op of
Add{..} -> op{ changePointer = f changePointer }
Cpy{..} -> op{ changePointer = f changePointer, fromPointer = f fromPointer }
Mov{..} -> op{ changePointer = f changePointer, fromPointer = f fromPointer }
Rem{..} -> op{ changePointer = f changePointer }
Rep{..} -> op{ changePointer = f changePointer }
Tst{..} -> op{ changePointer = f changePointer }
isAdd :: Operation -> Bool
isAdd Add{} = True
isAdd _ = False
isCpy :: Operation -> Bool
isCpy Cpy{} = True
isCpy _ = False
isMov :: Operation -> Bool
isMov Mov{} = True
isMov _ = False
isRem :: Operation -> Bool
isRem Rem{} = True
isRem _ = False
isRep :: Operation -> Bool
isRep Rep{} = True
isRep _ = False
isTst :: Operation -> Bool
isTst Tst{} = True
isTst _ = False
|
