@@ -11,67 +11,69 @@ import Text.Read (readMaybe)
12newtype JsonPointer = JsonPointer { _unJsonPointer :: [Text] } deriving (Eq, Show)
12newtype JsonPointer = JsonPointer { _unJsonPointer :: [Text] } deriving (Eq, Show)
14−data PointerErr
14+data PointerFormatError
15 -- | The Text to build a JSON Pointer must either be empty
15 -- | The Text to build a JSON Pointer must either be empty
16− -- or start with a '/'.
16+ -- or start with a "/".
17 = InvalidFirstChar
17 = InvalidFirstChar
18 | UnescapedTilde
18 | UnescapedTilde
19− | ObjectLookupFailed
22+ = ObjectLookupFailed
20 | ArrayIndexInvalid
23 | ArrayIndexInvalid
21 | ArrayElemNotFound
24 | ArrayElemNotFound
22− | UnindexableValue
25+ | ExpectedObjectOrArray
23 deriving (Eq, Show)
26 deriving (Eq, Show)
25-- | The Text to build a JSON Pointer must either be empty or start
28-- | The Text to build a JSON Pointer must either be empty or start
26−-- with a '/'. If you're turning a URI Fragment into a JSON Pointer
29+-- with a "/". If you're turning a URI Fragment into a JSON Pointer
27−-- you must drop the initial '#'.
30+-- you must drop the initial "#".
28−jsonPointer :: Text -> Either PointerErr JsonPointer
31+jsonPointer :: Text -> Either PointerFormatError JsonPointer
29jsonPointer t =
32jsonPointer t =
30 JsonPointer <$> (unescape =<< process (T.splitOn "/" t))
33 JsonPointer <$> (unescape =<< process (T.splitOn "/" t))
32− process ::[Text] -> Either PointerErr [Text]
35+ process ::[Text] -> Either PointerFormatError [Text]
33 process [] = Right []
36 process [] = Right []
34− process (x:xs) = do
37+ process (x:xs)
38+ -- This checks that the JsonPointer started with a "/":
35− unless (T.null x) $ Left InvalidFirstChar
39+ | (not . T.null $ x) = Left InvalidFirstChar
36− Right xs
40+ | otherwise = Right xs
38− unescape :: [Text] -> Either PointerErr [Text]
42+ unescape :: [Text] -> Either PointerFormatError [Text]
39 unescape xs = do
43 unescape xs = do
40 void $ mapM checkValid xs
44 void $ mapM checkValid xs
41 Right $ T.replace "~0" "~" . T.replace "~1" "/" <$> xs
45 Right $ T.replace "~0" "~" . T.replace "~1" "/" <$> xs
43− checkValid :: Text -> Either PointerErr ()
47+ checkValid :: Text -> Either PointerFormatError ()
44 checkValid x = do
48 checkValid x = do
45 let afterTildes = drop 1 $ T.splitOn "~" x
49 let afterTildes = drop 1 $ T.splitOn "~" x
46 if all (\y -> T.isPrefixOf "0" y || T.isPrefixOf "1" y) afterTildes
50 if all (\y -> T.isPrefixOf "0" y || T.isPrefixOf "1" y) afterTildes
47 then Right ()
51 then Right ()
48 else Left UnescapedTilde
52 else Left UnescapedTilde
50−resolvePointer :: Value -> JsonPointer -> Either PointerErr Value
54+resolvePointer :: JsonPointer -> Value -> Either ResolutionError Value
51−resolvePointer v p =
55+resolvePointer p v =
52 case _unJsonPointer p of
56 case _unJsonPointer p of
53 [] -> Right v
57 [] -> Right v
54− _ -> resolveRefTok v p >>= uncurry resolvePointer
58+ _ -> resolveRefTok p v >>= uncurry resolvePointer
56-- | For internal use and specialized applications that don't want to
60-- | For internal use and specialized applications that don't want to
57-- resolve the entire pointer at once.
61-- resolve the entire pointer at once.
58−resolveRefTok :: Value -> JsonPointer -> Either PointerErr (Value, JsonPointer)
62+resolveRefTok :: JsonPointer -> Value -> Either ResolutionError (JsonPointer, Value)
59−resolveRefTok v p = do
63+resolveRefTok p v = do
60 case _unJsonPointer p of
64 case _unJsonPointer p of
61− [] -> Right (v, p)
65+ [] -> Right (p, v)
62 (tok:ps) ->
66 (tok:ps) ->
64 Object h ->
68 Object h ->
65 case H.lookup tok h of
69 case H.lookup tok h of
66 Nothing -> Left ObjectLookupFailed
70 Nothing -> Left ObjectLookupFailed
67− Just vv -> Right (vv, JsonPointer ps)
71+ Just vv -> Right (JsonPointer ps, vv)
68 Array vs -> do
72 Array vs -> do
69 case readMaybe (T.unpack tok) of
73 case readMaybe (T.unpack tok) of
70 Nothing -> Left ArrayIndexInvalid
74 Nothing -> Left ArrayIndexInvalid
71 Just n -> do
75 Just n -> do
72− unless (n >= 0) $ Left ArrayIndexInvalid
76+ when (n < 0) $ Left ArrayIndexInvalid
73− unless (n < V.length vs) $ Left ArrayElemNotFound
77+ when (n >= V.length vs) $ Left ArrayElemNotFound
74− Right (vs V.! n, JsonPointer ps)
78+ Right (JsonPointer ps, vs V.! n)
75− vv -> do
79+ _ -> Left ExpectedObjectOrArray
76− unless (null ps) $ Left UnindexableValue
77− Right (vv, JsonPointer [])