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