git.iko.soy/typeable/aeson
on 1.4.5.0 help sign in
typeable/aeson/tests/ErrorMessages.hs
198 lines 5.0 kB history raw
1{-# LANGUAGE NoImplicitPrelude #-}
2{-# LANGUAGE OverloadedStrings #-}
3{-# LANGUAGE ScopedTypeVariables #-}
5module ErrorMessages
6 (
7 tests
8 ) where
10import Prelude.Compat
12import Data.Aeson (FromJSON(..), Value, json)
13import Data.Aeson.Types (Parser)
14import Data.Aeson.Parser (eitherDecodeWith)
15import Data.Aeson.Internal (formatError, iparse)
16import Data.Algorithm.Diff (Diff(..), getGroupedDiff)
17import Data.Proxy (Proxy(..))
18import Data.Semigroup ((<>))
19import Data.Sequence (Seq)
20import Instances ()
21import Numeric.Natural (Natural)
22import Test.Tasty (TestTree, TestName)
23import Test.Tasty.Golden.Advanced (goldenTest)
24import qualified Data.ByteString.Lazy.Char8 as L
25import qualified Data.HashMap.Strict as HM
27import Encoders
28import Types
30tests :: [TestTree]
31tests =
32 [ aesonGoldenTest "simple" "tests/golden/simple.expected" output
33 , aesonGoldenTest "generic" "tests/golden/generic.expected" (outputGeneric G)
34 ]
36output :: Output
37output = concat
38 [ testFor "Int" (Proxy :: Proxy Int)
39 [ "\"\""
40 , "[]"
41 , "{}"
42 , "null"
43 ]
45 , testFor "Integer" (Proxy :: Proxy Integer)
46 [ "44.44"
47 ]
49 , testFor "Natural" (Proxy :: Proxy Natural)
50 [ "44.44"
51 , "-50"
52 ]
54 , testFor "String" (Proxy :: Proxy String)
55 [ "1"
56 , "[]"
57 , "{}"
58 , "null"
59 ]
61 , testFor "HashMap" (Proxy :: Proxy (HM.HashMap String Int))
62 [ "\"\""
63 , "[]"
64 ]
66 -- issue #356
67 , testFor "Either" (Proxy :: Proxy (Int, Either (Int, Bool) ()))
68 [ "[1,{\"Left\":[2,3]}]"
69 ]
71 -- issue #358
72 , testFor "Seq" (Proxy :: Proxy (Seq Int))
73 [ "[0,1,true]"
74 ]
75 ]
77data Choice = TH | G
79outputGeneric :: Choice -> Output
80outputGeneric choice = concat
81 [ testWith "OneConstructor"
82 (select
83 thOneConstructorParseJSONDefault
84 gOneConstructorParseJSONDefault)
85 [ "\"X\""
86 , "[0]"
87 ]
89 , testWith "Nullary"
90 (select
91 thNullaryParseJSONString
92 gNullaryParseJSONString)
93 [ "\"X\""
94 , "[]"
95 ]
97 , testWithSomeType "SomeType (tagged)"
98 (select
99 thSomeTypeParseJSONTaggedObject
100 gSomeTypeParseJSONTaggedObject)
101 [ "{\"tag\": \"unary\", \"contents\": true}"
102 , "{\"tag\": \"unary\"}"
103 , "{\"tag\": \"record\"}"
104 , "{\"tag\": \"record\", \"testone\": true, \"testtwo\": null, \"testthree\": null}"
105 , "{\"tag\": \"X\"}"
106 , "{}"
107 , "[]"
108 ]
110 , testWithSomeType "SomeType (single-field)"
111 (select
112 thSomeTypeParseJSONObjectWithSingleField
113 gSomeTypeParseJSONObjectWithSingleField)
114 [ "{\"unary\": {}}"
115 , "{\"unary\": []}"
116 , "{\"X\": []}"
117 , "{\"record\": {}, \"W\":{}}"
118 , "{}"
119 , "[]"
120 , "{\"unary\""
121 , "{\"unary\":"
122 , "{\"unary\":1"
123 ]
125 , testWithSomeType "SomeType (two-element array)"
126 (select
127 thSomeTypeParseJSON2ElemArray
128 gSomeTypeParseJSON2ElemArray)
129 [ "[\"unary\", true]"
130 , "[\"record\", null]"
131 , "[\"X\", 0]"
132 , "[null, 0]"
133 , "[]"
134 , "{}"
135 , "[1"
136 , "[1,"
137 ]
139 , testWith "EitherTextInt"
140 (select
141 thEitherTextIntParseJSONUntaggedValue
142 gEitherTextIntParseJSONUntaggedValue)
143 [ "\"X\""
144 , "[]"
145 ]
147 , testWith "Product2 Int Bool"
148 (select
149 thProduct2ParseJSON
150 gProduct2ParseJSON)
151 [ "[1, null]"
152 , "[]"
153 , "{}"
154 ]
155 ]
156 where
157 select a b = case choice of
158 TH -> a
159 G -> b
161-- Test infrastructure
163type Output = [String]
165outputLine :: String -> Output
166outputLine = pure
168aesonGoldenTest :: TestName -> FilePath -> Output -> TestTree
169aesonGoldenTest name ref out = goldenTest name (L.readFile ref) act cmp upd
170 where
171 act = pure (L.pack (unlines out))
172 upd = L.writeFile ref
173 cmp x y | x == y = return Nothing
174 cmp x y = return $ Just $ unlines $
175 concatMap f (getGroupedDiff (L.lines x) (L.lines y))
176 where
177 f (First xs) = map (cons3 '-' . L.unpack) xs
178 f (Second ys) = map (cons3 '+' . L.unpack) ys
179 -- we print unchanged lines too. It shouldn't be a problem while we have
180 -- reasonably small examples
181 f (Both xs _) = map (cons3 ' ' . L.unpack) xs
182 -- we add three characters, so the changed lines are easier to spot
183 cons3 c cs = c : c : c : ' ' : cs
185testWith :: Show a => String -> (Value -> Parser a) -> [L.ByteString] -> Output
186testWith name parser ts =
187 outputLine name <>
188 foldMap (\s ->
189 case eitherDecodeWith json (iparse parser) s of
190 Left err -> outputLine $ uncurry formatError err
191 Right a -> outputLine $ show a) ts
193testFor :: forall a proxy. (FromJSON a, Show a)
194 => String -> proxy a -> [L.ByteString] -> Output
195testFor name _ = testWith name (parseJSON :: Value -> Parser a)
197testWithSomeType :: String -> (Value -> Parser (SomeType Int)) -> [L.ByteString] -> Output
198testWithSomeType = testWith