tests/SerializationFormatSpec.hs · typeable/aeson

git.iko.soy/typeable/aeson

on acc-errors help sign in

typeable/aeson/tests/SerializationFormatSpec.hs

271 lines 13 kB history raw

1{-# LANGUAGE CPP #-}

2{-# LANGUAGE DeriveGeneric #-}

3{-# LANGUAGE GADTs #-}

4{-# LANGUAGE OverloadedStrings #-}

5#if __GLASGOW_HASKELL__ >= 708

6{-# LANGUAGE DataKinds #-}

7#endif

9------------------------------------------------------------------------------

10-- These tests assert that the JSON serialization doesn't change by accident.

11-----------------------------------------------------------------------------

13module SerializationFormatSpec

14 (

15 tests

16 ) where

18import Prelude ()

19import Prelude.Compat

21import Control.Applicative (Const(..))

22import Data.Aeson (FromJSON(..), decode, encode, genericParseJSON, genericToEncoding, genericToJSON)

23import Data.Aeson.Types (Options(..), SumEncoding(..), ToJSON(..), defaultOptions)

24import Data.Fixed (Pico)

25import Data.Foldable (for_, toList)

26import Data.Functor.Compose (Compose(..))

27import Data.Functor.Identity (Identity(..))

28import Data.Functor.Product (Product(..))

29import Data.Functor.Sum (Sum(..))

30import Data.List.NonEmpty (NonEmpty(..))

31import Data.Proxy (Proxy(..))

32import Data.Scientific (Scientific)

33import Data.Tagged (Tagged(..))

34import Data.Time (fromGregorian)

35import Data.Word (Word8)

36import GHC.Generics (Generic)

37import Instances ()

38import Test.Framework (Test, testGroup)

39import Test.Framework.Providers.HUnit (testCase)

40import Test.HUnit (assertFailure, assertEqual)

41import Types (Approx(..), Compose3, Compose3', I)

42import qualified Data.ByteString.Lazy.Char8 as L

43import qualified Data.DList as DList

44import qualified Data.HashMap.Strict as HM

45import qualified Data.HashSet as HashSet

46import qualified Data.IntMap as IntMap

47import qualified Data.IntSet as IntSet

48import qualified Data.Map as M

49import qualified Data.Monoid as Monoid

50import qualified Data.Semigroup as Semigroup

51import qualified Data.Sequence as Seq

52import qualified Data.Set as Set

53import qualified Data.Tree as Tree

54import qualified Data.UUID.Types as UUID

55import qualified Data.Vector as Vector

57tests :: [Test]

58tests =

59 [

60 testGroup "To JSON representation" $ fmap assertJsonEncodingExample jsonEncodingExamples

61 , testGroup "From JSON representation" $ fmap assertJsonExample jsonDecodingExamples

62 , testGroup "To/From JSON representation" $ fmap assertJsonExample jsonExamples

64 ]

66jsonExamples :: [Example]

67jsonExamples =

68 [

69 example "Either Left" "{\"Left\":1}" (Left 1 :: Either Int Int)

70 , example "Either Right" "{\"Right\":1}" (Right 1 :: Either Int Int)

71 , example "Nothing" "null" (Nothing :: Maybe Int)

72 , example "Just" "1" (Just 1 :: Maybe Int)

73 , example "Proxy Int" "null" (Proxy :: Proxy Int)

74 , example "Tagged Char Int" "1" (Tagged 1 :: Tagged Char Int)

75#if __GLASGOW_HASKELL__ >= 708

76 -- Test Tagged instance is polykinded

77 , example "Tagged 123 Int" "1" (Tagged 1 :: Tagged 123 Int)

78#endif

79 , example "Const Char Int" "\"c\"" (Const 'c' :: Const Char Int)

80 , example "Tuple" "[1,2]" ((1, 2) :: (Int, Int))

81 , example "NonEmpty" "[1,2,3]" (1 :| [2, 3] :: NonEmpty Int)

82 , example "Seq" "[1,2,3]" (Seq.fromList [1, 2, 3] :: Seq.Seq Int)

83 , example "DList" "[1,2,3]" (DList.fromList [1, 2, 3] :: DList.DList Int)

84 , example "()" "[]" ()

86 , Example "HashMap Int Int"

87 [ "{\"0\":1,\"2\":3}", "{\"2\":3,\"0\":1}"]

88 (HM.fromList [(0,1),(2,3)] :: HM.HashMap Int Int)

89 , Example "Map Int Int"

90 [ "{\"0\":1,\"2\":3}", "{\"2\":3,\"0\":1}"]

91 (M.fromList [(0,1),(2,3)] :: M.Map Int Int)

92 , Example "Map (Tagged Int Int) Int"

93 [ "{\"0\":1,\"2\":3}", "{\"2\":3,\"0\":1}"]

94 (M.fromList [(Tagged 0,1),(Tagged 2,3)] :: M.Map (Tagged Int Int) Int)

95 , example "Map [Int] Int"

96 "[[[0],1],[[2],3]]"

97 (M.fromList [([0],1),([2],3)] :: M.Map [Int] Int)

98 , Example "Map [Char] Int"

99 [ "{\"ab\":1,\"cd\":3}", "{\"cd\":3,\"ab\":1}" ]

100 (M.fromList [("ab",1),("cd",3)] :: M.Map String Int)

101 , Example "Map [I Char] Int"

102 [ "{\"ab\":1,\"cd\":3}", "{\"cd\":3,\"ab\":1}" ]

103 (M.fromList [(map pure "ab",1),(map pure "cd",3)] :: M.Map [I Char] Int)

104

105 , example "nan :: Double" "null" (Approx $ 0/0 :: Approx Double)

106

107 , example "Ordering LT" "\"LT\"" LT

108 , example "Ordering EQ" "\"EQ\"" EQ

109 , example "Ordering GT" "\"GT\"" GT

110

111 , example "Float" "3.14" (3.14 :: Float)

112 , example "Pico" "3.14" (3.14 :: Pico)

113 , example "Scientific" "3.14" (3.14 :: Scientific)

114

115 , example "UUID" "\"c2cc10e1-57d6-4b6f-9899-38d972112d8c\"" $ UUID.fromWords

116 0xc2cc10e1 0x57d64b6f 0x989938d9 0x72112d8c

117

118 , example "Set Int" "[1,2,3]" (Set.fromList [3, 2, 1] :: Set.Set Int)

119 , example "IntSet" "[1,2,3]" (IntSet.fromList [3, 2, 1])

120 , example "IntMap" "[[1,2],[3,4]]" (IntMap.fromList [(3,4), (1,2)] :: IntMap.IntMap Int)

121 , example "Vector" "[1,2,3]" (Vector.fromList [1, 2, 3] :: Vector.Vector Int)

122 , example "HashSet Int" "[1,2,3]" (HashSet.fromList [3, 2, 1] :: HashSet.HashSet Int)

123 , example "Tree Int" "[1,[[2,[[3,[]],[4,[]]]],[5,[]]]]" (let n = Tree.Node in n 1 [n 2 [n 3 [], n 4 []], n 5 []] :: Tree.Tree Int)

124

125 -- Three separate cases, as ordering in HashMap is not defined

126 , example "HashMap Float Int, NaN" "{\"NaN\":1}" (Approx $ HM.singleton (0/0) 1 :: Approx (HM.HashMap Float Int))

127 , example "HashMap Float Int, Infinity" "{\"Infinity\":1}" (HM.singleton (1/0) 1 :: HM.HashMap Float Int)

128 , example "HashMap Float Int, +Infinity" "{\"-Infinity\":1}" (HM.singleton (negate 1/0) 1 :: HM.HashMap Float Int)

129

130 -- Functors

131 , example "Identity Int" "1" (pure 1 :: Identity Int)

132

133 , example "Identity Char" "\"x\"" (pure 'x' :: Identity Char)

134 , example "Identity String" "\"foo\"" (pure "foo" :: Identity String)

135 , example "[Identity Char]" "\"xy\"" ([pure 'x', pure 'y'] :: [Identity Char])

136

137 , example "Maybe Char" "\"x\"" (pure 'x' :: Maybe Char)

138 , example "Maybe String" "\"foo\"" (pure "foo" :: Maybe String)

139 , example "Maybe [Identity Char]" "\"xy\"" (pure [pure 'x', pure 'y'] :: Maybe [Identity Char])

140

141 , example "Day; year >= 1000" "\"1999-10-12\"" (fromGregorian 1999 10 12)

142 , example "Day; year > 0 && < 1000" "\"0500-03-04\"" (fromGregorian 500 3 4)

143 , example "Day; year == 0" "\"0000-02-20\"" (fromGregorian 0 2 20)

144 , example "Day; year < 0" "\"-0234-01-01\"" (fromGregorian (-234) 1 1)

145 , example "Day; year < -1000" "\"-1234-01-01\"" (fromGregorian (-1234) 1 1)

146

147 , example "Product I Maybe Int" "[1,2]" (Pair (pure 1) (pure 2) :: Product I Maybe Int)

148 , example "Product I Maybe Int" "[1,null]" (Pair (pure 1) Nothing :: Product I Maybe Int)

149 , example "Product I [] Char" "[\"a\",\"foo\"]" (Pair (pure 'a') "foo" :: Product I [] Char)

150

151 , example "Sum I [] Int: InL" "{\"InL\":1}" (InL (pure 1) :: Sum I [] Int)

152 , example "Sum I [] Int: InR" "{\"InR\":[1,2]}" (InR [1, 2] :: Sum I [] Int)

153 , example "Sum I [] Char: InR" "{\"InR\":\"foo\"}" (InR "foo" :: Sum I [] Char)

154

155 , example "Compose I I Int" "1" (pure 1 :: Compose I I Int)

156 , example "Compose I [] Int" "[1]" (pure 1 :: Compose I [] Int)

157 , example "Compose [] I Int" "[1]" (pure 1 :: Compose [] I Int)

158 , example "Compose [] [] Int" "[[1]]" (pure 1 :: Compose [] [] Int)

159

160 , example "Compose I I Char" "\"x\"" (pure 'x' :: Compose I I Char)

161 , example "Compose I [] Char" "\"x\"" (pure 'x' :: Compose I [] Char)

162 , example "Compose [] I Char" "\"x\"" (pure 'x' :: Compose [] I Char)

163 , example "Compose [] [] Char" "[\"x\"]" (pure 'x' :: Compose [] [] Char)

164

165 , example "Compose3 I I I Char" "\"x\"" (pure 'x' :: Compose3 I I I Char)

166 , example "Compose3 I I [] Char" "\"x\"" (pure 'x' :: Compose3 I I [] Char)

167 , example "Compose3 I [] I Char" "\"x\"" (pure 'x' :: Compose3 I [] I Char)

168 , example "Compose3 I [] [] Char" "[\"x\"]" (pure 'x' :: Compose3 I [] [] Char)

169 , example "Compose3 [] I I Char" "\"x\"" (pure 'x' :: Compose3 [] I I Char)

170 , example "Compose3 [] I [] Char" "[\"x\"]" (pure 'x' :: Compose3 [] I [] Char)

171 , example "Compose3 [] [] I Char" "[\"x\"]" (pure 'x' :: Compose3 [] [] I Char)

172 , example "Compose3 [] [] [] Char" "[[\"x\"]]" (pure 'x' :: Compose3 [] [] [] Char)

173

174 , example "Compose3' I I I Char" "\"x\"" (pure 'x' :: Compose3' I I I Char)

175 , example "Compose3' I I [] Char" "\"x\"" (pure 'x' :: Compose3' I I [] Char)

176 , example "Compose3' I [] I Char" "\"x\"" (pure 'x' :: Compose3' I [] I Char)

177 , example "Compose3' I [] [] Char" "[\"x\"]" (pure 'x' :: Compose3' I [] [] Char)

178 , example "Compose3' [] I I Char" "\"x\"" (pure 'x' :: Compose3' [] I I Char)

179 , example "Compose3' [] I [] Char" "[\"x\"]" (pure 'x' :: Compose3' [] I [] Char)

180 , example "Compose3' [] [] I Char" "[\"x\"]" (pure 'x' :: Compose3' [] [] I Char)

181 , example "Compose3' [] [] [] Char" "[[\"x\"]]" (pure 'x' :: Compose3' [] [] [] Char)

182

183 , example "MyEither Int String: Left" "42" (MyLeft 42 :: MyEither Int String)

184 , example "MyEither Int String: Right" "\"foo\"" (MyRight "foo" :: MyEither Int String)

185

186 -- newtypes from Monoid/Semigroup

187 , example "Monoid.Dual Int" "2" (pure 2 :: Monoid.Dual Int)

188 , example "Monoid.First Int" "2" (pure 2 :: Monoid.First Int)

189 , example "Monoid.Last Int" "2" (pure 2 :: Monoid.Last Int)

190 , example "Semigroup.Min Int" "2" (pure 2 :: Semigroup.Min Int)

191 , example "Semigroup.Max Int" "2" (pure 2 :: Semigroup.Max Int)

192 , example "Semigroup.First Int" "2" (pure 2 :: Semigroup.First Int)

193 , example "Semigroup.Last Int" "2" (pure 2 :: Semigroup.Last Int)

194 , example "Semigroup.WrappedMonoid Int" "2" (Semigroup.WrapMonoid 2 :: Semigroup.WrappedMonoid Int)

195 , example "Semigroup.Option Just" "2" (pure 2 :: Semigroup.Option Int)

196 , example "Semigroup.Option Nothing" "null" (Semigroup.Option (Nothing :: Maybe Bool))

197 ]

198

199jsonEncodingExamples :: [Example]

200jsonEncodingExamples =

201 [

202 -- Maybe serialising is lossy

203 -- https://github.com/bos/aeson/issues/376

204 example "Just Nothing" "null" (Just Nothing :: Maybe (Maybe Int))

205 -- infinities cannot be recovered, null is decoded as NaN

206 , example "inf :: Double" "null" (Approx $ 1/0 :: Approx Double)

207 ]

208

209jsonDecodingExamples :: [Example]

210jsonDecodingExamples = [

211 -- Maybe serialising is lossy

212 -- https://github.com/bos/aeson/issues/376

213 MaybeExample "Nothing" "null" (Just Nothing :: Maybe (Maybe Int))

214 , MaybeExample "Just" "1" (Just $ Just 1 :: Maybe (Maybe Int))

215 , MaybeExample "Just Nothing" "null" (Just Nothing :: Maybe (Maybe (Maybe Int)))

216 -- Integral values are truncated, and overflowed

217 -- https://github.com/bos/aeson/issues/317

218 , MaybeExample "Word8 3" "3" (Just 3 :: Maybe Word8)

219 , MaybeExample "Word8 3.00" "3.00" (Just 3 :: Maybe Word8)

220 , MaybeExample "Word8 3.14" "3.14" (Nothing :: Maybe Word8)

221 , MaybeExample "Word8 -1" "-1" (Nothing :: Maybe Word8)

222 , MaybeExample "Word8 300" "300" (Nothing :: Maybe Word8)

223 -- Negative zero year, encoding never produces such:

224 , MaybeExample "Day -0000-02-03" "\"-0000-02-03\"" (Just (fromGregorian 0 2 3))

225 ]

226

227data Example where

228 Example

229 :: (Eq a, Show a, ToJSON a, FromJSON a)

230 => String -> [L.ByteString] -> a -> Example -- empty bytestring will fail, any p [] == False

231 MaybeExample

232 :: (Eq a, Show a, FromJSON a)

233 => String -> L.ByteString -> Maybe a -> Example

234

235example :: (Eq a, Show a, ToJSON a, FromJSON a)

236 => String -> L.ByteString -> a -> Example

237example n bs x = Example n [bs] x

238

239data MyEither a b = MyLeft a | MyRight b

240 deriving (Generic, Show, Eq)

241

242instance (ToJSON a, ToJSON b) => ToJSON (MyEither a b) where

243 toJSON = genericToJSON defaultOptions { sumEncoding = UntaggedValue }

244 toEncoding = genericToEncoding defaultOptions { sumEncoding = UntaggedValue }

245

246instance (FromJSON a, FromJSON b) => FromJSON (MyEither a b) where

247 parseJSON = genericParseJSON defaultOptions { sumEncoding = UntaggedValue }

248

249assertJsonExample :: Example -> Test

250assertJsonExample (Example name bss val) = testCase name $ do

251 assertSomeEqual "encode" bss (encode val)

252 assertSomeEqual "encode/via value" bss (encode $ toJSON val)

253 for_ bss $ \bs ->

254 assertEqual "decode" (Just val) (decode bs)

255assertJsonExample (MaybeExample name bs mval) = testCase name $

256 assertEqual "decode" mval (decode bs)

257

258assertJsonEncodingExample :: Example -> Test

259assertJsonEncodingExample (Example name bss val) = testCase name $ do

260 assertSomeEqual "encode" bss (encode val)

261 assertSomeEqual "encode/via value" bss (encode $ toJSON val)

262assertJsonEncodingExample (MaybeExample name _ _) = testCase name $

263 assertFailure "cannot encode MaybeExample"

264

265assertSomeEqual :: (Eq a, Show a, Foldable f) => String -> f a -> a -> IO ()

266assertSomeEqual preface expected actual

267 | actual `elem` expected = return ()

268 | otherwise = assertFailure $ preface

269 ++ ": expecting one of " ++ show (toList expected)

270 ++ ", got " ++ show actual

271