@@ -11,67 +11,69 @@ import Text.Read (readMaybe)
1111
1212newtype JsonPointer = JsonPointer { _unJsonPointer :: [Text] } deriving (Eq, Show)
1313
14−data PointerErr
14+data PointerFormatError
1515 -- | The Text to build a JSON Pointer must either be empty
16− -- or start with a '/'.
16+ -- or start with a "/".
1717 = InvalidFirstChar
1818 | UnescapedTilde
19− | ObjectLookupFailed
19+ deriving (Eq, Show)
20+
21+data ResolutionError
22+ = ObjectLookupFailed
2023 | ArrayIndexInvalid
2124 | ArrayElemNotFound
22− | UnindexableValue
25+ | ExpectedObjectOrArray
2326 deriving (Eq, Show)
2427
2528-- | 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
27−-- you must drop the initial '#'.
28−jsonPointer :: Text -> Either PointerErr JsonPointer
29+-- with a "/". If you're turning a URI Fragment into a JSON Pointer
30+-- you must drop the initial "#".
31+jsonPointer :: Text -> Either PointerFormatError JsonPointer
2932jsonPointer t =
3033 JsonPointer <$> (unescape =<< process (T.splitOn "/" t))
3134 where
32− process ::[Text] -> Either PointerErr [Text]
35+ process ::[Text] -> Either PointerFormatError [Text]
3336 process [] = Right []
34− process (x:xs) = do
35− unless (T.null x) $ Left InvalidFirstChar
36− Right xs
37+ process (x:xs)
38+ -- This checks that the JsonPointer started with a "/":
39+ | (not . T.null $ x) = Left InvalidFirstChar
40+ | otherwise = Right xs
3741
38− unescape :: [Text] -> Either PointerErr [Text]
42+ unescape :: [Text] -> Either PointerFormatError [Text]
3943 unescape xs = do
4044 void $ mapM checkValid xs
4145 Right $ T.replace "~0" "~" . T.replace "~1" "/" <$> xs
4246
43− checkValid :: Text -> Either PointerErr ()
47+ checkValid :: Text -> Either PointerFormatError ()
4448 checkValid x = do
4549 let afterTildes = drop 1 $ T.splitOn "~" x
4650 if all (\y -> T.isPrefixOf "0" y || T.isPrefixOf "1" y) afterTildes
4751 then Right ()
4852 else Left UnescapedTilde
4953
50−resolvePointer :: Value -> JsonPointer -> Either PointerErr Value
51−resolvePointer v p =
54+resolvePointer :: JsonPointer -> Value -> Either ResolutionError Value
55+resolvePointer p v =
5256 case _unJsonPointer p of
5357 [] -> Right v
54− _ -> resolveRefTok v p >>= uncurry resolvePointer
58+ _ -> resolveRefTok p v >>= uncurry resolvePointer
5559
5660-- | For internal use and specialized applications that don't want to
5761-- resolve the entire pointer at once.
58−resolveRefTok :: Value -> JsonPointer -> Either PointerErr (Value, JsonPointer)
59−resolveRefTok v p = do
62+resolveRefTok :: JsonPointer -> Value -> Either ResolutionError (JsonPointer, Value)
63+resolveRefTok p v = do
6064 case _unJsonPointer p of
61− [] -> Right (v, p)
65+ [] -> Right (p, v)
6266 (tok:ps) ->
6367 case v of
6468 Object h ->
6569 case H.lookup tok h of
6670 Nothing -> Left ObjectLookupFailed
67− Just vv -> Right (vv, JsonPointer ps)
71+ Just vv -> Right (JsonPointer ps, vv)
6872 Array vs -> do
6973 case readMaybe (T.unpack tok) of
7074 Nothing -> Left ArrayIndexInvalid
7175 Just n -> do
72− unless (n >= 0) $ Left ArrayIndexInvalid
73− unless (n < V.length vs) $ Left ArrayElemNotFound
74− Right (vs V.! n, JsonPointer ps)
75− vv -> do
76− unless (null ps) $ Left UnindexableValue
77− Right (vv, JsonPointer [])
76+ when (n < 0) $ Left ArrayIndexInvalid
77+ when (n >= V.length vs) $ Left ArrayElemNotFound
78+ Right (JsonPointer ps, vs V.! n)
79+ _ -> Left ExpectedObjectOrArray