950a712...master · typeable/hjsonpointer

git.iko.soy/typeable/hjsonpointer

10 files changed+263−154

since splitsnapshots

unifiedsplit

.travis.yml+79−59 Example.hs+7−8 MIT-LICENSE.txt+1−1 README.md+7−9 changelog.md+44 hjsonpointer.cabal+15−22 shell.nix+9 src/Data/Aeson/Pointer.hs → src/JSONPointer.hs+76−31 stack.yaml+2 test/Unit.hs+23−24

.travis.yml+79−59

@@ -1,84 +1,104 @@

1−# This file has been generated -- see https://github.com/hvr/multi-ghc-travis

1+# This Travis job script has been generated by a script via

22#

3−# Manually modified to remove cabal check. I don't want a description field.

3+# runghc make_travis_yml_2.hs 'hjsonpointer.cabal'

4+#

5+# For more information, see https://github.com/hvr/multi-ghc-travis

7+# NOTE: After generating comment out `cabal check`, it requires a description field.

59language: c

610sudo: false

711

12+git:

13+ submodules: false # whether to recursively clone submodules

14+

815cache:

916 directories:

10− - $HOME/.cabsnap

1117 - $HOME/.cabal/packages

18+ - $HOME/.cabal/store

1219

1320before_cache:

1421 - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log

15− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.tar

22+ # remove files that are regenerated by 'cabal update'

23+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.*

24+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/*.json

25+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.cache

26+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar

27+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar.idx

28+

29+ - rm -rfv $HOME/.cabal/packages/head.hackage

1630

1731matrix:

1832 include:

19− - env: CABALVER=1.18 GHCVER=7.8.4

20− compiler: ": #GHC 7.8.4"

21− addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4], sources: [hvr-ghc]}}

22− - env: CABALVER=1.22 GHCVER=7.10.2

23− compiler: ": #GHC 7.10.2"

24− addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.2], sources: [hvr-ghc]}}

25− - env: CABALVER=1.24 GHCVER=8.0.1

26− compiler: ": #GHC 8.0.1"

27− addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.1], sources: [hvr-ghc]}}

33+ - compiler: "ghc-8.0.2"

34+ # env: TEST=--disable-tests BENCH=--disable-benchmarks

35+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.0.2], sources: [hvr-ghc]}}

36+ - compiler: "ghc-8.2.2"

37+ # env: TEST=--disable-tests BENCH=--disable-benchmarks

38+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.2.2], sources: [hvr-ghc]}}

39+ - compiler: "ghc-8.4.1"

40+ # env: TEST=--disable-tests BENCH=--disable-benchmarks

41+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.4.1], sources: [hvr-ghc]}}

2842

2943before_install:

30− - unset CC

31− - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH

44+ - HC=${CC}

45+ - HCPKG=${HC/ghc/ghc-pkg}

46+ - unset CC

47+ - ROOTDIR=$(pwd)

48+ - mkdir -p $HOME/.local/bin

49+ - "PATH=/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$HOME/local/bin:$PATH"

50+ - HCNUMVER=$(( $(${HC} --numeric-version|sed -E 's/([0-9]+)\.([0-9]+)\.([0-9]+).*/\1 * 10000 + \2 * 100 + \3/') ))

51+ - echo $HCNUMVER

3252

3353install:

34− - cabal --version

35− - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]"

36− - if [ -f $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz ];

37− then

38− zcat $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz >

39− $HOME/.cabal/packages/hackage.haskell.org/00-index.tar;

40− fi

41− - travis_retry cabal update -v

42− - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config

43− - cabal install --only-dependencies --enable-tests --enable-benchmarks --dry -v > installplan.txt

44− - sed -i -e '1,/^Resolving /d' installplan.txt; cat installplan.txt

45−

46−# check whether current requested install-plan matches cached package-db snapshot

47− - if diff -u installplan.txt $HOME/.cabsnap/installplan.txt;

48− then

49− echo "cabal build-cache HIT";

50− rm -rfv .ghc;

51− cp -a $HOME/.cabsnap/ghc $HOME/.ghc;

52− cp -a $HOME/.cabsnap/lib $HOME/.cabsnap/share $HOME/.cabsnap/bin $HOME/.cabal/;

53− else

54− echo "cabal build-cache MISS";

55− rm -rf $HOME/.cabsnap;

56− mkdir -p $HOME/.ghc $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin;

57− cabal install --only-dependencies --enable-tests --enable-benchmarks;

58− fi

59−

60−# snapshot package-db on cache miss

61− - if [ ! -d $HOME/.cabsnap ];

62− then

63− echo "snapshotting package-db to build-cache";

64− mkdir $HOME/.cabsnap;

65− cp -a $HOME/.ghc $HOME/.cabsnap/ghc;

66− cp -a $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin installplan.txt $HOME/.cabsnap/;

67− fi

54+ - cabal --version

55+ - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"

56+ - BENCH=${BENCH---enable-benchmarks}

57+ - TEST=${TEST---enable-tests}

58+ - HADDOCK=${HADDOCK-true}

59+ - INSTALLED=${INSTALLED-true}

60+ - GHCHEAD=${GHCHEAD-false}

61+ - travis_retry cabal update -v

62+ - "sed -i.bak 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config"

63+ - rm -fv cabal.project cabal.project.local

64+ - grep -Ev -- '^\s*--' ${HOME}/.cabal/config | grep -Ev '^\s*$'

65+ - "printf 'packages: \".\"\\n' > cabal.project"

66+ - cat cabal.project

67+ - if [ -f "./configure.ac" ]; then

68+ (cd "." && autoreconf -i);

69+ fi

70+ - rm -f cabal.project.freeze

71+ - cabal new-build -w ${HC} ${TEST} ${BENCH} --project-file="cabal.project" --dep -j2 all

72+ - cabal new-build -w ${HC} --disable-tests --disable-benchmarks --project-file="cabal.project" --dep -j2 all

73+ - rm -rf .ghc.environment.* "."/dist

74+ - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)

6875

6976# Here starts the actual work to be performed for the package under test;

7077# any command which exits with a non-zero exit code causes the build to fail.

7178script:

72− - if [ -f configure.ac ]; then autoreconf -i; fi

73− - cabal configure --enable-tests --enable-benchmarks -v2 # -v2 provides useful information for debugging

74− - cabal build # this builds all libraries and executables (including tests/benchmarks)

75− - cabal test

76− - cabal sdist # tests that a source-distribution can be generated

79+ # test that source-distributions can be generated

80+ - (cd "." && cabal sdist)

81+ - mv "."/dist/hjsonpointer-*.tar.gz ${DISTDIR}/

82+ - cd ${DISTDIR} || false

83+ - find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \;

84+ - "printf 'packages: hjsonpointer-*/*.cabal\\n' > cabal.project"

85+ - cat cabal.project

86+ # this builds all libraries and executables (without tests/benchmarks)

87+ - cabal new-build -w ${HC} --disable-tests --disable-benchmarks all

88+

89+ # Build with installed constraints for packages in global-db

90+ - if $INSTALLED; then echo cabal new-build -w ${HC} --disable-tests --disable-benchmarks $(${HCPKG} list --global --simple-output --names-only | sed 's/$[a-zA-Z0-9-]\{1,\}$ */--constraint="\1 installed" /g') all | sh; else echo "Not building with installed constraints"; fi

91+

92+ # build & run tests, build benchmarks

93+ - cabal new-build -w ${HC} ${TEST} ${BENCH} all

94+ - if [ "x$TEST" = "x--enable-tests" ]; then cabal new-test -w ${HC} ${TEST} ${BENCH} all; fi

95+

96+ # cabal check

97+ # - (cd hjsonpointer-* && cabal check)

7798

78−# Check that the resulting source distribution can be built & installed.

79−# If there are no other `.tar.gz` files in `dist`, this can be even simpler:

80−# `cabal install --force-reinstalls dist/*-*.tar.gz`

81− - SRC_TGZ=$(cabal info . | awk '{print $2;exit}').tar.gz &&

82− (cd dist && cabal install --force-reinstalls "$SRC_TGZ")

99+ # haddock

100+ - rm -rf ./dist-newstyle

101+ - if $HADDOCK; then cabal new-haddock -w ${HC} ${TEST} ${BENCH} all; else echo "Skipping haddock generation";fi

83102

103+# REGENDATA ["hjsonpointer.cabal"]

84104# EOF

Example.hs+7−8

@@ -1,27 +1,26 @@

1−{-# LANGUAGE OverloadedStrings #-}

32module Example where

5−import Control.Monad (unless)

4+import Control.Monad (unless)

65import Data.Aeson

7−import qualified Data.Aeson.Pointer as P

6+import qualified JSONPointer as JP

98main :: IO ()

109main = do

1110 -- JSON Pointers must either be empty or start with a /.

12− pntr1 <- case P.unescape "/foo/0" of

11+ pntr1 <- case JP.unescape "/foo/0" of

1312 Left _ -> error "Failed to construct JSON Pointer."

1413 Right pntr -> return pntr

1514

1615 -- We can also write JSON Pointers in Haskell.

17− let pntr2 = P.Pointer [P.Token "/"]

16+ let pntr2 = JP.Pointer [JP.Token "/"]

1817 -- When we do this we don't have to escape / or ~ characters

1918 -- (as ~1 and ~0 respectively) like we do in an escaped JSON

2019 -- Pointer string.

21− unless (P.unescape "/~1" == Right pntr2) (error "ohno!")

20+ unless (JP.unescape "/~1" == Right pntr2) (error "ohno!")

2221

23− print (P.resolve pntr1 document)

24− print (P.resolve pntr2 document)

22+ print (JP.resolve pntr1 document)

23+ print (JP.resolve pntr2 document)

2524

2625 where

2726 document :: Value

MIT-LICENSE.txt+1−1

@@ -1,5 +1,5 @@

11The MIT License (MIT)

44Permission is hereby granted, free of charge, to any person obtaining a copy

55of this software and associated documentation files (the "Software"), to deal

README.md+7−9

@@ -7,30 +7,28 @@

77# Example

99```haskell

10−{-# LANGUAGE OverloadedStrings #-}

11−

1210module Example where

1311

14−import Control.Monad (unless)

12+import Control.Monad (unless)

1513import Data.Aeson

16−import qualified Data.Aeson.Pointer as P

14+import qualified JSONPointer as JP

1715

1816main :: IO ()

1917main = do

2018 -- JSON Pointers must either be empty or start with a /.

21− pntr1 <- case P.unescape "/foo/0" of

19+ pntr1 <- case JP.unescape "/foo/0" of

2220 Left _ -> error "Failed to construct JSON Pointer."

2321 Right pntr -> return pntr

2422

2523 -- We can also write JSON Pointers in Haskell.

26− let pntr2 = P.Pointer [P.Token "/"]

24+ let pntr2 = JP.Pointer [JP.Token "/"]

2725 -- When we do this we don't have to escape / or ~ characters

2826 -- (as ~1 and ~0 respectively) like we do in an escaped JSON

2927 -- Pointer string.

30− unless (P.unescape "/~1" == Right pntr2) (error "ohno!")

28+ unless (JP.unescape "/~1" == Right pntr2) (error "ohno!")

3129

32− print (P.resolve pntr1 document)

33− print (P.resolve pntr2 document)

30+ print (JP.resolve pntr1 document)

31+ print (JP.resolve pntr2 document)

3432

3533 where

3634 document :: Value

changelog.md+44

@@ -1,3 +1,47 @@

1+# 1.5.0

3++ Drop QuickCheck dependency (thanks @mmhat !).

5+# 1.4.0

7++ Enable GHC 8.4 (thanks @4e6 !).

8++ Drop GHC 7.10.

10+# 1.3.0

11+

12++ Test with GHC 8.2. Drop GHC 7.8.

13+

14+# 1.2.0

15+

16++ Track upper bounds in a Hackage revision instead of source code.

17+

18+# 1.1.1

19+

20++ Bump aeson.

21+

22+# 1.1.0.2

23+

24++ Raise test dep upper bounds.

25+

26+# 1.1.0.1

27+

28++ Bump `vector`.

29+

30+# 1.1.0.0

31+

32++ Rename the module to `JSONPointer`.

33++ Bump aeson.

34++ Derive `Semigroup` for `Pointer`.

35++ Reorganize code.

36+

37+# 1.0.0.2

38+

39++ Bump hspec.

40+

41+# 1.0.0.1

42+

43++ Remove HUnit dep.

44+

145# 1.0.0.0

246

347+ Bump aeson.

hjsonpointer.cabal+15−22

@@ -1,5 +1,5 @@

11name: hjsonpointer

2−version: 1.0.0.0

2+version: 1.5.0

33synopsis: JSON Pointer library

44homepage: https://github.com/seagreen/hjsonpointer

55license: MIT

@@ -9,7 +9,8 @@ maintainer: ian@housejeffries.com

99category: Data

1010build-type: Simple

1111cabal-version: >=1.10

12−tested-with: GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.1

12+-- Rerun multi-ghc-travis (executable make-travis-yml-2) after changing:

13+Tested-With: GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.1

1314extra-source-files:

1415 changelog.md

1516 README.md

@@ -18,46 +19,38 @@ library

1819 hs-source-dirs:

1920 src

2021 default-language: Haskell2010

21− default-extensions:

22− OverloadedStrings

23− other-extensions:

24− GeneralizedNewtypeDeriving

2522 ghc-options:

2623 -Wall

2724 exposed-modules:

28− Data.Aeson.Pointer

25+ JSONPointer

2926 build-depends:

30− aeson >= 0.7 && < 1.1

31− , base >= 4.6 && < 4.10

32− , QuickCheck >= 2.8 && < 2.10

33− , unordered-containers >= 0.2 && < 0.3

34− , text >= 1.2 && < 1.3

35− , vector >= 0.10 && < 0.12

27+ base >= 4.9 && < 5

28+ , aeson >= 0.7

29+ , hashable >= 1.2

30+ , unordered-containers >= 0.2

31+ , text >= 1.2

32+ , vector >= 0.10

3633

3734test-suite unit

3835 hs-source-dirs:

3936 test

4037 ./

38+ main-is: Unit.hs

4139 default-language: Haskell2010

40+ type: exitcode-stdio-1.0

4241 default-extensions:

4342 OverloadedStrings

4443 ghc-options:

4544 -Wall

46− type: exitcode-stdio-1.0

47− main-is: Unit.hs

45+ -fno-warn-orphans

4846 other-modules: Example

4947 build-depends:

5048 aeson

5149 , base

5250 , hjsonpointer

51+ , hspec >= 2.2

52+ , http-types >= 0.8

5353 , QuickCheck

5454 , unordered-containers

5555 , text

5656 , vector

57− , hspec >= 2.2 && < 2.3

58− , http-types >= 0.8 && < 0.10

59− , HUnit >= 1.2 && < 1.4

60−

61−source-repository head

62− type: git

63− location: git://github.com/seagreen/hjsonpointer.git

shell.nixnew file+9

@@ -0,0 +1,9 @@

1+{ghc}:

2+with (import <nixpkgs> {});

4+haskell.lib.buildStackProject {

5+ name = "none";

6+ inherit ghc;

7+ buildInputs = [

8+ ];

9+}

src/Data/Aeson/Pointer.hs → src/JSONPointer.hsrenamed+76−31

@@ -1,24 +1,44 @@

1+{-# LANGUAGE DeriveGeneric #-}

12{-# LANGUAGE GeneralizedNewtypeDeriving #-}

3+{-# LANGUAGE OverloadedStrings #-}

3−module Data.Aeson.Pointer where

5+module JSONPointer where

57import Control.Monad (when)

68import Data.Aeson

7−import qualified Data.HashMap.Strict as H

9+import qualified Data.Hashable as HA

10+import qualified Data.HashMap.Strict as HM

11+import Data.Semigroup (Semigroup)

812import Data.Text (Text)

913import qualified Data.Text as T

1014import qualified Data.Vector as V

11−import Test.QuickCheck

15+import GHC.Generics (Generic)

1216import Text.Read (readMaybe)

1317

14−-- For GHCs before 7.10:

15−import Control.Applicative

16−import Data.Monoid

17−import Data.Traversable

18+--------------------------------------------------

19+-- * Resolution

20+--------------------------------------------------

21+

22+data ResolutionError

23+ = ObjectLookupFailed

24+ | ArrayIndexInvalid

25+ | ArrayElemNotFound

26+ | ExpectedObjectOrArray

27+ deriving (Eq, Show)

28+

29+resolve :: Pointer -> Value -> Either ResolutionError Value

30+resolve (Pointer []) v = Right v

31+resolve (Pointer (t:ts)) v = resolveToken t v >>= resolve (Pointer ts)

32+

33+--------------------------------------------------

34+-- * Main types and escaping

35+--------------------------------------------------

1836

1937newtype Pointer

2038 = Pointer { _unPointer :: [Token] }

21− deriving (Eq, Show, Monoid, Arbitrary)

39+ deriving (Eq, Show, Semigroup, Monoid, Generic)

40+

41+instance HA.Hashable Pointer

2242

2343instance FromJSON Pointer where

2444 parseJSON = withText "JSON Pointer" $ \t ->

@@ -32,13 +52,19 @@ instance ToJSON Pointer where

3252-- | We don't try to distinguish between integer tokens and string

3353-- tokens since all tokens start as strings, and all tokens can

3454-- be used to resolve JSON objects.

55+--

56+-- Since these are unescaped you can write @"/"@ and @"~"@ normally.

57+-- (e.g. if you're referencing a key such as @"abc/123"@, go ahead

58+-- and write that exactly.

3559newtype Token

3660 = Token { _unToken :: Text }

37− deriving (Eq, Show)

61+ deriving (Eq, Show, Generic)

3862

39−instance Arbitrary Token where

40− arbitrary = Token . T.pack <$> arbitrary

63+instance HA.Hashable Token

4164

65+-- | This escapes @"/"@ (because it's the token separator character).

66+--

67+-- It also escapes @"~"@ (because it's the escape character).

4268escape :: Pointer -> Text

4369escape (Pointer []) = ""

4470escape (Pointer ts) =

@@ -47,15 +73,12 @@ escape (Pointer ts) =

4773 . fmap (T.replace "/" "~1" . T.replace "~" "~0" . _unToken)

4874 $ ts

4975

50−-- * Unescaping

51−

5276data FormatError

5377 = InvalidFirstChar

5478 -- ^ JSON Pointers must either be empty or start with a @/@.

5579 | UnescapedTilde

5680 deriving (Eq, Show)

5781

58−

5982-- | JSON Pointers must either be empty or start with a @/@. This means

6083-- that if you're turning a URI Fragment into a JSON Pointer you must

6184-- drop the initial @#@.

@@ -77,7 +100,40 @@ unescape txt =

77100 Nothing -> Left UnescapedTilde

78101 Just tok -> Right tok

79102

80−-- | For internal use by 'unescape'.

103+--------------------------------------------------

104+-- * Wrapper Types

105+--

106+-- $ These aren't used by the rest of the library

107+-- (as explained in the docs for 'Token').

108+--

109+-- However, they might be useful if you need to distinguish JSON Pointer

110+-- tokens from plain 'Text' or 'Int' without losing information by

111+-- converting to 'Token'.

112+--------------------------------------------------

113+

114+-- | A glorified @type@ alias. If you need to do JSON Pointer operations

115+-- you're looking for 'Token' instead.

116+--

117+-- NOTE: Unlike 'Token' this is escaped.

118+newtype Key

119+ = Key { _unKey :: Text }

120+ deriving (Eq, Show, Generic)

121+

122+instance HA.Hashable Key

123+

124+-- | A glorified @type@ alias. If you need to do JSON Pointer operations

125+-- you're looking for 'Token' instead.

126+newtype Index

127+ = Index { _unIndex :: Int }

128+ deriving (Eq, Show, Generic)

129+

130+instance HA.Hashable Index

131+

132+--------------------------------------------------

133+-- * Internals

134+--------------------------------------------------

135+

136+-- | For internal use (by 'unescape').

81137unescapeToken :: Text -> Maybe Token

82138unescapeToken t

83139 | not (isValid t) = Nothing

@@ -93,21 +149,10 @@ unescapeToken t

93149 replace :: Text -> Text

94150 replace = T.replace "~0" "~" . T.replace "~1" "/"

95151

96−-- * Resolution

97−

98−data ResolutionError

99− = ObjectLookupFailed

100− | ArrayIndexInvalid

101− | ArrayElemNotFound

102− | ExpectedObjectOrArray

103− deriving (Eq, Show)

104−

105−resolve :: Pointer -> Value -> Either ResolutionError Value

106−resolve (Pointer []) v = Right v

107−resolve (Pointer (t:ts)) v = resolveToken t v >>= resolve (Pointer ts)

108−

109−-- | For internal use (or specialized applications that don't want to

110−-- resolve an entire pointer at once).

152+-- | For internal use (by 'resolve').

153+--

154+-- Might also be useful for specialized applications that don't

155+-- want to resolve an entire pointer at once.

111156resolveToken :: Token -> Value -> Either ResolutionError Value

112157resolveToken tok (Array vs) =

113158 case readMaybe . T.unpack . _unToken $ tok of

@@ -118,7 +163,7 @@ resolveToken tok (Array vs) =

118163 Nothing -> Left ArrayElemNotFound

119164 Just res -> Right res

120165resolveToken tok (Object h) =

121− case H.lookup (_unToken tok) h of

166+ case HM.lookup (_unToken tok) h of

122167 Nothing -> Left ObjectLookupFailed

123168 Just res -> Right res

124169resolveToken _ _ = Left ExpectedObjectOrArray

stack.yamlnew file+2

@@ -0,0 +1,2 @@

1+resolver: lts-12.10

2+pvp-bounds: upper-revision

test/Unit.hs+23−24

@@ -1,26 +1,28 @@

1+{-# LANGUAGE GeneralizedNewtypeDeriving #-}

2+{-# LANGUAGE StandaloneDeriving #-}

24module Main where

4−import Control.Arrow

56import Data.Aeson

6−import qualified Data.Aeson.Pointer as P

7−import Data.Text (Text)

8−import qualified Data.Text as T

9−import Data.Text.Encoding

10−import qualified Data.Vector as V

11−import Network.HTTP.Types.URI (urlDecode)

7+import Data.Bifunctor (first)

8+import Data.Foldable

9+import Data.Monoid

10+import Data.Text (Text)

11+import qualified Data.Text as T

12+import Data.Text.Encoding (decodeUtf8, encodeUtf8)

13+import qualified Data.Vector as V

14+import qualified JSONPointer as JP

15+import Network.HTTP.Types.URI (urlDecode)

1216

1317import Test.Hspec

14−import Test.QuickCheck (property)

18+import Test.QuickCheck (Arbitrary(..), property)

1519

16−import Test.HUnit hiding (Test)

20+import qualified Example

1721

18−-- For GHCs before 7.10:

19−import Control.Applicative

20−import Data.Foldable

21−import Data.Monoid

22+deriving instance Arbitrary JP.Pointer

2223

23−import qualified Example

24+instance Arbitrary JP.Token where

25+ arbitrary = JP.Token . T.pack <$> arbitrary

2426

2527main :: IO ()

2628main = hspec $ do

@@ -31,10 +33,10 @@ main = hspec $ do

3133 it "can be represented in a JSON string value" jsonString

3234 it "can be represented in a URI fragment identifier" uriFragment

3335

34−roundtrip :: P.Pointer -> Bool

36+roundtrip :: JP.Pointer -> Bool

3537roundtrip a = Just a == decode (encode a)

3638

37−jsonString :: Assertion

39+jsonString :: Expectation

3840jsonString = traverse_ resolvesTo

3941 [ ("" , specExample)

4042 , ("/foo" , Array $ V.fromList ["bar", "baz"])

@@ -50,7 +52,7 @@ jsonString = traverse_ resolvesTo

5052 , ("/m~0n" , Number 8)

5153 ]

5254

53−uriFragment :: Assertion

55+uriFragment :: Expectation

5456uriFragment = traverse_ resolvesTo . fmap (first decodeFragment) $

5557 [ ("#" , specExample)

5658 , ("#/foo" , Array $ V.fromList ["bar", "baz"])

@@ -69,14 +71,11 @@ uriFragment = traverse_ resolvesTo . fmap (first decodeFragment) $

6971 decodeFragment :: Text -> Text

7072 decodeFragment = T.drop 1 . decodeUtf8 . urlDecode True . encodeUtf8

7173

72−resolvesTo :: (Text, Value) -> Assertion

74+resolvesTo :: (Text, Value) -> Expectation

7375resolvesTo (t, expected) =

74− case P.unescape t of

75− Left e -> assertFailure (show e <> " error for pointer: " <> show t)

76− Right p -> assertEqual

77− ("Resolved value for pointer: " <> show t)

78− (Right expected)

79− (P.resolve p specExample)

76+ case JP.unescape t of

77+ Left e -> expectationFailure (show e <> " error for pointer: " <> show t)

78+ Right p -> JP.resolve p specExample `shouldBe` Right expected

8079

8180specExample :: Value

8281specExample = object