mirror of
https://github.com/typeable/hjsonpointer.git
synced 2024-08-17 02:20:23 +03:00
0.3.0.0 - rewrite.
This commit is contained in:
parent
05c967e9db
commit
59434d8b81
81
.travis.yml
Normal file
81
.travis.yml
Normal file
@ -0,0 +1,81 @@
|
||||
# This file has been generated -- see https://github.com/hvr/multi-ghc-travis
|
||||
#
|
||||
# Manually modified to remove cabal check. I don't want a description field.
|
||||
|
||||
language: c
|
||||
sudo: false
|
||||
|
||||
cache:
|
||||
directories:
|
||||
- $HOME/.cabsnap
|
||||
- $HOME/.cabal/packages
|
||||
|
||||
before_cache:
|
||||
- rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log
|
||||
- rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.tar
|
||||
|
||||
matrix:
|
||||
include:
|
||||
- env: CABALVER=1.18 GHCVER=7.8.4
|
||||
compiler: ": #GHC 7.8.4"
|
||||
addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4], sources: [hvr-ghc]}}
|
||||
- env: CABALVER=1.22 GHCVER=7.10.2
|
||||
compiler: ": #GHC 7.10.2"
|
||||
addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.2], sources: [hvr-ghc]}}
|
||||
|
||||
before_install:
|
||||
- unset CC
|
||||
- export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH
|
||||
|
||||
install:
|
||||
- cabal --version
|
||||
- echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]"
|
||||
- if [ -f $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz ];
|
||||
then
|
||||
zcat $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz >
|
||||
$HOME/.cabal/packages/hackage.haskell.org/00-index.tar;
|
||||
fi
|
||||
- travis_retry cabal update -v
|
||||
- sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config
|
||||
- cabal install --only-dependencies --enable-tests --enable-benchmarks --dry -v > installplan.txt
|
||||
- sed -i -e '1,/^Resolving /d' installplan.txt; cat installplan.txt
|
||||
|
||||
# check whether current requested install-plan matches cached package-db snapshot
|
||||
- if diff -u installplan.txt $HOME/.cabsnap/installplan.txt;
|
||||
then
|
||||
echo "cabal build-cache HIT";
|
||||
rm -rfv .ghc;
|
||||
cp -a $HOME/.cabsnap/ghc $HOME/.ghc;
|
||||
cp -a $HOME/.cabsnap/lib $HOME/.cabsnap/share $HOME/.cabsnap/bin $HOME/.cabal/;
|
||||
else
|
||||
echo "cabal build-cache MISS";
|
||||
rm -rf $HOME/.cabsnap;
|
||||
mkdir -p $HOME/.ghc $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin;
|
||||
cabal install --only-dependencies --enable-tests --enable-benchmarks;
|
||||
fi
|
||||
|
||||
# snapshot package-db on cache miss
|
||||
- if [ ! -d $HOME/.cabsnap ];
|
||||
then
|
||||
echo "snapshotting package-db to build-cache";
|
||||
mkdir $HOME/.cabsnap;
|
||||
cp -a $HOME/.ghc $HOME/.cabsnap/ghc;
|
||||
cp -a $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin installplan.txt $HOME/.cabsnap/;
|
||||
fi
|
||||
|
||||
# Here starts the actual work to be performed for the package under test;
|
||||
# any command which exits with a non-zero exit code causes the build to fail.
|
||||
script:
|
||||
- if [ -f configure.ac ]; then autoreconf -i; fi
|
||||
- cabal configure --enable-tests --enable-benchmarks -v2 # -v2 provides useful information for debugging
|
||||
- cabal build # this builds all libraries and executables (including tests/benchmarks)
|
||||
- cabal test
|
||||
- cabal sdist # tests that a source-distribution can be generated
|
||||
|
||||
# Check that the resulting source distribution can be built & installed.
|
||||
# If there are no other `.tar.gz` files in `dist`, this can be even simpler:
|
||||
# `cabal install --force-reinstalls dist/*-*.tar.gz`
|
||||
- SRC_TGZ=$(cabal info . | awk '{print $2;exit}').tar.gz &&
|
||||
(cd dist && cabal install --force-reinstalls "$SRC_TGZ")
|
||||
|
||||
# EOF
|
30
Example.hs
Normal file
30
Example.hs
Normal file
@ -0,0 +1,30 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Main where
|
||||
|
||||
import Control.Monad (unless)
|
||||
import Data.Aeson
|
||||
import qualified Data.Aeson.Pointer as P
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
-- JSON Pointers must either be empty or start with a /.
|
||||
pntr1 <- case P.unescape "/foo/0" of
|
||||
Left _ -> error "Failed to construct JSON Pointer."
|
||||
Right pntr -> return pntr
|
||||
|
||||
-- We can also write JSON Pointers in Haskell.
|
||||
let pntr2 = P.Pointer [P.Token "/"]
|
||||
-- When we do this we don't have to escape / or ~ characters
|
||||
-- (as ~1 and ~0 respectively) like we do in an escaped JSON
|
||||
-- Pointer string.
|
||||
unless (P.unescape "/~1" == Right pntr2) (error "ohno!")
|
||||
|
||||
print (P.resolve pntr1 document)
|
||||
print (P.resolve pntr2 document)
|
||||
|
||||
where
|
||||
document :: Value
|
||||
document = object [ "foo" .= [String "bar", String "baz"]
|
||||
, "/" .= String "quux"
|
||||
]
|
39
README.md
39
README.md
@ -2,28 +2,45 @@
|
||||
|
||||
[JSON Pointer](http://tools.ietf.org/html/rfc6901) library for Haskell.
|
||||
|
||||
[Hackage](https://hackage.haskell.org/package/hjsonpointer) / [GitHub](https://github.com/seagreen/hjsonpointer) / [Travis CI](https://travis-ci.org/seagreen/hjsonpointer)
|
||||
|
||||
# Example
|
||||
|
||||
```
|
||||
```haskell
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Main where
|
||||
|
||||
import Control.Monad (unless)
|
||||
import Data.Aeson
|
||||
import qualified Data.HashMap.Strict as H
|
||||
import Data.JsonPointer
|
||||
import qualified Data.Aeson.Pointer as P
|
||||
|
||||
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
|
||||
main = do
|
||||
-- JSON Pointers must either be empty or start with a /.
|
||||
pntr1 <- case P.unescape "/foo/0" of
|
||||
Left _ -> error "Failed to construct JSON Pointer."
|
||||
Right pntr -> pure pntr
|
||||
|
||||
-- We can also write JSON Pointers in Haskell.
|
||||
let pntr2 = P.Pointer [P.Token "/"]
|
||||
-- When we do this we don't have to escape / or ~ characters
|
||||
-- (as ~1 and ~0 respectively) like we do in an escaped JSON
|
||||
-- Pointer string.
|
||||
unless (P.unescape "/~1" == Right pntr2) (error "ohno!")
|
||||
|
||||
print (P.resolve pntr1 document)
|
||||
print (P.resolve pntr2 document)
|
||||
|
||||
where
|
||||
document :: Value
|
||||
document = object [ "foo" .= [String "bar", String "baz"]
|
||||
, "/" .= String "quux"
|
||||
]
|
||||
```
|
||||
|
||||
Output:
|
||||
```
|
||||
String "bar"
|
||||
Right (String "bar")
|
||||
Right (String "quux")
|
||||
```
|
||||
|
13
changelog.md
Normal file
13
changelog.md
Normal file
@ -0,0 +1,13 @@
|
||||
# 0.3
|
||||
|
||||
+ Rewrite.
|
||||
|
||||
# 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,9 +0,0 @@
|
||||
# 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,5 +1,5 @@
|
||||
name: hjsonpointer
|
||||
version: 0.2.0.4
|
||||
version: 0.3.0.0
|
||||
synopsis: JSON Pointer library
|
||||
homepage: https://github.com/seagreen/hjsonpointer
|
||||
license: MIT
|
||||
@ -9,17 +9,20 @@ maintainer: ian@housejeffries.com
|
||||
category: Data
|
||||
build-type: Simple
|
||||
cabal-version: >=1.10
|
||||
extra-source-files: changelog.txt
|
||||
tested-with: GHC == 7.8.4, GHC == 7.10.3
|
||||
extra-source-files: changelog.md
|
||||
README.md
|
||||
|
||||
library
|
||||
hs-source-dirs: src
|
||||
exposed-modules: Data.JsonPointer
|
||||
exposed-modules: Data.Aeson.Pointer
|
||||
default-language: Haskell2010
|
||||
default-extensions: OverloadedStrings
|
||||
other-extensions: GeneralizedNewtypeDeriving
|
||||
ghc-options: -Wall
|
||||
build-depends: aeson >= 0.7 && < 0.10
|
||||
build-depends: aeson >= 0.7 && < 0.12
|
||||
, base >= 4.6 && < 4.9
|
||||
, QuickCheck >= 2.8 && < 2.9
|
||||
, unordered-containers >= 0.2 && < 0.3
|
||||
, text >= 1.2 && < 1.3
|
||||
, vector >= 0.10 && < 0.12
|
||||
@ -37,10 +40,19 @@ test-suite unit
|
||||
, unordered-containers
|
||||
, text
|
||||
, vector
|
||||
, http-types >= 0.8 && < 0.9
|
||||
, HUnit >= 1.2 && < 1.4
|
||||
, test-framework >= 0.8 && < 0.9
|
||||
, test-framework-hunit >= 0.3 && < 0.4
|
||||
, http-types >= 0.8 && < 0.10
|
||||
, HUnit >= 1.2 && < 1.4
|
||||
, test-framework >= 0.8 && < 0.9
|
||||
, test-framework-hunit >= 0.3 && < 0.4
|
||||
, test-framework-quickcheck2 >= 0.3 && < 0.4
|
||||
|
||||
executable example
|
||||
main-is: Example.hs
|
||||
default-language: Haskell2010
|
||||
ghc-options: -Wall
|
||||
build-depends: aeson
|
||||
, base
|
||||
, hjsonpointer
|
||||
|
||||
source-repository head
|
||||
type: git
|
||||
|
122
src/Data/Aeson/Pointer.hs
Normal file
122
src/Data/Aeson/Pointer.hs
Normal file
@ -0,0 +1,122 @@
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
|
||||
module Data.Aeson.Pointer where
|
||||
|
||||
import Control.Monad (when)
|
||||
import Data.Aeson
|
||||
import qualified Data.HashMap.Strict as H
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Vector as V
|
||||
import Test.QuickCheck
|
||||
import Text.Read (readMaybe)
|
||||
|
||||
-- For GHCs before 7.10:
|
||||
import Control.Applicative
|
||||
import Data.Monoid
|
||||
import Data.Traversable
|
||||
|
||||
newtype Pointer
|
||||
= Pointer { _unPointer :: [Token] }
|
||||
deriving (Eq, Show, Monoid, Arbitrary)
|
||||
|
||||
instance FromJSON Pointer where
|
||||
parseJSON = withText "JSON Pointer" $ \t ->
|
||||
case unescape t of
|
||||
Left e -> fail (show e)
|
||||
Right p -> pure p
|
||||
|
||||
instance ToJSON Pointer where
|
||||
toJSON = String . escape
|
||||
|
||||
-- | We don't try to distinguish between integer tokens and string
|
||||
-- tokens since all tokens start as strings, and all tokens can
|
||||
-- be used to resolve JSON objects.
|
||||
newtype Token = Token { _unToken :: Text } deriving (Eq, Show)
|
||||
|
||||
instance Arbitrary Token where
|
||||
arbitrary = Token . T.pack <$> arbitrary
|
||||
|
||||
escape :: Pointer -> Text
|
||||
escape (Pointer []) = ""
|
||||
escape (Pointer ts) =
|
||||
T.cons '/'
|
||||
. T.intercalate "/"
|
||||
. fmap (T.replace "/" "~1" . T.replace "~" "~0" . _unToken)
|
||||
$ ts
|
||||
|
||||
-- * Unescaping
|
||||
|
||||
data FormatError
|
||||
= InvalidFirstChar
|
||||
-- ^ JSON Pointers must either be empty or start with a @/@.
|
||||
| UnescapedTilde
|
||||
deriving (Eq, Show)
|
||||
|
||||
|
||||
-- | JSON Pointers must either be empty or start with a @/@. This means
|
||||
-- that if you're turning a URI Fragment into a JSON Pointer you must
|
||||
-- drop the initial @#@.
|
||||
--
|
||||
-- Note that the unescaping happening here is not the same as URI
|
||||
-- decoding. If you are turning a URI fragment into a JSON Pointer you
|
||||
-- must URI decode the 'Text' before using it as an argument to this
|
||||
-- function. There's an example of how to do this in the tests using
|
||||
-- "Network.HTTP.Types.URI.urlDecode" from http-types.
|
||||
unescape :: Text -> Either FormatError Pointer
|
||||
unescape txt =
|
||||
case T.splitOn "/" txt of
|
||||
[] -> Right (Pointer [])
|
||||
"":xs -> Pointer <$> traverse f xs
|
||||
_ -> Left InvalidFirstChar
|
||||
where
|
||||
f :: Text -> Either FormatError Token
|
||||
f t = case unescapeToken t of
|
||||
Nothing -> Left UnescapedTilde
|
||||
Just tok -> Right tok
|
||||
|
||||
-- | For internal use by 'unescape'.
|
||||
unescapeToken :: Text -> Maybe Token
|
||||
unescapeToken t
|
||||
| not (isValid t) = Nothing
|
||||
| otherwise = Just . Token . replace $ t
|
||||
where
|
||||
-- All tildes must be followed by 0s or 1s.
|
||||
isValid :: Text -> Bool
|
||||
isValid x = all (\y -> T.isPrefixOf "0" y || T.isPrefixOf "1" y) afterTildes
|
||||
where
|
||||
afterTildes :: [Text]
|
||||
afterTildes = drop 1 $ T.splitOn "~" x
|
||||
|
||||
replace :: Text -> Text
|
||||
replace = T.replace "~0" "~" . T.replace "~1" "/"
|
||||
|
||||
-- * Resolution
|
||||
|
||||
data ResolutionError
|
||||
= ObjectLookupFailed
|
||||
| ArrayIndexInvalid
|
||||
| ArrayElemNotFound
|
||||
| ExpectedObjectOrArray
|
||||
deriving (Eq, Show)
|
||||
|
||||
resolve :: Pointer -> Value -> Either ResolutionError Value
|
||||
resolve (Pointer []) v = Right v
|
||||
resolve (Pointer (t:ts)) v = resolveToken t v >>= resolve (Pointer ts)
|
||||
|
||||
-- | For internal use (or specialized applications that don't want to
|
||||
-- resolve an entire pointer at once).
|
||||
resolveToken :: Token -> Value -> Either ResolutionError Value
|
||||
resolveToken tok (Array vs) =
|
||||
case readMaybe . T.unpack . _unToken $ tok of
|
||||
Nothing -> Left ArrayIndexInvalid
|
||||
Just n -> do
|
||||
when (n < 0) (Left ArrayIndexInvalid)
|
||||
case vs V.!? n of
|
||||
Nothing -> Left ArrayElemNotFound
|
||||
Just res -> Right res
|
||||
resolveToken tok (Object h) =
|
||||
case H.lookup (_unToken tok) h of
|
||||
Nothing -> Left ObjectLookupFailed
|
||||
Just res -> Right res
|
||||
resolveToken _ _ = Left ExpectedObjectOrArray
|
@ -1,79 +0,0 @@
|
||||
module Data.JsonPointer where
|
||||
|
||||
import Control.Applicative
|
||||
import Control.Monad
|
||||
import Data.Aeson
|
||||
import qualified Data.HashMap.Strict as H
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Vector as V
|
||||
import Text.Read (readMaybe)
|
||||
|
||||
newtype JsonPointer = JsonPointer { _unJsonPointer :: [Text] } deriving (Eq, Show)
|
||||
|
||||
data PointerFormatError
|
||||
-- | The Text to build a JSON Pointer must either be empty
|
||||
-- or start with a "/".
|
||||
= InvalidFirstChar
|
||||
| UnescapedTilde
|
||||
deriving (Eq, Show)
|
||||
|
||||
data ResolutionError
|
||||
= ObjectLookupFailed
|
||||
| ArrayIndexInvalid
|
||||
| ArrayElemNotFound
|
||||
| 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 PointerFormatError JsonPointer
|
||||
jsonPointer t =
|
||||
JsonPointer <$> (unescape =<< process (T.splitOn "/" t))
|
||||
where
|
||||
process ::[Text] -> Either PointerFormatError [Text]
|
||||
process [] = Right []
|
||||
process (x:xs)
|
||||
-- This checks that the JsonPointer started with a "/":
|
||||
| (not . T.null $ x) = Left InvalidFirstChar
|
||||
| otherwise = Right xs
|
||||
|
||||
unescape :: [Text] -> Either PointerFormatError [Text]
|
||||
unescape xs = do
|
||||
void $ mapM checkValid xs
|
||||
Right $ T.replace "~0" "~" . T.replace "~1" "/" <$> xs
|
||||
|
||||
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 :: JsonPointer -> Value -> Either ResolutionError Value
|
||||
resolvePointer p v =
|
||||
case _unJsonPointer p of
|
||||
[] -> Right v
|
||||
_ -> resolveRefTok p v >>= uncurry resolvePointer
|
||||
|
||||
-- | For internal use and specialized applications that don't want to
|
||||
-- resolve the entire pointer at once.
|
||||
resolveRefTok :: JsonPointer -> Value -> Either ResolutionError (JsonPointer, Value)
|
||||
resolveRefTok p v = do
|
||||
case _unJsonPointer p of
|
||||
[] -> Right (p, v)
|
||||
(tok:ps) ->
|
||||
case v of
|
||||
Object h ->
|
||||
case H.lookup tok h of
|
||||
Nothing -> Left ObjectLookupFailed
|
||||
Just vv -> Right (JsonPointer ps, vv)
|
||||
Array vs -> do
|
||||
case readMaybe (T.unpack tok) of
|
||||
Nothing -> Left ArrayIndexInvalid
|
||||
Just n -> do
|
||||
when (n < 0) $ Left ArrayIndexInvalid
|
||||
when (n >= V.length vs) $ Left ArrayElemNotFound
|
||||
Right (JsonPointer ps, vs V.! n)
|
||||
_ -> Left ExpectedObjectOrArray
|
135
tests/Unit.hs
135
tests/Unit.hs
@ -1,87 +1,90 @@
|
||||
|
||||
module Main where
|
||||
|
||||
import Control.Applicative
|
||||
import Control.Arrow
|
||||
import Control.Monad
|
||||
import Data.Aeson
|
||||
import qualified Data.HashMap.Strict as H
|
||||
import Data.JsonPointer
|
||||
import Data.Monoid
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Aeson.Pointer as P
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Data.Text.Encoding
|
||||
import qualified Data.Vector as V
|
||||
import Network.HTTP.Types.URI
|
||||
import Test.Framework (defaultMain, testGroup)
|
||||
import Test.Framework.Providers.HUnit (testCase)
|
||||
import Test.HUnit hiding (Test)
|
||||
import qualified Data.Vector as V
|
||||
import Network.HTTP.Types.URI (urlDecode)
|
||||
import Test.Framework (defaultMain, testGroup)
|
||||
import Test.Framework.Providers.HUnit (testCase)
|
||||
import Test.Framework.Providers.QuickCheck2 (testProperty)
|
||||
import Test.HUnit hiding (Test)
|
||||
|
||||
-- For GHCs before 7.10:
|
||||
import Control.Applicative
|
||||
import Data.Foldable
|
||||
import Data.Monoid
|
||||
|
||||
main :: IO ()
|
||||
main = defaultMain
|
||||
[ testGroup "unit"
|
||||
[ testCase "Can be represented in a JSON string value" jsonString
|
||||
[ testProperty "Storing a Pointer as JSON doesn't change its value" roundtrip
|
||||
, testCase "Can be represented in a JSON string value" jsonString
|
||||
, testCase "Can be represented in a URI fragment identifier" uriFragment
|
||||
]
|
||||
]
|
||||
|
||||
specExample :: Value
|
||||
specExample =
|
||||
Object $ H.fromList
|
||||
[ ("foo" , Array $ V.fromList ["bar", "baz"])
|
||||
, ("" , Number 0)
|
||||
, ("a/b" , Number 1)
|
||||
, ("c%d" , Number 2)
|
||||
, ("e^f" , Number 3)
|
||||
, ("g|h" , Number 4)
|
||||
, ("i\\j", Number 5)
|
||||
, ("k\"l", Number 6)
|
||||
, (" " , Number 7)
|
||||
, ("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
|
||||
roundtrip :: P.Pointer -> Bool
|
||||
roundtrip a = Just a == decode (encode a)
|
||||
|
||||
jsonString :: Assertion
|
||||
jsonString =
|
||||
void $ mapM resolvesTo
|
||||
[ ("" , specExample)
|
||||
, ("/foo" , Array $ V.fromList ["bar", "baz"])
|
||||
, ("/foo/0", String "bar")
|
||||
, ("/" , Number 0)
|
||||
, ("/a~1b" , Number 1)
|
||||
, ("/c%d" , Number 2)
|
||||
, ("/e^f" , Number 3)
|
||||
, ("/g|h" , Number 4)
|
||||
, ("/i\\j" , Number 5)
|
||||
, ("/k\"l" , Number 6)
|
||||
, ("/ " , Number 7)
|
||||
, ("/m~0n" , Number 8)
|
||||
]
|
||||
jsonString = traverse_ resolvesTo
|
||||
[ ("" , specExample)
|
||||
, ("/foo" , Array $ V.fromList ["bar", "baz"])
|
||||
, ("/foo/0", String "bar")
|
||||
, ("/" , Number 0)
|
||||
, ("/a~1b" , Number 1)
|
||||
, ("/c%d" , Number 2)
|
||||
, ("/e^f" , Number 3)
|
||||
, ("/g|h" , Number 4)
|
||||
, ("/i\\j" , Number 5)
|
||||
, ("/k\"l" , Number 6)
|
||||
, ("/ " , Number 7)
|
||||
, ("/m~0n" , Number 8)
|
||||
]
|
||||
|
||||
uriFragment :: Assertion
|
||||
uriFragment =
|
||||
void $ mapM resolvesTo $ first decodeFragment <$>
|
||||
[ ("#" , specExample)
|
||||
, ("#/foo" , Array $ V.fromList ["bar", "baz"])
|
||||
, ("#/foo/0", String "bar")
|
||||
, ("#/" , Number 0)
|
||||
, ("#/a~1b" , Number 1)
|
||||
, ("#/c%25d", Number 2)
|
||||
, ("#/e%5Ef", Number 3)
|
||||
, ("#/g%7Ch", Number 4)
|
||||
, ("#/i%5Cj", Number 5)
|
||||
, ("#/k%22l", Number 6)
|
||||
, ("#/%20" , Number 7)
|
||||
, ("#/m~0n" , Number 8)
|
||||
]
|
||||
uriFragment = traverse_ resolvesTo . fmap (first decodeFragment) $
|
||||
[ ("#" , specExample)
|
||||
, ("#/foo" , Array $ V.fromList ["bar", "baz"])
|
||||
, ("#/foo/0", String "bar")
|
||||
, ("#/" , Number 0)
|
||||
, ("#/a~1b" , Number 1)
|
||||
, ("#/c%25d", Number 2)
|
||||
, ("#/e%5Ef", Number 3)
|
||||
, ("#/g%7Ch", Number 4)
|
||||
, ("#/i%5Cj", Number 5)
|
||||
, ("#/k%22l", Number 6)
|
||||
, ("#/%20" , Number 7)
|
||||
, ("#/m~0n" , Number 8)
|
||||
]
|
||||
where
|
||||
decodeFragment :: Text -> Text
|
||||
decodeFragment = T.drop 1 . decodeUtf8 . urlDecode True . encodeUtf8
|
||||
|
||||
resolvesTo :: (Text, Value) -> Assertion
|
||||
resolvesTo (t, expected) =
|
||||
case P.unescape t of
|
||||
Left e -> assertFailure (show e <> " error for pointer: " <> show t)
|
||||
Right p -> assertEqual
|
||||
("Resolved value for pointer: " <> show t)
|
||||
(Right expected)
|
||||
(P.resolve p specExample)
|
||||
|
||||
specExample :: Value
|
||||
specExample = object
|
||||
[ "foo" .= (["bar", "baz"] :: [Text])
|
||||
, "" .= (0 :: Int)
|
||||
, "a/b" .= (1 :: Int)
|
||||
, "c%d" .= (2 :: Int)
|
||||
, "e^f" .= (3 :: Int)
|
||||
, "g|h" .= (4 :: Int)
|
||||
, "i\\j" .= (5 :: Int)
|
||||
, "k\"l" .= (6 :: Int)
|
||||
, " " .= (7 :: Int)
|
||||
, "m~n" .= (8 :: Int)
|
||||
]
|
||||
|
Loading…
Reference in New Issue
Block a user