@@ -9,62 +9,99 @@ module ErrorMessages
99
1010import Prelude.Compat
1111
12−import Data.Aeson (FromJSON(..), eitherDecode)
12+import Data.Aeson (FromJSON(..), Value, json)
13+import Data.Aeson.Types (Parser)
14+import Data.Aeson.Parser (eitherDecodeWith)
15+import Data.Aeson.Internal (formatError, iparse)
16+import Data.Algorithm.Diff (Diff(..), getGroupedDiff)
1317import Data.Proxy (Proxy(..))
18+import Data.Semigroup ((<>))
19+import Data.Sequence (Seq)
1420import Instances ()
1521import Numeric.Natural (Natural)
16−import Test.Tasty (TestTree)
17−import Test.Tasty.HUnit (Assertion, assertFailure, assertEqual, testCase)
22+import Test.Tasty (TestTree, TestName)
23+import Test.Tasty.Golden.Advanced (goldenTest)
1824import qualified Data.ByteString.Lazy.Char8 as L
1925import qualified Data.HashMap.Strict as HM
2026
2127tests :: [TestTree]
2228tests =
23− [
24− testCase "Int" int
25− , testCase "Integer" integer
26− , testCase "Natural" natural
27− , testCase "String" string
28− , testCase "HashMap" hashMap
29− ]
30−
31−int :: Assertion
32−int = do
33− let t = test (Proxy :: Proxy Int)
34− t "\"\"" $ expected "Int" "String"
35− t "[]" $ expected "Int" "Array"
36− t "{}" $ expected "Int" "Object"
37− t "null" $ expected "Int" "Null"
38−
39−integer :: Assertion
40−integer = do
41− let t = test (Proxy :: Proxy Integer)
42− t "44.44" $ expected "Integer" "floating number 44.44"
43−
44−natural :: Assertion
45−natural = do
46− let t = test (Proxy :: Proxy Natural)
47− t "44.44" $ expected "Natural" "floating number 44.44"
48− t "-50" $ expected "Natural" "negative number -50"
49−
50−string :: Assertion
51−string = do
52− let t = test (Proxy :: Proxy String)
53− t "1" $ expected "String" "Number"
54− t "[]" $ expected "String" "Array"
55− t "{}" $ expected "String" "Object"
56− t "null" $ expected "String" "Null"
57−
58−hashMap :: Assertion
59−hashMap = do
60− let t = test (Proxy :: Proxy (HM.HashMap String Int))
61− t "\"\"" $ expected "HashMap k v" "String"
62− t "[]" $ expected "HashMap k v" "Array"
63−
64−expected :: String -> String -> String
65−expected ex enc = "Error in $: expected " ++ ex ++ ", encountered " ++ enc
66−
67−test :: forall a proxy . (FromJSON a, Show a) => proxy a -> L.ByteString -> String -> Assertion
68−test _ v msg = case eitherDecode v of
69− Left e -> assertEqual "Invalid error message" msg e
70− Right (x :: a) -> assertFailure $ "Expected parsing to fail but it suceeded with: " ++ show x
29+ [ aesonGoldenTest "simple" "tests/golden/simple.expected" output
30+ ]
31+
32+output :: Output
33+output = concat
34+ [ testFor "Int" (Proxy :: Proxy Int)
35+ [ "\"\""
36+ , "[]"
37+ , "{}"
38+ , "null"
39+ ]
40+
41+ , testFor "Integer" (Proxy :: Proxy Integer)
42+ [ "44.44"
43+ ]
44+
45+ , testFor "Natural" (Proxy :: Proxy Natural)
46+ [ "44.44"
47+ , "-50"
48+ ]
49+
50+ , testFor "String" (Proxy :: Proxy String)
51+ [ "1"
52+ , "[]"
53+ , "{}"
54+ , "null"
55+ ]
56+
57+ , testFor "HashMap" (Proxy :: Proxy (HM.HashMap String Int))
58+ [ "\"\""
59+ , "[]"
60+ ]
61+
62+ -- issue #356
63+ , testFor "Either" (Proxy :: Proxy (Int, Either (Int, Bool) ()))
64+ [ "[1,{\"Left\":[2,3]}]"
65+ ]
66+
67+ -- issue #358
68+ , testFor "Seq" (Proxy :: Proxy (Seq Int))
69+ [ "[0,1,true]"
70+ ]
71+ ]
72+
73+-- Test infrastructure
74+
75+type Output = [String]
76+
77+outputLine :: String -> Output
78+outputLine = pure
79+
80+aesonGoldenTest :: TestName -> FilePath -> Output -> TestTree
81+aesonGoldenTest name ref out = goldenTest name (L.readFile ref) act cmp upd
82+ where
83+ act = pure (L.pack (unlines out))
84+ upd = L.writeFile ref
85+ cmp x y | x == y = return Nothing
86+ cmp x y = return $ Just $ unlines $
87+ concatMap f (getGroupedDiff (L.lines x) (L.lines y))
88+ where
89+ f (First xs) = map (cons3 '-' . L.unpack) xs
90+ f (Second ys) = map (cons3 '+' . L.unpack) ys
91+ -- we print unchanged lines too. It shouldn't be a problem while we have
92+ -- reasonably small examples
93+ f (Both xs _) = map (cons3 ' ' . L.unpack) xs
94+ -- we add three characters, so the changed lines are easier to spot
95+ cons3 c cs = c : c : c : ' ' : cs
96+
97+testWith :: Show a => String -> (Value -> Parser a) -> [L.ByteString] -> Output
98+testWith name parser ts =
99+ outputLine name <>
100+ foldMap (\s ->
101+ case eitherDecodeWith json (iparse parser) s of
102+ Left err -> outputLine $ uncurry formatError err
103+ Right a -> outputLine $ show a) ts
104+
105+testFor :: forall a proxy. (FromJSON a, Show a)
106+ => String -> proxy a -> [L.ByteString] -> Output
107+testFor name _ = testWith name (parseJSON :: Value -> Parser a)