tests/SerializationFormatSpec.hs · typeable/aeson

git.iko.soy/typeable/aeson

on 1.4.4.0 help sign in

typeable/aeson/tests/SerializationFormatSpec.hs

298 lines 14 kB history raw

1{-# LANGUAGE CPP #-}

2{-# LANGUAGE DeriveGeneric #-}

3{-# LANGUAGE GADTs #-}

4{-# LANGUAGE NoImplicitPrelude #-}

5{-# LANGUAGE OverloadedStrings #-}

6#if __GLASGOW_HASKELL__ >= 708

7{-# LANGUAGE DataKinds #-}

8#endif

10------------------------------------------------------------------------------

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

12-----------------------------------------------------------------------------

14module SerializationFormatSpec

15 (

16 tests

17 ) where

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.Time.Calendar.Compat (CalendarDiffDays (..), DayOfWeek (..))

36import Data.Time.LocalTime.Compat (CalendarDiffTime (..))

37import Data.Time.Clock.System.Compat (SystemTime (..))

38import Data.Word (Word8)

39import GHC.Generics (Generic)

40import Instances ()

41import Test.Tasty (TestTree, testGroup)

42import Test.Tasty.HUnit (assertFailure, assertEqual, testCase)

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

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

45import qualified Data.DList as DList

46import qualified Data.HashMap.Strict as HM

47import qualified Data.HashSet as HashSet

48import qualified Data.IntMap as IntMap

49import qualified Data.IntSet as IntSet

50import qualified Data.Map as M

51import qualified Data.Monoid as Monoid

52import qualified Data.Semigroup as Semigroup

53import qualified Data.Sequence as Seq

54import qualified Data.Set as Set

55import qualified Data.Tree as Tree

56import qualified Data.UUID.Types as UUID

57import qualified Data.Vector as Vector

59tests :: [TestTree]

60tests =

61 [

62 testGroup "To JSON representation" $ fmap assertJsonEncodingExample jsonEncodingExamples

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

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

66 ]

68jsonExamples :: [Example]

69jsonExamples =

70 [

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

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

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

74 -- Maybe serialising is lossy

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

76 , Example "Just Nothing" ["null"] (Just Nothing :: Maybe (Maybe Int)) Nothing

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

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

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

80#if __GLASGOW_HASKELL__ >= 708

81 -- Test Tagged instance is polykinded

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

83#endif

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

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

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

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

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

89 , example "()" "[]" ()

91 , ndExample "HashMap Int Int"

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

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

94 , ndExample "Map Int Int"

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

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

97 , ndExample "Map (Tagged Int Int) Int"

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

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

100 , example "Map [Int] Int"

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

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

103 , ndExample "Map [Char] Int"

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

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

106 , ndExample "Map [I Char] Int"

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

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

109

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

111

112 , example "Ordering LT" "\"LT\"" LT

113 , example "Ordering EQ" "\"EQ\"" EQ

114 , example "Ordering GT" "\"GT\"" GT

115

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

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

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

119

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

121 0xc2cc10e1 0x57d64b6f 0x989938d9 0x72112d8c

122

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

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

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

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

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

128 , 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)

129

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

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

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

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

134

135 -- Functors

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

137

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

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

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

141

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

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

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

145

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

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

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

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

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

151

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

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

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

155

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

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

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

159

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

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

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

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

164

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

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

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

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

169

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

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

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

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

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

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

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

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

178

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

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

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

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

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

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

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

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

187

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

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

190

191 -- newtypes from Monoid/Semigroup

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

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

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

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

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

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

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

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

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

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

202

203 -- time 1.9

204 , example "SystemTime" "123.123456789" (MkSystemTime 123 123456789)

205 , Example "SystemTime" ["124.23456789"]

206 (MkSystemTime 123 1234567890)

207 (MkSystemTime 124 234567890)

208 , ndExample "CalendarDiffTime"

209 [ "{\"months\":12,\"time\":456.789}", "{\"time\":456.789,\"months\":12}" ]

210 (CalendarDiffTime 12 456.789)

211 , ndExample "CalendarDiffDays"

212 [ "{\"months\":12,\"days\":20}", "{\"days\":20,\"months\":12}" ]

213 (CalendarDiffDays 12 20)

214 , example "DayOfWeek" "\"monday\"" Monday

215 ]

216

217jsonEncodingExamples :: [Example]

218jsonEncodingExamples =

219 [

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

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

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

223 ]

224

225jsonDecodingExamples :: [Example]

226jsonDecodingExamples = [

227 -- Maybe serialising is lossy

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

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

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

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

232 -- Integral values are truncated, and overflowed

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

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

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

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

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

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

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

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

241 ]

242

243data Example where

244 Example

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

246 => String -- name

247 -> [L.ByteString] -- encoded variants

248 -> a -- input

249 -> a -- decoded

250 -> Example -- empty bytestring will fail, any p [] == False

251

252 MaybeExample

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

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

255

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

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

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

259

260-- | Non-deterministic example, input encodes to some of bytestrings.

261ndExample :: (Eq a, Show a, ToJSON a, FromJSON a)

262 => String -> [L.ByteString] -> a -> Example

263ndExample n bss x = Example n bss x x

264

265

266data MyEither a b = MyLeft a | MyRight b

267 deriving (Generic, Show, Eq)

268

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

270 toJSON = genericToJSON defaultOptions { sumEncoding = UntaggedValue }

271 toEncoding = genericToEncoding defaultOptions { sumEncoding = UntaggedValue }

272

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

274 parseJSON = genericParseJSON defaultOptions { sumEncoding = UntaggedValue }

275

276assertJsonExample :: Example -> TestTree

277assertJsonExample (Example name bss val val') = testCase name $ do

278 assertSomeEqual "encode" bss (encode val)

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

280 for_ bss $ \bs ->

281 assertEqual "decode" (Just val') (decode bs)

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

283 assertEqual "decode" mval (decode bs)

284

285assertJsonEncodingExample :: Example -> TestTree

286assertJsonEncodingExample (Example name bss val _) = testCase name $ do

287 assertSomeEqual "encode" bss (encode val)

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

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

290 assertFailure "cannot encode MaybeExample"

291

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

293assertSomeEqual preface expected actual

294 | actual `elem` expected = return ()

295 | otherwise = assertFailure $ preface

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

297 ++ ", got " ++ show actual

298