git.iko.soy/typeable/hjsonpointer
on master help sign in
Switch to 4 space indentation.
commit930c14acc8ab6a405f0e2b6dad279d801819d09a authorIan Grant Jeffries <ian@housejeffries.com> dateWed 13 Jul 2016, 01:27 (10 years ago) parent92621b1
4 files changed+118−116
compare with master
unifiedsplit
Example.hs+12−12 README.md+15−15 src/Data/Aeson/Pointer.hs+42−40 test/Unit.hs+49−49
Example.hs+12−12
@@ -8,20 +8,20 @@ import qualified Data.Aeson.Pointer as P
88
99main :: IO ()
1010main = do
11− -- JSON Pointers must either be empty or start with a /.
12− pntr1 <- case P.unescape "/foo/0" of
13− Left _ -> error "Failed to construct JSON Pointer."
14− Right pntr -> return pntr
11+ -- JSON Pointers must either be empty or start with a /.
12+ pntr1 <- case P.unescape "/foo/0" of
13+ Left _ -> error "Failed to construct JSON Pointer."
14+ Right pntr -> return pntr
1515
16− -- We can also write JSON Pointers in Haskell.
17− let pntr2 = P.Pointer [P.Token "/"]
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
20− -- Pointer string.
21− unless (P.unescape "/~1" == Right pntr2) (error "ohno!")
16+ -- We can also write JSON Pointers in Haskell.
17+ let pntr2 = P.Pointer [P.Token "/"]
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
20+ -- Pointer string.
21+ unless (P.unescape "/~1" == Right pntr2) (error "ohno!")
2222
23− print (P.resolve pntr1 document)
24− print (P.resolve pntr2 document)
23+ print (P.resolve pntr1 document)
24+ print (P.resolve pntr2 document)
2525
2626 where
2727 document :: Value
README.md+15−15
@@ -9,7 +9,7 @@
99```haskell
1010{-# LANGUAGE OverloadedStrings #-}
1111
12−module Main where
12+module Example where
1313
1414import Control.Monad (unless)
1515import Data.Aeson
@@ -17,20 +17,20 @@ import qualified Data.Aeson.Pointer as P
1717
1818main :: IO ()
1919main = do
20− -- JSON Pointers must either be empty or start with a /.
21− pntr1 <- case P.unescape "/foo/0" of
22− Left _ -> error "Failed to construct JSON Pointer."
23− Right pntr -> pure pntr
24−
25− -- We can also write JSON Pointers in Haskell.
26− let pntr2 = P.Pointer [P.Token "/"]
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
29− -- Pointer string.
30− unless (P.unescape "/~1" == Right pntr2) (error "ohno!")
31−
32− print (P.resolve pntr1 document)
33− print (P.resolve pntr2 document)
20+ -- JSON Pointers must either be empty or start with a /.
21+ pntr1 <- case P.unescape "/foo/0" of
22+ Left _ -> error "Failed to construct JSON Pointer."
23+ Right pntr -> return pntr
24+
25+ -- We can also write JSON Pointers in Haskell.
26+ let pntr2 = P.Pointer [P.Token "/"]
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
29+ -- Pointer string.
30+ unless (P.unescape "/~1" == Right pntr2) (error "ohno!")
31+
32+ print (P.resolve pntr1 document)
33+ print (P.resolve pntr2 document)
3434
3535 where
3636 document :: Value
src/Data/Aeson/Pointer.hs+42−40
@@ -17,41 +17,43 @@ import Data.Monoid
1717import Data.Traversable
1818
1919newtype Pointer
20− = Pointer { _unPointer :: [Token] }
21− deriving (Eq, Show, Monoid, Arbitrary)
20+ = Pointer { _unPointer :: [Token] }
21+ deriving (Eq, Show, Monoid, Arbitrary)
2222
2323instance FromJSON Pointer where
24− parseJSON = withText "JSON Pointer" $ \t ->
25− case unescape t of
26− Left e -> fail (show e)
27− Right p -> pure p
24+ parseJSON = withText "JSON Pointer" $ \t ->
25+ case unescape t of
26+ Left e -> fail (show e)
27+ Right p -> pure p
2828
2929instance ToJSON Pointer where
30− toJSON = String . escape
30+ toJSON = String . escape
3131
3232-- | We don't try to distinguish between integer tokens and string
3333-- tokens since all tokens start as strings, and all tokens can
3434-- be used to resolve JSON objects.
35−newtype Token = Token { _unToken :: Text } deriving (Eq, Show)
35+newtype Token
36+ = Token { _unToken :: Text }
37+ deriving (Eq, Show)
3638
3739instance Arbitrary Token where
38− arbitrary = Token . T.pack <$> arbitrary
40+ arbitrary = Token . T.pack <$> arbitrary
3941
4042escape :: Pointer -> Text
4143escape (Pointer []) = ""
4244escape (Pointer ts) =
43− T.cons '/'
44− . T.intercalate "/"
45− . fmap (T.replace "/" "~1" . T.replace "~" "~0" . _unToken)
46− $ ts
45+ T.cons '/'
46+ . T.intercalate "/"
47+ . fmap (T.replace "/" "~1" . T.replace "~" "~0" . _unToken)
48+ $ ts
4749
4850-- * Unescaping
4951
5052data FormatError
51− = InvalidFirstChar
52− -- ^ JSON Pointers must either be empty or start with a @/@.
53− | UnescapedTilde
54− deriving (Eq, Show)
53+ = InvalidFirstChar
54+ -- ^ JSON Pointers must either be empty or start with a @/@.
55+ | UnescapedTilde
56+ deriving (Eq, Show)
5557
5658
5759-- | JSON Pointers must either be empty or start with a @/@. This means
@@ -65,21 +67,21 @@ data FormatError
6567-- "Network.HTTP.Types.URI.urlDecode" from http-types.
6668unescape :: Text -> Either FormatError Pointer
6769unescape txt =
68− case T.splitOn "/" txt of
69− [] -> Right (Pointer [])
70− "":xs -> Pointer <$> traverse f xs
71− _ -> Left InvalidFirstChar
70+ case T.splitOn "/" txt of
71+ [] -> Right (Pointer [])
72+ "":xs -> Pointer <$> traverse f xs
73+ _ -> Left InvalidFirstChar
7274 where
7375 f :: Text -> Either FormatError Token
7476 f t = case unescapeToken t of
75− Nothing -> Left UnescapedTilde
76− Just tok -> Right tok
77+ Nothing -> Left UnescapedTilde
78+ Just tok -> Right tok
7779
7880-- | For internal use by 'unescape'.
7981unescapeToken :: Text -> Maybe Token
8082unescapeToken t
81− | not (isValid t) = Nothing
82− | otherwise = Just . Token . replace $ t
83+ | not (isValid t) = Nothing
84+ | otherwise = Just . Token . replace $ t
8385 where
8486 -- All tildes must be followed by 0s or 1s.
8587 isValid :: Text -> Bool
@@ -94,11 +96,11 @@ unescapeToken t
9496-- * Resolution
9597
9698data ResolutionError
97− = ObjectLookupFailed
98− | ArrayIndexInvalid
99− | ArrayElemNotFound
100− | ExpectedObjectOrArray
101− deriving (Eq, Show)
99+ = ObjectLookupFailed
100+ | ArrayIndexInvalid
101+ | ArrayElemNotFound
102+ | ExpectedObjectOrArray
103+ deriving (Eq, Show)
102104
103105resolve :: Pointer -> Value -> Either ResolutionError Value
104106resolve (Pointer []) v = Right v
@@ -108,15 +110,15 @@ resolve (Pointer (t:ts)) v = resolveToken t v >>= resolve (Pointer ts)
108110-- resolve an entire pointer at once).
109111resolveToken :: Token -> Value -> Either ResolutionError Value
110112resolveToken tok (Array vs) =
111− case readMaybe . T.unpack . _unToken $ tok of
112− Nothing -> Left ArrayIndexInvalid
113− Just n -> do
114− when (n < 0) (Left ArrayIndexInvalid)
115− case vs V.!? n of
116− Nothing -> Left ArrayElemNotFound
117− Just res -> Right res
113+ case readMaybe . T.unpack . _unToken $ tok of
114+ Nothing -> Left ArrayIndexInvalid
115+ Just n -> do
116+ when (n < 0) (Left ArrayIndexInvalid)
117+ case vs V.!? n of
118+ Nothing -> Left ArrayElemNotFound
119+ Just res -> Right res
118120resolveToken tok (Object h) =
119− case H.lookup (_unToken tok) h of
120− Nothing -> Left ObjectLookupFailed
121− Just res -> Right res
121+ case H.lookup (_unToken tok) h of
122+ Nothing -> Left ObjectLookupFailed
123+ Just res -> Right res
122124resolveToken _ _ = Left ExpectedObjectOrArray
test/Unit.hs+49−49
@@ -24,70 +24,70 @@ import qualified Example
2424
2525main :: IO ()
2626main = hspec $ do
27− describe "example" $ do
28− it "compiles and runs without errors" Example.main
29− describe "pointers" $ do
30− it "can be stored as JSON without changing its value" (property roundtrip)
31− it "can be represented in a JSON string value" jsonString
32− it "can be represented in a URI fragment identifier" uriFragment
27+ describe "example" $ do
28+ it "compiles and runs without errors" Example.main
29+ describe "pointers" $ do
30+ it "can be stored as JSON without changing its value" (property roundtrip)
31+ it "can be represented in a JSON string value" jsonString
32+ it "can be represented in a URI fragment identifier" uriFragment
3333
3434roundtrip :: P.Pointer -> Bool
3535roundtrip a = Just a == decode (encode a)
3636
3737jsonString :: Assertion
3838jsonString = traverse_ resolvesTo
39− [ ("" , specExample)
40− , ("/foo" , Array $ V.fromList ["bar", "baz"])
41− , ("/foo/0", String "bar")
42− , ("/" , Number 0)
43− , ("/a~1b" , Number 1)
44− , ("/c%d" , Number 2)
45− , ("/e^f" , Number 3)
46− , ("/g|h" , Number 4)
47− , ("/i\\j" , Number 5)
48− , ("/k\"l" , Number 6)
49− , ("/ " , Number 7)
50− , ("/m~0n" , Number 8)
51− ]
39+ [ ("" , specExample)
40+ , ("/foo" , Array $ V.fromList ["bar", "baz"])
41+ , ("/foo/0", String "bar")
42+ , ("/" , Number 0)
43+ , ("/a~1b" , Number 1)
44+ , ("/c%d" , Number 2)
45+ , ("/e^f" , Number 3)
46+ , ("/g|h" , Number 4)
47+ , ("/i\\j" , Number 5)
48+ , ("/k\"l" , Number 6)
49+ , ("/ " , Number 7)
50+ , ("/m~0n" , Number 8)
51+ ]
5252
5353uriFragment :: Assertion
5454uriFragment = traverse_ resolvesTo . fmap (first decodeFragment) $
55− [ ("#" , specExample)
56− , ("#/foo" , Array $ V.fromList ["bar", "baz"])
57− , ("#/foo/0", String "bar")
58− , ("#/" , Number 0)
59− , ("#/a~1b" , Number 1)
60− , ("#/c%25d", Number 2)
61− , ("#/e%5Ef", Number 3)
62− , ("#/g%7Ch", Number 4)
63− , ("#/i%5Cj", Number 5)
64− , ("#/k%22l", Number 6)
65− , ("#/%20" , Number 7)
66− , ("#/m~0n" , Number 8)
67− ]
55+ [ ("#" , specExample)
56+ , ("#/foo" , Array $ V.fromList ["bar", "baz"])
57+ , ("#/foo/0", String "bar")
58+ , ("#/" , Number 0)
59+ , ("#/a~1b" , Number 1)
60+ , ("#/c%25d", Number 2)
61+ , ("#/e%5Ef", Number 3)
62+ , ("#/g%7Ch", Number 4)
63+ , ("#/i%5Cj", Number 5)
64+ , ("#/k%22l", Number 6)
65+ , ("#/%20" , Number 7)
66+ , ("#/m~0n" , Number 8)
67+ ]
6868 where
6969 decodeFragment :: Text -> Text
7070 decodeFragment = T.drop 1 . decodeUtf8 . urlDecode True . encodeUtf8
7171
7272resolvesTo :: (Text, Value) -> Assertion
7373resolvesTo (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)
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)
8080
8181specExample :: Value
8282specExample = object
83− [ "foo" .= (["bar", "baz"] :: [Text])
84− , "" .= (0 :: Int)
85− , "a/b" .= (1 :: Int)
86− , "c%d" .= (2 :: Int)
87− , "e^f" .= (3 :: Int)
88− , "g|h" .= (4 :: Int)
89− , "i\\j" .= (5 :: Int)
90− , "k\"l" .= (6 :: Int)
91− , " " .= (7 :: Int)
92− , "m~n" .= (8 :: Int)
93− ]
83+ [ "foo" .= (["bar", "baz"] :: [Text])
84+ , "" .= (0 :: Int)
85+ , "a/b" .= (1 :: Int)
86+ , "c%d" .= (2 :: Int)
87+ , "e^f" .= (3 :: Int)
88+ , "g|h" .= (4 :: Int)
89+ , "i\\j" .= (5 :: Int)
90+ , "k\"l" .= (6 :: Int)
91+ , " " .= (7 :: Int)
92+ , "m~n" .= (8 :: Int)
93+ ]