@@ -1,93 +1,92 @@
1+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2+{-# LANGUAGE StandaloneDeriving #-}
13
24module Main where
35
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
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
29+ describe "example" $ do
30+ it "compiles and runs without errors" Example.main
31+ describe "pointers" $ do
32+ it "can be stored as JSON without changing its value" (property roundtrip)
33+ it "can be represented in a JSON string value" jsonString
34+ 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
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− ]
41+ [ ("" , specExample)
42+ , ("/foo" , Array $ V.fromList ["bar", "baz"])
43+ , ("/foo/0", String "bar")
44+ , ("/" , Number 0)
45+ , ("/a~1b" , Number 1)
46+ , ("/c%d" , Number 2)
47+ , ("/e^f" , Number 3)
48+ , ("/g|h" , Number 4)
49+ , ("/i\\j" , Number 5)
50+ , ("/k\"l" , Number 6)
51+ , ("/ " , Number 7)
52+ , ("/m~0n" , Number 8)
53+ ]
5254
53−uriFragment :: Assertion
55+uriFragment :: Expectation
5456uriFragment = 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− ]
57+ [ ("#" , specExample)
58+ , ("#/foo" , Array $ V.fromList ["bar", "baz"])
59+ , ("#/foo/0", String "bar")
60+ , ("#/" , Number 0)
61+ , ("#/a~1b" , Number 1)
62+ , ("#/c%25d", Number 2)
63+ , ("#/e%5Ef", Number 3)
64+ , ("#/g%7Ch", Number 4)
65+ , ("#/i%5Cj", Number 5)
66+ , ("#/k%22l", Number 6)
67+ , ("#/%20" , Number 7)
68+ , ("#/m~0n" , Number 8)
69+ ]
6870 where
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
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− ]
82+ [ "foo" .= (["bar", "baz"] :: [Text])
83+ , "" .= (0 :: Int)
84+ , "a/b" .= (1 :: Int)
85+ , "c%d" .= (2 :: Int)
86+ , "e^f" .= (3 :: Int)
87+ , "g|h" .= (4 :: Int)
88+ , "i\\j" .= (5 :: Int)
89+ , "k\"l" .= (6 :: Int)
90+ , " " .= (7 :: Int)
91+ , "m~n" .= (8 :: Int)
92+ ]