git.iko.soy/typeable/hjsonpointer
on master help sign in
Switch to 4 space indentation.
930c14aIan Grant Jeffries
Example.hs+12−12
compare with master
unifiedsplit
@@ -8,20 +8,20 @@ import qualified Data.Aeson.Pointer as P
8
8
9main :: IO ()
9main :: IO ()
10main = do
10main = do
11− -- JSON Pointers must either be empty or start with a /.
11+ -- JSON Pointers must either be empty or start with a /.
12− pntr1 <- case P.unescape "/foo/0" of
12+ pntr1 <- case P.unescape "/foo/0" of
13− Left _ -> error "Failed to construct JSON Pointer."
13+ Left _ -> error "Failed to construct JSON Pointer."
14− Right pntr -> return pntr
14+ Right pntr -> return pntr
15
15
16− -- We can also write JSON Pointers in Haskell.
16+ -- We can also write JSON Pointers in Haskell.
17− let pntr2 = P.Pointer [P.Token "/"]
17+ let pntr2 = P.Pointer [P.Token "/"]
18− -- When we do this we don't have to escape / or ~ characters
18+ -- 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
19+ -- (as ~1 and ~0 respectively) like we do in an escaped JSON
20− -- Pointer string.
20+ -- Pointer string.
21− unless (P.unescape "/~1" == Right pntr2) (error "ohno!")
21+ unless (P.unescape "/~1" == Right pntr2) (error "ohno!")
22
22
23− print (P.resolve pntr1 document)
23+ print (P.resolve pntr1 document)
24− print (P.resolve pntr2 document)
24+ print (P.resolve pntr2 document)
25
25
26 where
26 where
27 document :: Value
27 document :: Value
README.md+15−15
@@ -9,7 +9,7 @@
9```haskell
9```haskell
10{-# LANGUAGE OverloadedStrings #-}
10{-# LANGUAGE OverloadedStrings #-}
11
11
12−module Main where
12+module Example where
13
13
14import Control.Monad (unless)
14import Control.Monad (unless)
15import Data.Aeson
15import Data.Aeson
@@ -17,20 +17,20 @@ import qualified Data.Aeson.Pointer as P
17
17
18main :: IO ()
18main :: IO ()
19main = do
19main = do
20− -- JSON Pointers must either be empty or start with a /.
20+ -- JSON Pointers must either be empty or start with a /.
21− pntr1 <- case P.unescape "/foo/0" of
21+ pntr1 <- case P.unescape "/foo/0" of
22− Left _ -> error "Failed to construct JSON Pointer."
22+ Left _ -> error "Failed to construct JSON Pointer."
23− Right pntr -> pure pntr
23+ Right pntr -> return pntr
24−
24+
25− -- We can also write JSON Pointers in Haskell.
25+ -- We can also write JSON Pointers in Haskell.
26− let pntr2 = P.Pointer [P.Token "/"]
26+ let pntr2 = P.Pointer [P.Token "/"]
27− -- When we do this we don't have to escape / or ~ characters
27+ -- 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
28+ -- (as ~1 and ~0 respectively) like we do in an escaped JSON
29− -- Pointer string.
29+ -- Pointer string.
30− unless (P.unescape "/~1" == Right pntr2) (error "ohno!")
30+ unless (P.unescape "/~1" == Right pntr2) (error "ohno!")
31−
31+
32− print (P.resolve pntr1 document)
32+ print (P.resolve pntr1 document)
33− print (P.resolve pntr2 document)
33+ print (P.resolve pntr2 document)
34
34
35 where
35 where
36 document :: Value
36 document :: Value
src/Data/Aeson/Pointer.hs+42−40
@@ -17,41 +17,43 @@ import Data.Monoid
17import Data.Traversable
17import Data.Traversable
18
18
19newtype Pointer
19newtype Pointer
20− = Pointer { _unPointer :: [Token] }
20+ = Pointer { _unPointer :: [Token] }
21− deriving (Eq, Show, Monoid, Arbitrary)
21+ deriving (Eq, Show, Monoid, Arbitrary)
22
22
23instance FromJSON Pointer where
23instance FromJSON Pointer where
24− parseJSON = withText "JSON Pointer" $ \t ->
24+ parseJSON = withText "JSON Pointer" $ \t ->
25− case unescape t of
25+ case unescape t of
26− Left e -> fail (show e)
26+ Left e -> fail (show e)
27− Right p -> pure p
27+ Right p -> pure p
28
28
29instance ToJSON Pointer where
29instance ToJSON Pointer where
30− toJSON = String . escape
30+ toJSON = String . escape
31
31
32-- | We don't try to distinguish between integer tokens and string
32-- | We don't try to distinguish between integer tokens and string
33-- tokens since all tokens start as strings, and all tokens can
33-- tokens since all tokens start as strings, and all tokens can
34-- be used to resolve JSON objects.
34-- be used to resolve JSON objects.
35+newtype Token
35−newtype Token = Token { _unToken :: Text } deriving (Eq, Show)
36+ = Token { _unToken :: Text }
37+ deriving (Eq, Show)
36
38
37instance Arbitrary Token where
39instance Arbitrary Token where
38− arbitrary = Token . T.pack <$> arbitrary
40+ arbitrary = Token . T.pack <$> arbitrary
39
41
40escape :: Pointer -> Text
42escape :: Pointer -> Text
41escape (Pointer []) = ""
43escape (Pointer []) = ""
42escape (Pointer ts) =
44escape (Pointer ts) =
43− T.cons '/'
45+ T.cons '/'
44− . T.intercalate "/"
46+ . T.intercalate "/"
45− . fmap (T.replace "/" "~1" . T.replace "~" "~0" . _unToken)
47+ . fmap (T.replace "/" "~1" . T.replace "~" "~0" . _unToken)
46− $ ts
48+ $ ts
47
49
48-- * Unescaping
50-- * Unescaping
49
51
50data FormatError
52data FormatError
51− = InvalidFirstChar
53+ = InvalidFirstChar
52− -- ^ JSON Pointers must either be empty or start with a @/@.
54+ -- ^ JSON Pointers must either be empty or start with a @/@.
53− | UnescapedTilde
55+ | UnescapedTilde
54− deriving (Eq, Show)
56+ deriving (Eq, Show)
55
57
56
58
57-- | JSON Pointers must either be empty or start with a @/@. This means
59-- | JSON Pointers must either be empty or start with a @/@. This means
@@ -65,21 +67,21 @@ data FormatError
65-- "Network.HTTP.Types.URI.urlDecode" from http-types.
67-- "Network.HTTP.Types.URI.urlDecode" from http-types.
66unescape :: Text -> Either FormatError Pointer
68unescape :: Text -> Either FormatError Pointer
67unescape txt =
69unescape txt =
68− case T.splitOn "/" txt of
70+ case T.splitOn "/" txt of
69− [] -> Right (Pointer [])
71+ [] -> Right (Pointer [])
70− "":xs -> Pointer <$> traverse f xs
72+ "":xs -> Pointer <$> traverse f xs
71− _ -> Left InvalidFirstChar
73+ _ -> Left InvalidFirstChar
72 where
74 where
73 f :: Text -> Either FormatError Token
75 f :: Text -> Either FormatError Token
74 f t = case unescapeToken t of
76 f t = case unescapeToken t of
75− Nothing -> Left UnescapedTilde
77+ Nothing -> Left UnescapedTilde
76− Just tok -> Right tok
78+ Just tok -> Right tok
77
79
78-- | For internal use by 'unescape'.
80-- | For internal use by 'unescape'.
79unescapeToken :: Text -> Maybe Token
81unescapeToken :: Text -> Maybe Token
80unescapeToken t
82unescapeToken t
81− | not (isValid t) = Nothing
83+ | not (isValid t) = Nothing
82− | otherwise = Just . Token . replace $ t
84+ | otherwise = Just . Token . replace $ t
83 where
85 where
84 -- All tildes must be followed by 0s or 1s.
86 -- All tildes must be followed by 0s or 1s.
85 isValid :: Text -> Bool
87 isValid :: Text -> Bool
@@ -94,11 +96,11 @@ unescapeToken t
94-- * Resolution
96-- * Resolution
95
97
96data ResolutionError
98data ResolutionError
97− = ObjectLookupFailed
99+ = ObjectLookupFailed
98− | ArrayIndexInvalid
100+ | ArrayIndexInvalid
99− | ArrayElemNotFound
101+ | ArrayElemNotFound
100− | ExpectedObjectOrArray
102+ | ExpectedObjectOrArray
101− deriving (Eq, Show)
103+ deriving (Eq, Show)
102
104
103resolve :: Pointer -> Value -> Either ResolutionError Value
105resolve :: Pointer -> Value -> Either ResolutionError Value
104resolve (Pointer []) v = Right v
106resolve (Pointer []) v = Right v
@@ -108,15 +110,15 @@ resolve (Pointer (t:ts)) v = resolveToken t v >>= resolve (Pointer ts)
108-- resolve an entire pointer at once).
110-- resolve an entire pointer at once).
109resolveToken :: Token -> Value -> Either ResolutionError Value
111resolveToken :: Token -> Value -> Either ResolutionError Value
110resolveToken tok (Array vs) =
112resolveToken tok (Array vs) =
111− case readMaybe . T.unpack . _unToken $ tok of
113+ case readMaybe . T.unpack . _unToken $ tok of
112− Nothing -> Left ArrayIndexInvalid
114+ Nothing -> Left ArrayIndexInvalid
113− Just n -> do
115+ Just n -> do
114− when (n < 0) (Left ArrayIndexInvalid)
116+ when (n < 0) (Left ArrayIndexInvalid)
115− case vs V.!? n of
117+ case vs V.!? n of
116− Nothing -> Left ArrayElemNotFound
118+ Nothing -> Left ArrayElemNotFound
117− Just res -> Right res
119+ Just res -> Right res
118resolveToken tok (Object h) =
120resolveToken tok (Object h) =
119− case H.lookup (_unToken tok) h of
121+ case H.lookup (_unToken tok) h of
120− Nothing -> Left ObjectLookupFailed
122+ Nothing -> Left ObjectLookupFailed
121− Just res -> Right res
123+ Just res -> Right res
122resolveToken _ _ = Left ExpectedObjectOrArray
124resolveToken _ _ = Left ExpectedObjectOrArray
test/Unit.hs+49−49
@@ -24,70 +24,70 @@ import qualified Example
24
24
25main :: IO ()
25main :: IO ()
26main = hspec $ do
26main = hspec $ do
27− describe "example" $ do
27+ describe "example" $ do
28− it "compiles and runs without errors" Example.main
28+ it "compiles and runs without errors" Example.main
29− describe "pointers" $ do
29+ describe "pointers" $ do
30− it "can be stored as JSON without changing its value" (property roundtrip)
30+ it "can be stored as JSON without changing its value" (property roundtrip)
31− it "can be represented in a JSON string value" jsonString
31+ it "can be represented in a JSON string value" jsonString
32− it "can be represented in a URI fragment identifier" uriFragment
32+ it "can be represented in a URI fragment identifier" uriFragment
33
33
34roundtrip :: P.Pointer -> Bool
34roundtrip :: P.Pointer -> Bool
35roundtrip a = Just a == decode (encode a)
35roundtrip a = Just a == decode (encode a)
36
36
37jsonString :: Assertion
37jsonString :: Assertion
38jsonString = traverse_ resolvesTo
38jsonString = traverse_ resolvesTo
39− [ ("" , specExample)
39+ [ ("" , specExample)
40− , ("/foo" , Array $ V.fromList ["bar", "baz"])
40+ , ("/foo" , Array $ V.fromList ["bar", "baz"])
41− , ("/foo/0", String "bar")
41+ , ("/foo/0", String "bar")
42− , ("/" , Number 0)
42+ , ("/" , Number 0)
43− , ("/a~1b" , Number 1)
43+ , ("/a~1b" , Number 1)
44− , ("/c%d" , Number 2)
44+ , ("/c%d" , Number 2)
45− , ("/e^f" , Number 3)
45+ , ("/e^f" , Number 3)
46− , ("/g|h" , Number 4)
46+ , ("/g|h" , Number 4)
47− , ("/i\\j" , Number 5)
47+ , ("/i\\j" , Number 5)
48− , ("/k\"l" , Number 6)
48+ , ("/k\"l" , Number 6)
49− , ("/ " , Number 7)
49+ , ("/ " , Number 7)
50− , ("/m~0n" , Number 8)
50+ , ("/m~0n" , Number 8)
51− ]
51+ ]
52
52
53uriFragment :: Assertion
53uriFragment :: Assertion
54uriFragment = traverse_ resolvesTo . fmap (first decodeFragment) $
54uriFragment = traverse_ resolvesTo . fmap (first decodeFragment) $
55− [ ("#" , specExample)
55+ [ ("#" , specExample)
56− , ("#/foo" , Array $ V.fromList ["bar", "baz"])
56+ , ("#/foo" , Array $ V.fromList ["bar", "baz"])
57− , ("#/foo/0", String "bar")
57+ , ("#/foo/0", String "bar")
58− , ("#/" , Number 0)
58+ , ("#/" , Number 0)
59− , ("#/a~1b" , Number 1)
59+ , ("#/a~1b" , Number 1)
60− , ("#/c%25d", Number 2)
60+ , ("#/c%25d", Number 2)
61− , ("#/e%5Ef", Number 3)
61+ , ("#/e%5Ef", Number 3)
62− , ("#/g%7Ch", Number 4)
62+ , ("#/g%7Ch", Number 4)
63− , ("#/i%5Cj", Number 5)
63+ , ("#/i%5Cj", Number 5)
64− , ("#/k%22l", Number 6)
64+ , ("#/k%22l", Number 6)
65− , ("#/%20" , Number 7)
65+ , ("#/%20" , Number 7)
66− , ("#/m~0n" , Number 8)
66+ , ("#/m~0n" , Number 8)
67− ]
67+ ]
68 where
68 where
69 decodeFragment :: Text -> Text
69 decodeFragment :: Text -> Text
70 decodeFragment = T.drop 1 . decodeUtf8 . urlDecode True . encodeUtf8
70 decodeFragment = T.drop 1 . decodeUtf8 . urlDecode True . encodeUtf8
71
71
72resolvesTo :: (Text, Value) -> Assertion
72resolvesTo :: (Text, Value) -> Assertion
73resolvesTo (t, expected) =
73resolvesTo (t, expected) =
74− case P.unescape t of
74+ case P.unescape t of
75− Left e -> assertFailure (show e <> " error for pointer: " <> show t)
75+ Left e -> assertFailure (show e <> " error for pointer: " <> show t)
76− Right p -> assertEqual
76+ Right p -> assertEqual
77− ("Resolved value for pointer: " <> show t)
77+ ("Resolved value for pointer: " <> show t)
78− (Right expected)
78+ (Right expected)
79− (P.resolve p specExample)
79+ (P.resolve p specExample)
80
80
81specExample :: Value
81specExample :: Value
82specExample = object
82specExample = object
83− [ "foo" .= (["bar", "baz"] :: [Text])
83+ [ "foo" .= (["bar", "baz"] :: [Text])
84− , "" .= (0 :: Int)
84+ , "" .= (0 :: Int)
85− , "a/b" .= (1 :: Int)
85+ , "a/b" .= (1 :: Int)
86− , "c%d" .= (2 :: Int)
86+ , "c%d" .= (2 :: Int)
87− , "e^f" .= (3 :: Int)
87+ , "e^f" .= (3 :: Int)
88− , "g|h" .= (4 :: Int)
88+ , "g|h" .= (4 :: Int)
89− , "i\\j" .= (5 :: Int)
89+ , "i\\j" .= (5 :: Int)
90− , "k\"l" .= (6 :: Int)
90+ , "k\"l" .= (6 :: Int)
91− , " " .= (7 :: Int)
91+ , " " .= (7 :: Int)
92− , "m~n" .= (8 :: Int)
92+ , "m~n" .= (8 :: Int)
93− ]
93+ ]