mirror of
https://github.com/typeable/hjsonpointer.git
synced 2024-08-17 02:20:23 +03:00
0.2
Fix mistake in resolveRefTok. Split errors over two types. Switch the order of pointer and value arguments for functions that take both. The pointer now comes first.
This commit is contained in:
parent
c1075bb702
commit
907156bdaf
23
README.md
23
README.md
@ -5,6 +5,25 @@
|
||||
# Example
|
||||
|
||||
```
|
||||
λ jsonPointer "/foo" >>= resolvePointer (Object $ singleton "foo" $ String "bar")
|
||||
Right (String "bar")
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Main where
|
||||
|
||||
import Data.Aeson
|
||||
import qualified Data.HashMap.Strict as H
|
||||
import Data.JsonPointer
|
||||
|
||||
main :: IO ()
|
||||
main =
|
||||
case jsonPointer "/foo" of
|
||||
Left e -> print e
|
||||
Right pntr ->
|
||||
case resolvePointer pntr (Object $ H.singleton "foo" $ String "bar") of
|
||||
Left e2 -> print e2
|
||||
Right v -> print v
|
||||
```
|
||||
|
||||
Output:
|
||||
```
|
||||
String "bar"
|
||||
```
|
||||
|
9
changelog.txt
Normal file
9
changelog.txt
Normal file
@ -0,0 +1,9 @@
|
||||
# 0.2
|
||||
|
||||
Fix mistake in resolveRefTok.
|
||||
Split errors over two types.
|
||||
Switch the order of pointer and value arguments for functions that take both. The pointer now comes first.
|
||||
|
||||
# 0.1
|
||||
|
||||
Initial implementation.
|
@ -1,6 +1,6 @@
|
||||
name: hjsonpointer
|
||||
version: 0.1.0.1
|
||||
synopsis: JSON Pointer library for Haskell
|
||||
version: 0.2.0.0
|
||||
synopsis: JSON Pointer library
|
||||
homepage: https://github.com/seagreen/hjsonpointer
|
||||
license: MIT
|
||||
license-file: MIT-LICENSE.txt
|
||||
@ -9,7 +9,8 @@ maintainer: ian@housejeffries.com
|
||||
category: Data
|
||||
build-type: Simple
|
||||
cabal-version: >=1.10
|
||||
extra-source-files: README.md
|
||||
extra-source-files: changelog.txt
|
||||
README.md
|
||||
|
||||
library
|
||||
hs-source-dirs: src
|
||||
|
@ -11,67 +11,69 @@ import Text.Read (readMaybe)
|
||||
|
||||
newtype JsonPointer = JsonPointer { _unJsonPointer :: [Text] } deriving (Eq, Show)
|
||||
|
||||
data PointerErr
|
||||
data PointerFormatError
|
||||
-- | The Text to build a JSON Pointer must either be empty
|
||||
-- or start with a '/'.
|
||||
-- or start with a "/".
|
||||
= InvalidFirstChar
|
||||
| UnescapedTilde
|
||||
| ObjectLookupFailed
|
||||
deriving (Eq, Show)
|
||||
|
||||
data ResolutionError
|
||||
= ObjectLookupFailed
|
||||
| ArrayIndexInvalid
|
||||
| ArrayElemNotFound
|
||||
| UnindexableValue
|
||||
| ExpectedObjectOrArray
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | The Text to build a JSON Pointer must either be empty or start
|
||||
-- with a '/'. If you're turning a URI Fragment into a JSON Pointer
|
||||
-- you must drop the initial '#'.
|
||||
jsonPointer :: Text -> Either PointerErr JsonPointer
|
||||
-- with a "/". If you're turning a URI Fragment into a JSON Pointer
|
||||
-- you must drop the initial "#".
|
||||
jsonPointer :: Text -> Either PointerFormatError JsonPointer
|
||||
jsonPointer t =
|
||||
JsonPointer <$> (unescape =<< process (T.splitOn "/" t))
|
||||
where
|
||||
process ::[Text] -> Either PointerErr [Text]
|
||||
process ::[Text] -> Either PointerFormatError [Text]
|
||||
process [] = Right []
|
||||
process (x:xs) = do
|
||||
unless (T.null x) $ Left InvalidFirstChar
|
||||
Right xs
|
||||
process (x:xs)
|
||||
-- This checks that the JsonPointer started with a "/":
|
||||
| (not . T.null $ x) = Left InvalidFirstChar
|
||||
| otherwise = Right xs
|
||||
|
||||
unescape :: [Text] -> Either PointerErr [Text]
|
||||
unescape :: [Text] -> Either PointerFormatError [Text]
|
||||
unescape xs = do
|
||||
void $ mapM checkValid xs
|
||||
Right $ T.replace "~0" "~" . T.replace "~1" "/" <$> xs
|
||||
|
||||
checkValid :: Text -> Either PointerErr ()
|
||||
checkValid :: Text -> Either PointerFormatError ()
|
||||
checkValid x = do
|
||||
let afterTildes = drop 1 $ T.splitOn "~" x
|
||||
if all (\y -> T.isPrefixOf "0" y || T.isPrefixOf "1" y) afterTildes
|
||||
then Right ()
|
||||
else Left UnescapedTilde
|
||||
|
||||
resolvePointer :: Value -> JsonPointer -> Either PointerErr Value
|
||||
resolvePointer v p =
|
||||
resolvePointer :: JsonPointer -> Value -> Either ResolutionError Value
|
||||
resolvePointer p v =
|
||||
case _unJsonPointer p of
|
||||
[] -> Right v
|
||||
_ -> resolveRefTok v p >>= uncurry resolvePointer
|
||||
_ -> resolveRefTok p v >>= uncurry resolvePointer
|
||||
|
||||
-- | For internal use and specialized applications that don't want to
|
||||
-- resolve the entire pointer at once.
|
||||
resolveRefTok :: Value -> JsonPointer -> Either PointerErr (Value, JsonPointer)
|
||||
resolveRefTok v p = do
|
||||
resolveRefTok :: JsonPointer -> Value -> Either ResolutionError (JsonPointer, Value)
|
||||
resolveRefTok p v = do
|
||||
case _unJsonPointer p of
|
||||
[] -> Right (v, p)
|
||||
[] -> Right (p, v)
|
||||
(tok:ps) ->
|
||||
case v of
|
||||
Object h ->
|
||||
case H.lookup tok h of
|
||||
Nothing -> Left ObjectLookupFailed
|
||||
Just vv -> Right (vv, JsonPointer ps)
|
||||
Just vv -> Right (JsonPointer ps, vv)
|
||||
Array vs -> do
|
||||
case readMaybe (T.unpack tok) of
|
||||
Nothing -> Left ArrayIndexInvalid
|
||||
Just n -> do
|
||||
unless (n >= 0) $ Left ArrayIndexInvalid
|
||||
unless (n < V.length vs) $ Left ArrayElemNotFound
|
||||
Right (vs V.! n, JsonPointer ps)
|
||||
vv -> do
|
||||
unless (null ps) $ Left UnindexableValue
|
||||
Right (vv, JsonPointer [])
|
||||
when (n < 0) $ Left ArrayIndexInvalid
|
||||
when (n >= V.length vs) $ Left ArrayElemNotFound
|
||||
Right (JsonPointer ps, vs V.! n)
|
||||
_ -> Left ExpectedObjectOrArray
|
||||
|
@ -1,5 +1,7 @@
|
||||
module Main where
|
||||
|
||||
import Control.Applicative
|
||||
import Control.Arrow
|
||||
import Control.Monad
|
||||
import Data.Aeson
|
||||
import qualified Data.HashMap.Strict as H
|
||||
@ -38,11 +40,18 @@ specExample =
|
||||
, ("m~n" , Number 8)
|
||||
]
|
||||
|
||||
resolvesTo :: (Text, Value) -> Assertion
|
||||
resolvesTo (t, expected) =
|
||||
case jsonPointer t of
|
||||
Left e -> assertFailure (show e <> " error for pointer: " <> show t)
|
||||
Right p ->
|
||||
assertEqual ("Resolved value for pointer: " <> show t)
|
||||
(Right expected)
|
||||
$ resolvePointer p specExample
|
||||
|
||||
jsonString :: Assertion
|
||||
jsonString =
|
||||
void $ mapM
|
||||
(\(a,expected) -> assertEqual ("Tried to resolve " <> show a) (Right expected)
|
||||
$ jsonPointer a >>= resolvePointer specExample)
|
||||
void $ mapM resolvesTo
|
||||
[ ("" , specExample)
|
||||
, ("/foo" , Array $ V.fromList ["bar", "baz"])
|
||||
, ("/foo/0", String "bar")
|
||||
@ -59,9 +68,7 @@ jsonString =
|
||||
|
||||
uriFragment :: Assertion
|
||||
uriFragment =
|
||||
void $ mapM
|
||||
(\(a,expected) -> assertEqual ("Tried to resolve " <> show a) (Right expected)
|
||||
$ jsonPointer (decodeFragment a) >>= resolvePointer specExample)
|
||||
void $ mapM resolvesTo $ first decodeFragment <$>
|
||||
[ ("#" , specExample)
|
||||
, ("#/foo" , Array $ V.fromList ["bar", "baz"])
|
||||
, ("#/foo/0", String "bar")
|
||||
|
Loading…
Reference in New Issue
Block a user