git.iko.soy/typeable/hjsonpointer
on master help sign in
1.1.0.0.
e9b9827Ian Grant Jeffries
Example.hs+7−8
compare with master
unifiedsplit
@@ -1,27 +1,26 @@
1−{-# LANGUAGE OverloadedStrings #-}
2
1
3module Example where
2module Example where
4
3
5−import Control.Monad (unless)
4+import Control.Monad (unless)
6import Data.Aeson
5import Data.Aeson
7−import qualified Data.Aeson.Pointer as P
6+import qualified JSONPointer as JP
8
7
9main :: IO ()
8main :: IO ()
10main = do
9main = do
11 -- JSON Pointers must either be empty or start with a /.
10 -- 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
13 Left _ -> error "Failed to construct JSON Pointer."
12 Left _ -> error "Failed to construct JSON Pointer."
14 Right pntr -> return pntr
13 Right pntr -> return pntr
15
14
16 -- We can also write JSON Pointers in Haskell.
15 -- We can also write JSON Pointers in Haskell.
17− let pntr2 = P.Pointer [P.Token "/"]
16+ let pntr2 = JP.Pointer [JP.Token "/"]
18 -- When we do this we don't have to escape / or ~ characters
17 -- When we do this we don't have to escape / or ~ characters
19 -- (as ~1 and ~0 respectively) like we do in an escaped JSON
18 -- (as ~1 and ~0 respectively) like we do in an escaped JSON
20 -- Pointer string.
19 -- Pointer string.
21− unless (P.unescape "/~1" == Right pntr2) (error "ohno!")
20+ unless (JP.unescape "/~1" == Right pntr2) (error "ohno!")
22
21
23− print (P.resolve pntr1 document)
22+ print (JP.resolve pntr1 document)
24− print (P.resolve pntr2 document)
23+ print (JP.resolve pntr2 document)
25
24
26 where
25 where
27 document :: Value
26 document :: Value
README.md+7−9
@@ -7,30 +7,28 @@
7# Example
7# Example
8
8
9```haskell
9```haskell
10−{-# LANGUAGE OverloadedStrings #-}
11−
12module Example where
10module Example where
13
11
14−import Control.Monad (unless)
12+import Control.Monad (unless)
15import Data.Aeson
13import Data.Aeson
16−import qualified Data.Aeson.Pointer as P
14+import qualified JSONPointer as JP
17
15
18main :: IO ()
16main :: IO ()
19main = do
17main = do
20 -- JSON Pointers must either be empty or start with a /.
18 -- 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
22 Left _ -> error "Failed to construct JSON Pointer."
20 Left _ -> error "Failed to construct JSON Pointer."
23 Right pntr -> return pntr
21 Right pntr -> return pntr
24
22
25 -- We can also write JSON Pointers in Haskell.
23 -- We can also write JSON Pointers in Haskell.
26− let pntr2 = P.Pointer [P.Token "/"]
24+ let pntr2 = JP.Pointer [JP.Token "/"]
27 -- When we do this we don't have to escape / or ~ characters
25 -- When we do this we don't have to escape / or ~ characters
28 -- (as ~1 and ~0 respectively) like we do in an escaped JSON
26 -- (as ~1 and ~0 respectively) like we do in an escaped JSON
29 -- Pointer string.
27 -- Pointer string.
30− unless (P.unescape "/~1" == Right pntr2) (error "ohno!")
28+ unless (JP.unescape "/~1" == Right pntr2) (error "ohno!")
31
29
32− print (P.resolve pntr1 document)
30+ print (JP.resolve pntr1 document)
33− print (P.resolve pntr2 document)
31+ print (JP.resolve pntr2 document)
34
32
35 where
33 where
36 document :: Value
34 document :: Value
changelog.md+7
@@ -1,3 +1,10 @@
1+# 1.1.0.0
2+
3++ Rename the module to `JSONPointer`.
4++ Bump aeson.
5++ Derive `Semigroup` for `Pointer`.
6++ Reorganize code.
7+
1# 1.0.0.2
8# 1.0.0.2
2
9
3+ Bump hspec.
10+ Bump hspec.
hjsonpointer.cabal+9−10
@@ -1,5 +1,5 @@
1name: hjsonpointer
1name: hjsonpointer
2−version: 1.0.0.2
2+version: 1.1.0.0
3synopsis: JSON Pointer library
3synopsis: JSON Pointer library
4homepage: https://github.com/seagreen/hjsonpointer
4homepage: https://github.com/seagreen/hjsonpointer
5license: MIT
5license: MIT
@@ -17,19 +17,18 @@ library
17 hs-source-dirs:
17 hs-source-dirs:
18 src
18 src
19 default-language: Haskell2010
19 default-language: Haskell2010
20− default-extensions:
21− OverloadedStrings
22− other-extensions:
23− GeneralizedNewtypeDeriving
24 ghc-options:
20 ghc-options:
25 -Wall
21 -Wall
26 exposed-modules:
22 exposed-modules:
27− Data.Aeson.Pointer
23+ JSONPointer
28 build-depends:
24 build-depends:
25+ base >= 4.6 && < 4.10
29− aeson >= 0.7 && < 1.1
26+ , aeson >= 0.7 && < 1.2
30− , base >= 4.6 && < 4.10
27+ , hashable >= 1.2 && < 1.3
31 , QuickCheck >= 2.8 && < 2.10
28 , QuickCheck >= 2.8 && < 2.10
32 , unordered-containers >= 0.2 && < 0.3
29 , unordered-containers >= 0.2 && < 0.3
30+ , semigroups >= 0.18 && < 1.0
31+ -- ^ for GHCs < 8
33 , text >= 1.2 && < 1.3
32 , text >= 1.2 && < 1.3
34 , vector >= 0.10 && < 0.12
33 , vector >= 0.10 && < 0.12
35
34
@@ -49,12 +48,12 @@ test-suite unit
49 aeson
48 aeson
50 , base
49 , base
51 , hjsonpointer
50 , hjsonpointer
51+ , hspec >= 2.2 && < 2.4
52+ , http-types >= 0.8 && < 0.10
52 , QuickCheck
53 , QuickCheck
53 , unordered-containers
54 , unordered-containers
54 , text
55 , text
55 , vector
56 , vector
56− , hspec >= 2.2 && < 2.4
57− , http-types >= 0.8 && < 0.10
58
57
59source-repository head
58source-repository head
60 type: git
59 type: git
src/Data/Aeson/Pointer.hs → src/JSONPointer.hsrenamed+78−24
@@ -1,13 +1,18 @@
1+{-# LANGUAGE DeriveGeneric #-}
1{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2{-# LANGUAGE GeneralizedNewtypeDeriving #-}
3+{-# LANGUAGE OverloadedStrings #-}
2
4
3−module Data.Aeson.Pointer where
5+module JSONPointer where
4
6
5import Control.Monad (when)
7import Control.Monad (when)
6import Data.Aeson
8import 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)
8import Data.Text (Text)
12import Data.Text (Text)
9import qualified Data.Text as T
13import qualified Data.Text as T
10import qualified Data.Vector as V
14import qualified Data.Vector as V
15+import GHC.Generics (Generic)
11import Test.QuickCheck
16import Test.QuickCheck
12import Text.Read (readMaybe)
17import Text.Read (readMaybe)
13
18
@@ -16,9 +21,30 @@ import Control.Applicative
16import Data.Monoid
21import Data.Monoid
17import Data.Traversable
22import Data.Traversable
18
23
24+--------------------------------------------------
25+-- * Resolution
26+--------------------------------------------------
27+
28+data ResolutionError
29+ = ObjectLookupFailed
30+ | ArrayIndexInvalid
31+ | ArrayElemNotFound
32+ | ExpectedObjectOrArray
33+ deriving (Eq, Show)
34+
35+resolve :: Pointer -> Value -> Either ResolutionError Value
36+resolve (Pointer []) v = Right v
37+resolve (Pointer (t:ts)) v = resolveToken t v >>= resolve (Pointer ts)
38+
39+--------------------------------------------------
40+-- * Main types and escaping
41+--------------------------------------------------
42+
19newtype Pointer
43newtype Pointer
20 = Pointer { _unPointer :: [Token] }
44 = Pointer { _unPointer :: [Token] }
21− deriving (Eq, Show, Monoid, Arbitrary)
45+ deriving (Eq, Show, Semigroup, Monoid, Generic, Arbitrary)
46+
47+instance HA.Hashable Pointer
22
48
23instance FromJSON Pointer where
49instance FromJSON Pointer where
24 parseJSON = withText "JSON Pointer" $ \t ->
50 parseJSON = withText "JSON Pointer" $ \t ->
@@ -32,13 +58,22 @@ instance ToJSON Pointer where
32-- | We don't try to distinguish between integer tokens and string
58-- | We don't try to distinguish between integer tokens and string
33-- tokens since all tokens start as strings, and all tokens can
59-- tokens since all tokens start as strings, and all tokens can
34-- be used to resolve JSON objects.
60-- be used to resolve JSON objects.
61+--
62+-- Since these are unescaped you can write @"/"@ and @"~"@ normally.
63+-- (e.g. if you're referencing a key such as @"abc/123"@, go ahead
64+-- and write that exactly.
35newtype Token
65newtype Token
36 = Token { _unToken :: Text }
66 = Token { _unToken :: Text }
37− deriving (Eq, Show)
67+ deriving (Eq, Show, Generic)
68+
69+instance HA.Hashable Token
38
70
39instance Arbitrary Token where
71instance Arbitrary Token where
40 arbitrary = Token . T.pack <$> arbitrary
72 arbitrary = Token . T.pack <$> arbitrary
41
73
74+-- | This escapes @"/"@ (because it's the token separator character).
75+--
76+-- It also escapes @"~"@ (because it's the escape character).
42escape :: Pointer -> Text
77escape :: Pointer -> Text
43escape (Pointer []) = ""
78escape (Pointer []) = ""
44escape (Pointer ts) =
79escape (Pointer ts) =
@@ -47,15 +82,12 @@ escape (Pointer ts) =
47 . fmap (T.replace "/" "~1" . T.replace "~" "~0" . _unToken)
82 . fmap (T.replace "/" "~1" . T.replace "~" "~0" . _unToken)
48 $ ts
83 $ ts
49
84
50−-- * Unescaping
51−
52data FormatError
85data FormatError
53 = InvalidFirstChar
86 = InvalidFirstChar
54 -- ^ JSON Pointers must either be empty or start with a @/@.
87 -- ^ JSON Pointers must either be empty or start with a @/@.
55 | UnescapedTilde
88 | UnescapedTilde
56 deriving (Eq, Show)
89 deriving (Eq, Show)
57
90
58−
59-- | JSON Pointers must either be empty or start with a @/@. This means
91-- | JSON Pointers must either be empty or start with a @/@. This means
60-- that if you're turning a URI Fragment into a JSON Pointer you must
92-- that if you're turning a URI Fragment into a JSON Pointer you must
61-- drop the initial @#@.
93-- drop the initial @#@.
@@ -77,7 +109,40 @@ unescape txt =
77 Nothing -> Left UnescapedTilde
109 Nothing -> Left UnescapedTilde
78 Just tok -> Right tok
110 Just tok -> Right tok
79
111
112+--------------------------------------------------
113+-- * Wrapper Types
114+--
115+-- These aren't used by the rest of the library
116+-- (as explained in the docs for 'Token').
117+--
118+-- However, they might be useful if you need to distinguish JSON Pointer
119+-- tokens from plain 'Text' or 'Int' without losing information by
120+-- converting to 'Token'.
121+--------------------------------------------------
122+
123+-- | A glorified @type@ alias. If you need to do JSON Pointer operations
124+-- you're looking for 'Token' instead.
125+--
126+-- NOTE: Unlike 'Token' this is escaped.
127+newtype Key
128+ = Key { _unKey :: Text }
129+ deriving (Eq, Show, Generic)
130+
131+instance HA.Hashable Key
132+
133+-- | A glorified @type@ alias. If you need to do JSON Pointer operations
134+-- you're looking for 'Token' instead.
135+newtype Index
136+ = Index { _unIndex :: Int }
137+ deriving (Eq, Show, Generic)
138+
139+instance HA.Hashable Index
140+
141+--------------------------------------------------
142+-- * Internals
143+--------------------------------------------------
144+
80−-- | For internal use by 'unescape'.
145+-- | For internal use (by 'unescape').
81unescapeToken :: Text -> Maybe Token
146unescapeToken :: Text -> Maybe Token
82unescapeToken t
147unescapeToken t
83 | not (isValid t) = Nothing
148 | not (isValid t) = Nothing
@@ -93,21 +158,10 @@ unescapeToken t
93 replace :: Text -> Text
158 replace :: Text -> Text
94 replace = T.replace "~0" "~" . T.replace "~1" "/"
159 replace = T.replace "~0" "~" . T.replace "~1" "/"
95
160
96−-- * Resolution
161+-- | For internal use (by 'resolve').
97−
162+--
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
163+-- Might also be useful for specialized applications that don't
110−-- resolve an entire pointer at once).
164+-- want to resolve an entire pointer at once.
111resolveToken :: Token -> Value -> Either ResolutionError Value
165resolveToken :: Token -> Value -> Either ResolutionError Value
112resolveToken tok (Array vs) =
166resolveToken tok (Array vs) =
113 case readMaybe . T.unpack . _unToken $ tok of
167 case readMaybe . T.unpack . _unToken $ tok of
@@ -118,7 +172,7 @@ resolveToken tok (Array vs) =
118 Nothing -> Left ArrayElemNotFound
172 Nothing -> Left ArrayElemNotFound
119 Just res -> Right res
173 Just res -> Right res
120resolveToken tok (Object h) =
174resolveToken tok (Object h) =
121− case H.lookup (_unToken tok) h of
175+ case HM.lookup (_unToken tok) h of
122 Nothing -> Left ObjectLookupFailed
176 Nothing -> Left ObjectLookupFailed
123 Just res -> Right res
177 Just res -> Right res
124resolveToken _ _ = Left ExpectedObjectOrArray
178resolveToken _ _ = Left ExpectedObjectOrArray
test/Unit.hs+9−9
@@ -3,15 +3,15 @@ module Main where
3
3
4import Control.Arrow
4import Control.Arrow
5import Data.Aeson
5import Data.Aeson
6−import qualified Data.Aeson.Pointer as P
7−import Data.Text (Text)
6+import Data.Text (Text)
8−import qualified Data.Text as T
7+import qualified Data.Text as T
9import Data.Text.Encoding
8import Data.Text.Encoding
10−import qualified Data.Vector as V
9+import qualified Data.Vector as V
10+import qualified JSONPointer as JP
11−import Network.HTTP.Types.URI (urlDecode)
11+import Network.HTTP.Types.URI (urlDecode)
12
12
13import Test.Hspec
13import Test.Hspec
14−import Test.QuickCheck (property)
14+import Test.QuickCheck (property)
15
15
16-- For GHCs before 7.10:
16-- For GHCs before 7.10:
17import Control.Applicative
17import Control.Applicative
@@ -29,7 +29,7 @@ main = hspec $ do
29 it "can be represented in a JSON string value" jsonString
29 it "can be represented in a JSON string value" jsonString
30 it "can be represented in a URI fragment identifier" uriFragment
30 it "can be represented in a URI fragment identifier" uriFragment
31
31
32−roundtrip :: P.Pointer -> Bool
32+roundtrip :: JP.Pointer -> Bool
33roundtrip a = Just a == decode (encode a)
33roundtrip a = Just a == decode (encode a)
34
34
35jsonString :: Expectation
35jsonString :: Expectation
@@ -69,9 +69,9 @@ uriFragment = traverse_ resolvesTo . fmap (first decodeFragment) $
69
69
70resolvesTo :: (Text, Value) -> Expectation
70resolvesTo :: (Text, Value) -> Expectation
71resolvesTo (t, expected) =
71resolvesTo (t, expected) =
72− case P.unescape t of
72+ case JP.unescape t of
73 Left e -> expectationFailure (show e <> " error for pointer: " <> show t)
73 Left e -> expectationFailure (show e <> " error for pointer: " <> show t)
74− Right p -> P.resolve p specExample `shouldBe` Right expected
74+ Right p -> JP.resolve p specExample `shouldBe` Right expected
75
75
76specExample :: Value
76specExample :: Value
77specExample = object
77specExample = object