@@ -1,87 +1,90 @@
1+
12module Main where
23
3−import Control.Applicative
44import Control.Arrow
5−import Control.Monad
65import Data.Aeson
7−import qualified Data.HashMap.Strict as H
8−import Data.JsonPointer
9−import Data.Monoid
10−import Data.Text (Text)
11−import qualified Data.Text as T
6+import qualified Data.Aeson.Pointer as P
7+import Data.Text (Text)
8+import qualified Data.Text as T
129import Data.Text.Encoding
13−import qualified Data.Vector as V
14−import Network.HTTP.Types.URI
15−import Test.Framework (defaultMain, testGroup)
16−import Test.Framework.Providers.HUnit (testCase)
17−import Test.HUnit hiding (Test)
10+import qualified Data.Vector as V
11+import Network.HTTP.Types.URI (urlDecode)
12+import Test.Framework (defaultMain, testGroup)
13+import Test.Framework.Providers.HUnit (testCase)
14+import Test.Framework.Providers.QuickCheck2 (testProperty)
15+import Test.HUnit hiding (Test)
1816
17+-- For GHCs before 7.10:
18+import Control.Applicative
19+import Data.Foldable
20+import Data.Monoid
1921
2022main :: IO ()
2123main = defaultMain
2224 [ testGroup "unit"
23− [ testCase "Can be represented in a JSON string value" jsonString
25+ [ testProperty "Storing a Pointer as JSON doesn't change its value" roundtrip
26+ , testCase "Can be represented in a JSON string value" jsonString
2427 , testCase "Can be represented in a URI fragment identifier" uriFragment
2528 ]
2629 ]
2730
28−specExample :: Value
29−specExample =
30− Object $ H.fromList
31− [ ("foo" , Array $ V.fromList ["bar", "baz"])
32− , ("" , Number 0)
33− , ("a/b" , Number 1)
34− , ("c%d" , Number 2)
35− , ("e^f" , Number 3)
36− , ("g|h" , Number 4)
37− , ("i\\j", Number 5)
38− , ("k\"l", Number 6)
39− , (" " , Number 7)
40− , ("m~n" , Number 8)
41− ]
42−
43−resolvesTo :: (Text, Value) -> Assertion
44−resolvesTo (t, expected) =
45− case jsonPointer t of
46− Left e -> assertFailure (show e <> " error for pointer: " <> show t)
47− Right p ->
48− assertEqual ("Resolved value for pointer: " <> show t)
49− (Right expected)
50− $ resolvePointer p specExample
31+roundtrip :: P.Pointer -> Bool
32+roundtrip a = Just a == decode (encode a)
5133
5234jsonString :: Assertion
53−jsonString =
54− void $ mapM resolvesTo
55− [ ("" , specExample)
56− , ("/foo" , Array $ V.fromList ["bar", "baz"])
57− , ("/foo/0", String "bar")
58− , ("/" , Number 0)
59− , ("/a~1b" , Number 1)
60− , ("/c%d" , Number 2)
61− , ("/e^f" , Number 3)
62− , ("/g|h" , Number 4)
63− , ("/i\\j" , Number 5)
64− , ("/k\"l" , Number 6)
65− , ("/ " , Number 7)
66− , ("/m~0n" , Number 8)
67− ]
35+jsonString = traverse_ resolvesTo
36+ [ ("" , specExample)
37+ , ("/foo" , Array $ V.fromList ["bar", "baz"])
38+ , ("/foo/0", String "bar")
39+ , ("/" , Number 0)
40+ , ("/a~1b" , Number 1)
41+ , ("/c%d" , Number 2)
42+ , ("/e^f" , Number 3)
43+ , ("/g|h" , Number 4)
44+ , ("/i\\j" , Number 5)
45+ , ("/k\"l" , Number 6)
46+ , ("/ " , Number 7)
47+ , ("/m~0n" , Number 8)
48+ ]
6849
6950uriFragment :: Assertion
70−uriFragment =
71− void $ mapM resolvesTo $ first decodeFragment <$>
72− [ ("#" , specExample)
73− , ("#/foo" , Array $ V.fromList ["bar", "baz"])
74− , ("#/foo/0", String "bar")
75− , ("#/" , Number 0)
76− , ("#/a~1b" , Number 1)
77− , ("#/c%25d", Number 2)
78− , ("#/e%5Ef", Number 3)
79− , ("#/g%7Ch", Number 4)
80− , ("#/i%5Cj", Number 5)
81− , ("#/k%22l", Number 6)
82− , ("#/%20" , Number 7)
83− , ("#/m~0n" , Number 8)
84− ]
51+uriFragment = traverse_ resolvesTo . fmap (first decodeFragment) $
52+ [ ("#" , specExample)
53+ , ("#/foo" , Array $ V.fromList ["bar", "baz"])
54+ , ("#/foo/0", String "bar")
55+ , ("#/" , Number 0)
56+ , ("#/a~1b" , Number 1)
57+ , ("#/c%25d", Number 2)
58+ , ("#/e%5Ef", Number 3)
59+ , ("#/g%7Ch", Number 4)
60+ , ("#/i%5Cj", Number 5)
61+ , ("#/k%22l", Number 6)
62+ , ("#/%20" , Number 7)
63+ , ("#/m~0n" , Number 8)
64+ ]
8565 where
8666 decodeFragment :: Text -> Text
8767 decodeFragment = T.drop 1 . decodeUtf8 . urlDecode True . encodeUtf8
68+
69+resolvesTo :: (Text, Value) -> Assertion
70+resolvesTo (t, expected) =
71+ case P.unescape t of
72+ Left e -> assertFailure (show e <> " error for pointer: " <> show t)
73+ Right p -> assertEqual
74+ ("Resolved value for pointer: " <> show t)
75+ (Right expected)
76+ (P.resolve p specExample)
77+
78+specExample :: Value
79+specExample = object
80+ [ "foo" .= (["bar", "baz"] :: [Text])
81+ , "" .= (0 :: Int)
82+ , "a/b" .= (1 :: Int)
83+ , "c%d" .= (2 :: Int)
84+ , "e^f" .= (3 :: Int)
85+ , "g|h" .= (4 :: Int)
86+ , "i\\j" .= (5 :: Int)
87+ , "k\"l" .= (6 :: Int)
88+ , " " .= (7 :: Int)
89+ , "m~n" .= (8 :: Int)
90+ ]