930c14a...master · typeable/hjsonpointer

git.iko.soy/typeable/hjsonpointer

10 files changed+304−180

since splitsnapshots

unifiedsplit

.travis.yml+79−59 Example.hs+7−8 MIT-LICENSE.txt+1−1 README.md+7−9 changelog.md+48 hjsonpointer.cabal+52−48 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+48

@@ -1,3 +1,51 @@

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+

45+# 1.0.0.0

46+

47++ Bump aeson.

48+

149# 0.3.0.2

250

351+ Switch to hspec for tests.

hjsonpointer.cabal+52−48

@@ -1,52 +1,56 @@

1−name: hjsonpointer

2−version: 0.3.0.2

3−synopsis: JSON Pointer library

4−homepage: https://github.com/seagreen/hjsonpointer

5−license: MIT

6−license-file: MIT-LICENSE.txt

7−author: Ian Grant Jeffries

8−maintainer: ian@housejeffries.com

9−category: Data

10−build-type: Simple

11−cabal-version: >=1.10

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

13−extra-source-files: changelog.md

14− README.md

1+name: hjsonpointer

2+version: 1.5.0

3+synopsis: JSON Pointer library

4+homepage: https://github.com/seagreen/hjsonpointer

5+license: MIT

6+license-file: MIT-LICENSE.txt

7+author: Ian Grant Jeffries

8+maintainer: ian@housejeffries.com

9+category: Data

10+build-type: Simple

11+cabal-version: >=1.10

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

14+extra-source-files:

15+ changelog.md

16+ README.md

1517

1618library

17− hs-source-dirs: src

18− exposed-modules: Data.Aeson.Pointer

19− default-language: Haskell2010

20− default-extensions: OverloadedStrings

21− other-extensions: GeneralizedNewtypeDeriving

22− ghc-options: -Wall

23− build-depends: aeson >= 0.7 && < 0.12

24− , base >= 4.6 && < 4.10

25− , QuickCheck >= 2.8 && < 2.10

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

27− , text >= 1.2 && < 1.3

28− , vector >= 0.10 && < 0.12

19+ hs-source-dirs:

20+ src

21+ default-language: Haskell2010

22+ ghc-options:

23+ -Wall

24+ exposed-modules:

25+ JSONPointer

26+ build-depends:

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

2933

3034test-suite unit

31− type: exitcode-stdio-1.0

32− hs-source-dirs: test

33− ./

34− main-is: Unit.hs

35− other-modules: Example

36− default-language: Haskell2010

37− ghc-options: -Wall

38− default-extensions: OverloadedStrings

39− build-depends: aeson

40− , base

41− , hjsonpointer

42− , QuickCheck

43− , unordered-containers

44− , text

45− , vector

46− , hspec >= 2.2 && < 2.3

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

48− , HUnit >= 1.2 && < 1.4

49−

50−source-repository head

51− type: git

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

35+ hs-source-dirs:

36+ test

37+ ./

38+ main-is: Unit.hs

39+ default-language: Haskell2010

40+ type: exitcode-stdio-1.0

41+ default-extensions:

42+ OverloadedStrings

43+ ghc-options:

44+ -Wall

45+ -fno-warn-orphans

46+ other-modules: Example

47+ build-depends:

48+ aeson

49+ , base

50+ , hjsonpointer

51+ , hspec >= 2.2

52+ , http-types >= 0.8

53+ , QuickCheck

54+ , unordered-containers

55+ , text

56+ , vector

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