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:
Ian Grant Jeffries 2015-03-26 19:41:30 -04:00
parent c1075bb702
commit 907156bdaf
5 changed files with 75 additions and 37 deletions

View File

@ -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
View 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.

View File

@ -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

View File

@ -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

View File

@ -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")