master..5ad68a0 · typeable/aeson

git.iko.soy/typeable/aeson

on 5ad68a0 help sign in

.travis.yml+8

since splitsnapshots

unifiedsplit

@@ -65,6 +65,14 @@ matrix:

65 compiler: ": #GHC 7.8.4"

66 addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4], sources: [hvr-ghc]}}

68+ - env: BUILD=cabal CABALVER=1.18 GHCVER=7.6.3

69+ compiler: ": #GHC 7.6.3"

70+ addons: {apt: {packages: [cabal-install-1.18,ghc-7.6.3], sources: [hvr-ghc]}}

71+

72+ - env: BUILD=cabal CABALVER=1.18 GHCVER=7.4.2

73+ compiler: ": #GHC 7.4.2"

74+ addons: {apt: {packages: [cabal-install-1.18,ghc-7.4.2], sources: [hvr-ghc]}}

75+

68before_install:

76before_install:

69 - unset CC

77 - unset CC

70 - export PATH=$HOME/.local/bin:/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH

78 - export PATH=$HOME/.local/bin:/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH

CONTRIBUTING.md−38

@@ -58,41 +58,3 @@ import Foo as F

58import Qux (Q(..), q)

59import qualified A

60```

61−

62−## Development Workflow (If you plan on using Stack)

63−

64−Here we outline a general workflow new contributors could adopt for a nice incremental development experience.

65−

66−The root folder consists of two stack-*.yaml config files.

67−

68−1. stack-nightly.yaml - Config file defines all the settings to build and test any changes.

69−2. stack-bench.yaml - Used to run benchmark tests.

70−3. stack-ffi-unescape.yaml - This is for replacing certain parts with a C-implementation.

71−

72−Therefore, a ghci development experience would be:

73−

74−1. `stack ghci --stack-yaml stack-nightly.yaml --test`

75−2. :r to recompile

76−3. `main` to run all tests, or `:main --pattern Foo` to run specific tests matched by pattern.

77−

78−Some discussion on this topic can also be found here [here](https://github.com/bos/aeson/issues/733)

79−

80−Of course before submitting a PR, the following steps are recommended:

81−

82−1. 'stack test --stack-yaml stack-nightly.yaml` - Run the entire suite of tests

83−2. `make hlint` - Run hlint on the source folders.

84−3. 'stack test --stack-yaml stack-bench.yaml` - Run the benchmark tests if you believe your changes could affect the benchmarks.

85−

86−## Development Workflow (If you plan on using Cabal)

87−

88−A ghci development experience would be:

89−

90−1. `cabal new-repl test:tests`

91−2. `:r` to recompile

92−3. `Main.main` to run all tests, or `:m Main; :main --pattern Foo` to run specific tests matched by pattern.

93−

94−Of course before submitting a PR, the following steps are recommended:

95−

96−1. `cabal new-test` - Run the entire suite of tests

97−2. `make hlint` - Run hlint on the source folders.

98−3. Uncomment the `benchmarks` line in `cabal.project` - Run the benchmark tests if you believe your changes could affect the benchmarks.

Data/Aeson/Compat.hsnew file+16

@@ -0,0 +1,16 @@

1+{-# LANGUAGE CPP #-}

3+module Data.Aeson.Compat

4+ (

5+ fromStrict

6+ ) where

8+import qualified Data.ByteString as S

9+import qualified Data.ByteString.Lazy as L

10+

11+fromStrict :: S.ByteString -> L.ByteString

12+#if MIN_VERSION_bytestring(0, 9, 2)

13+fromStrict = L.fromChunks . (:[])

14+#else

15+fromStrict = L.fromStrict

16+#endif

Data/Aeson/TH.hs+38−24

@@ -135,15 +135,22 @@ import Data.Map (Map)

135import Data.Maybe (catMaybes, fromMaybe, mapMaybe)

136import qualified Data.Monoid as Monoid

137import Data.Set (Set)

138+#if MIN_VERSION_template_haskell(2,8,0)

138import Language.Haskell.TH hiding (Arity)

139import Language.Haskell.TH hiding (Arity)

140+#else

141+import Language.Haskell.TH

142+#endif

139import Language.Haskell.TH.Datatype

143import Language.Haskell.TH.Datatype

144+#if MIN_VERSION_template_haskell(2,7,0) && !(MIN_VERSION_template_haskell(2,8,0))

145+import Language.Haskell.TH.Lib (starK)

146+#endif

140#if MIN_VERSION_template_haskell(2,8,0) && !(MIN_VERSION_template_haskell(2,10,0))

147#if MIN_VERSION_template_haskell(2,8,0) && !(MIN_VERSION_template_haskell(2,10,0))

141import Language.Haskell.TH.Syntax (mkNameG_tc)

148import Language.Haskell.TH.Syntax (mkNameG_tc)

142#endif

149#endif

143import Text.Printf (printf)

150import Text.Printf (printf)

144import qualified Data.Aeson.Encoding.Internal as E

151import qualified Data.Aeson.Encoding.Internal as E

145import qualified Data.Foldable as F (all)

152import qualified Data.Foldable as F (all)

146−import qualified Data.HashMap.Strict as H (difference, fromList, keys, lookup, toList)

153+import qualified Data.HashMap.Strict as H (lookup, toList)

147import qualified Data.List.NonEmpty as NE (length, reverse)

154import qualified Data.List.NonEmpty as NE (length, reverse)

148import qualified Data.Map as M (fromList, keys, lookup , singleton, size)

155import qualified Data.Map as M (fromList, keys, lookup , singleton, size)

149import qualified Data.Semigroup as Semigroup (Option(..))

156import qualified Data.Semigroup as Semigroup (Option(..))

@@ -922,32 +929,12 @@ parseRecord :: JSONClass

922 -> Name

929 -> Name

923 -> [Name]

930 -> [Name]

924 -> Name

931 -> Name

925− -> Bool

926 -> ExpQ

932 -> ExpQ

927−parseRecord jc tvMap argTys opts tName conName fields obj inTaggedObject =

933+parseRecord jc tvMap argTys opts tName conName fields obj =

928− (if rejectUnknownFields opts

929− then infixApp checkUnknownRecords [|(>>)|]

930− else id) $

931 foldl' (\a b -> infixApp a [|(<*>)|] b)

934 foldl' (\a b -> infixApp a [|(<*>)|] b)

932 (infixApp (conE conName) [|(<$>)|] x)

935 (infixApp (conE conName) [|(<$>)|] x)

933 xs

936 xs

934 where

937 where

935− tagFieldNameAppender =

936− if inTaggedObject then (tagFieldName (sumEncoding opts) :) else id

937− knownFields = appE [|H.fromList|] $ listE $

938− map (\knownName -> tupE [appE [|T.pack|] $ litE $ stringL knownName, [|()|]]) $

939− tagFieldNameAppender $ map nameBase fields

940− checkUnknownRecords =

941− caseE (appE [|H.keys|] $ infixApp (varE obj) [|H.difference|] knownFields)

942− [ match (listP []) (normalB [|return ()|]) []

943− , newName "unknownFields" >>=

944− \unknownFields -> match (varP unknownFields)

945− (normalB $ appE [|fail|] $ infixApp

946− (litE (stringL "Unknown fields: "))

947− [|(++)|]

948− (appE [|show|] (varE unknownFields)))

949− []

950− ]

951 x:xs = [ [|lookupField|]

938 x:xs = [ [|lookupField|]

952 `appE` dispatchParseJSON jc conName tvMap argTy

939 `appE` dispatchParseJSON jc conName tvMap argTy

953 `appE` litE (stringL $ show tName)

940 `appE` litE (stringL $ show tName)

@@ -1022,7 +1009,7 @@ parseArgs jc tvMap tName opts

1022 , constructorFields = argTys }

1009 , constructorFields = argTys }

1023 (Left (_, obj)) = do

1010 (Left (_, obj)) = do

1024 argTys' <- mapM resolveTypeSynonyms argTys

1011 argTys' <- mapM resolveTypeSynonyms argTys

1025− parseRecord jc tvMap argTys' opts tName conName fields obj True

1012+ parseRecord jc tvMap argTys' opts tName conName fields obj

1026parseArgs jc tvMap tName opts

1013parseArgs jc tvMap tName opts

1027 info@ConstructorInfo { constructorName = conName

1014 info@ConstructorInfo { constructorName = conName

1028 , constructorVariant = RecordConstructor fields

1015 , constructorVariant = RecordConstructor fields

@@ -1037,7 +1024,7 @@ parseArgs jc tvMap tName opts

1037 argTys' <- mapM resolveTypeSynonyms argTys

1024 argTys' <- mapM resolveTypeSynonyms argTys

1038 caseE (varE valName)

1025 caseE (varE valName)

1039 [ match (conP 'Object [varP obj]) (normalB $

1026 [ match (conP 'Object [varP obj]) (normalB $

1040− parseRecord jc tvMap argTys' opts tName conName fields obj False) []

1027+ parseRecord jc tvMap argTys' opts tName conName fields obj) []

1041 , matchFailed tName conName "Object"

1028 , matchFailed tName conName "Object"

1042 ]

1029 ]

1043

1030

@@ -1603,13 +1590,21 @@ type TyVarMap = Map Name (Name, Name)

1603-- | Returns True if a Type has kind *.

1590-- | Returns True if a Type has kind *.

1604hasKindStar :: Type -> Bool

1591hasKindStar :: Type -> Bool

1605hasKindStar VarT{} = True

1592hasKindStar VarT{} = True

1593+#if MIN_VERSION_template_haskell(2,8,0)

1606hasKindStar (SigT _ StarT) = True

1594hasKindStar (SigT _ StarT) = True

1595+#else

1596+hasKindStar (SigT _ StarK) = True

1597+#endif

1607hasKindStar _ = False

1598hasKindStar _ = False

1608

1599

1609-- Returns True is a kind is equal to *, or if it is a kind variable.

1600-- Returns True is a kind is equal to *, or if it is a kind variable.

1610isStarOrVar :: Kind -> Bool

1601isStarOrVar :: Kind -> Bool

1602+#if MIN_VERSION_template_haskell(2,8,0)

1611isStarOrVar StarT = True

1603isStarOrVar StarT = True

1612isStarOrVar VarT{} = True

1604isStarOrVar VarT{} = True

1605+#else

1606+isStarOrVar StarK = True

1607+#endif

1613isStarOrVar _ = False

1608isStarOrVar _ = False

1614

1609

1615-- Generate a list of fresh names with a common prefix, and numbered suffixes.

1610-- Generate a list of fresh names with a common prefix, and numbered suffixes.

@@ -1667,7 +1662,9 @@ isTyFamily (ConT n) = do

1667#else

1662#else

1668 FamilyI (FamilyD TypeFam _ _ _) _ -> True

1663 FamilyI (FamilyD TypeFam _ _ _) _ -> True

1669#endif

1664#endif

1665+#if MIN_VERSION_template_haskell(2,9,0)

1670 FamilyI ClosedTypeFamilyD{} _ -> True

1666 FamilyI ClosedTypeFamilyD{} _ -> True

1667+#endif

1671 _ -> False

1668 _ -> False

1672isTyFamily _ = return False

1669isTyFamily _ = return False

1673

1670

@@ -1695,7 +1692,9 @@ mentionsName = go

1695 go :: Type -> [Name] -> Bool

1692 go :: Type -> [Name] -> Bool

1696 go (AppT t1 t2) names = go t1 names || go t2 names

1693 go (AppT t1 t2) names = go t1 names || go t2 names

1697 go (SigT t _k) names = go t names

1694 go (SigT t _k) names = go t names

1695+#if MIN_VERSION_template_haskell(2,8,0)

1698 || go _k names

1696 || go _k names

1697+#endif

1699 go (VarT n) names = n `elem` names

1698 go (VarT n) names = n `elem` names

1700 go _ _ = False

1699 go _ _ = False

1701

1700

@@ -1751,14 +1750,23 @@ uncurryTy t = ([], t :| [])

1751

1750

1752-- | Like uncurryType, except on a kind level.

1751-- | Like uncurryType, except on a kind level.

1753uncurryKind :: Kind -> NonEmpty Kind

1752uncurryKind :: Kind -> NonEmpty Kind

1753+#if MIN_VERSION_template_haskell(2,8,0)

1754uncurryKind = snd . uncurryTy

1755+#else

1756+uncurryKind (ArrowK k1 k2) = k1 <| uncurryKind k2

1757+uncurryKind k = k :| []

1758+#endif

1755

1759

1756createKindChain :: Int -> Kind

1760createKindChain :: Int -> Kind

1757createKindChain = go starK

1761createKindChain = go starK

1758 where

1762 where

1759 go :: Kind -> Int -> Kind

1763 go :: Kind -> Int -> Kind

1760 go k 0 = k

1764 go k 0 = k

1765+#if MIN_VERSION_template_haskell(2,8,0)

1761 go k !n = go (AppT (AppT ArrowT StarT) k) (n - 1)

1766 go k !n = go (AppT (AppT ArrowT StarT) k) (n - 1)

1767+#else

1768+ go k !n = go (ArrowK StarK k) (n - 1)

1769+#endif

1762

1770

1763-- | Makes a string literal expression from a constructor's name.

1771-- | Makes a string literal expression from a constructor's name.

1764conNameExp :: Options -> ConstructorInfo -> Q Exp

1772conNameExp :: Options -> ConstructorInfo -> Q Exp

@@ -1812,7 +1820,11 @@ canEtaReduce remaining dropped =

1812-------------------------------------------------------------------------------

1820-------------------------------------------------------------------------------

1813

1821

1814applySubstitutionKind :: Map Name Kind -> Type -> Type

1822applySubstitutionKind :: Map Name Kind -> Type -> Type

1823+#if MIN_VERSION_template_haskell(2,8,0)

1815applySubstitutionKind = applySubstitution

1824applySubstitutionKind = applySubstitution

1825+#else

1826+applySubstitutionKind _ t = t

1827+#endif

1816

1828

1817substNameWithKind :: Name -> Kind -> Type -> Type

1829substNameWithKind :: Name -> Kind -> Type -> Type

1818substNameWithKind n k = applySubstitutionKind (M.singleton n k)

1830substNameWithKind n k = applySubstitutionKind (M.singleton n k)

@@ -1976,7 +1988,9 @@ data StarKindStatus = NotKindStar

1976canRealizeKindStar :: Type -> StarKindStatus

1988canRealizeKindStar :: Type -> StarKindStatus

1977canRealizeKindStar t = case t of

1989canRealizeKindStar t = case t of

1978 _ | hasKindStar t -> KindStar

1990 _ | hasKindStar t -> KindStar

1991+#if MIN_VERSION_template_haskell(2,8,0)

1979 SigT _ (VarT k) -> IsKindVar k

1992 SigT _ (VarT k) -> IsKindVar k

1993+#endif

1980 _ -> NotKindStar

1994 _ -> NotKindStar

1981

1995

1982-- | Returns 'Just' the kind variable 'Name' of a 'StarKindStatus' if it exists.

1996-- | Returns 'Just' the kind variable 'Name' of a 'StarKindStatus' if it exists.

Data/Aeson/Types.hs−1

@@ -124,7 +124,6 @@ module Data.Aeson.Types

124 , sumEncoding

125 , unwrapUnaryRecords

126 , tagSingleConstructors

127− , rejectUnknownFields

128

127

129 -- ** Options utilities

128 -- ** Options utilities

130 , SumEncoding(..)

129 , SumEncoding(..)

Data/Aeson/Types/FromJSON.hs+62−75

@@ -7,14 +7,16 @@

7{-# LANGUAGE MultiParamTypeClasses #-}

8{-# LANGUAGE NoImplicitPrelude #-}

9{-# LANGUAGE OverloadedStrings #-}

10−{-# LANGUAGE PolyKinds #-}

11{-# LANGUAGE RecordWildCards #-}

10{-# LANGUAGE RecordWildCards #-}

12{-# LANGUAGE ScopedTypeVariables #-}

11{-# LANGUAGE ScopedTypeVariables #-}

13{-# LANGUAGE TypeOperators #-}

12{-# LANGUAGE TypeOperators #-}

14−{-# LANGUAGE TupleSections #-}

15{-# LANGUAGE UndecidableInstances #-}

13{-# LANGUAGE UndecidableInstances #-}

16{-# LANGUAGE ViewPatterns #-}

14{-# LANGUAGE ViewPatterns #-}

16+#if __GLASGOW_HASKELL__ >= 706

17+{-# LANGUAGE PolyKinds #-}

18+#endif

19+

18#include "incoherent-compat.h"

20#include "incoherent-compat.h"

19#include "overlapping-compat.h"

21#include "overlapping-compat.h"

@@ -118,9 +120,9 @@ import GHC.Generics

118import Numeric.Natural (Natural)

120import Numeric.Natural (Natural)

119import Text.ParserCombinators.ReadP (readP_to_S)

121import Text.ParserCombinators.ReadP (readP_to_S)

120import Unsafe.Coerce (unsafeCoerce)

122import Unsafe.Coerce (unsafeCoerce)

123+import qualified Data.Aeson.Compat as Compat

121import qualified Data.Aeson.Parser.Time as Time

124import qualified Data.Aeson.Parser.Time as Time

122import qualified Data.Attoparsec.ByteString.Char8 as A (endOfInput, parseOnly, scientific)

125import qualified Data.Attoparsec.ByteString.Char8 as A (endOfInput, parseOnly, scientific)

123−import qualified Data.ByteString.Lazy as L

124import qualified Data.DList as DList

126import qualified Data.DList as DList

125import qualified Data.HashMap.Strict as H

127import qualified Data.HashMap.Strict as H

126import qualified Data.HashSet as HashSet

128import qualified Data.HashSet as HashSet

@@ -155,8 +157,18 @@ import qualified Data.Primitive.UnliftedArray as PM

155import qualified Data.Primitive.PrimArray as PM

157import qualified Data.Primitive.PrimArray as PM

156#endif

158#endif

157

159

160+#ifndef HAS_COERCIBLE

161+#define HAS_COERCIBLE (__GLASGOW_HASKELL__ >= 707)

162+#endif

158

163

164+#if HAS_COERCIBLE

159import Data.Coerce (Coercible, coerce)

165import Data.Coerce (Coercible, coerce)

166+coerce' :: Coercible a b => a -> b

167+coerce' = coerce

168+#else

169+coerce' :: a -> b

170+coerce' = unsafeCoerce

171+#endif

160

172

161parseIndexedJSON :: (Value -> Parser a) -> Int -> Value -> Parser a

173parseIndexedJSON :: (Value -> Parser a) -> Int -> Value -> Parser a

162parseIndexedJSON p idx value = p value <?> Index idx

174parseIndexedJSON p idx value = p value <?> Index idx

@@ -428,7 +440,11 @@ class FromJSONKey a where

428-- At the moment this type is intentionally not exported. 'FromJSONKeyFunction'

440-- At the moment this type is intentionally not exported. 'FromJSONKeyFunction'

429-- can be inspected, but cannot be constructed.

441-- can be inspected, but cannot be constructed.

430data CoerceText a where

442data CoerceText a where

443+#if HAS_COERCIBLE

431 CoerceText :: Coercible Text a => CoerceText a

444 CoerceText :: Coercible Text a => CoerceText a

445+#else

446+ CoerceText :: CoerceText a

447+#endif

432

448

433-- | This type is related to 'ToJSONKeyFunction'. If 'FromJSONKeyValue' is used in the

449-- | This type is related to 'ToJSONKeyFunction'. If 'FromJSONKeyValue' is used in the

434-- 'FromJSONKey' instance, then 'ToJSONKeyValue' should be used in the 'ToJSONKey'

450-- 'FromJSONKey' instance, then 'ToJSONKeyValue' should be used in the 'ToJSONKey'

@@ -448,7 +464,7 @@ data FromJSONKeyFunction a

448

464

449-- | Only law abiding up to interpretation

465-- | Only law abiding up to interpretation

450instance Functor FromJSONKeyFunction where

466instance Functor FromJSONKeyFunction where

451− fmap h (FromJSONKeyCoerce CoerceText) = FromJSONKeyText (h . coerce)

467+ fmap h (FromJSONKeyCoerce CoerceText) = FromJSONKeyText (h . coerce')

452 fmap h (FromJSONKeyText f) = FromJSONKeyText (h . f)

468 fmap h (FromJSONKeyText f) = FromJSONKeyText (h . f)

453 fmap h (FromJSONKeyTextParser f) = FromJSONKeyTextParser (fmap h . f)

469 fmap h (FromJSONKeyTextParser f) = FromJSONKeyTextParser (fmap h . f)

454 fmap h (FromJSONKeyValue f) = FromJSONKeyValue (fmap h . f)

470 fmap h (FromJSONKeyValue f) = FromJSONKeyValue (fmap h . f)

@@ -462,7 +478,9 @@ instance Functor FromJSONKeyFunction where

462--

478--

463-- On pre GHC 7.8 this is unconstrainted function.

479-- On pre GHC 7.8 this is unconstrainted function.

464fromJSONKeyCoerce ::

480fromJSONKeyCoerce ::

481+#if HAS_COERCIBLE

465 Coercible Text a =>

482 Coercible Text a =>

483+#endif

466 FromJSONKeyFunction a

484 FromJSONKeyFunction a

467fromJSONKeyCoerce = FromJSONKeyCoerce CoerceText

485fromJSONKeyCoerce = FromJSONKeyCoerce CoerceText

468

486

@@ -470,18 +488,29 @@ fromJSONKeyCoerce = FromJSONKeyCoerce CoerceText

470--

488--

471-- See note on 'fromJSONKeyCoerce'.

489-- See note on 'fromJSONKeyCoerce'.

472coerceFromJSONKeyFunction ::

490coerceFromJSONKeyFunction ::

491+#if HAS_COERCIBLE

473 Coercible a b =>

492 Coercible a b =>

493+#endif

474 FromJSONKeyFunction a -> FromJSONKeyFunction b

494 FromJSONKeyFunction a -> FromJSONKeyFunction b

495+#if HAS_COERCIBLE

475coerceFromJSONKeyFunction = coerce

496coerceFromJSONKeyFunction = coerce

497+#else

498+coerceFromJSONKeyFunction (FromJSONKeyCoerce CoerceText) = FromJSONKeyCoerce CoerceText

499+coerceFromJSONKeyFunction (FromJSONKeyText f) = FromJSONKeyText (coerce' . f)

500+coerceFromJSONKeyFunction (FromJSONKeyTextParser f) = FromJSONKeyTextParser (fmap coerce' . f)

501+coerceFromJSONKeyFunction (FromJSONKeyValue f) = FromJSONKeyValue (fmap coerce' . f)

502+#endif

476

503

477{-# RULES

504{-# RULES

478 "FromJSONKeyCoerce: fmap id" forall (x :: FromJSONKeyFunction a).

505 "FromJSONKeyCoerce: fmap id" forall (x :: FromJSONKeyFunction a).

479 fmap id x = x

506 fmap id x = x

480 #-}

507 #-}

508+#if HAS_COERCIBLE

481{-# RULES

509{-# RULES

482 "FromJSONKeyCoerce: fmap coerce" forall x .

510 "FromJSONKeyCoerce: fmap coerce" forall x .

483 fmap coerce x = coerceFromJSONKeyFunction x

511 fmap coerce x = coerceFromJSONKeyFunction x

484 #-}

512 #-}

513+#endif

485

514

486-- | Same as 'fmap'. Provided for the consistency with 'ToJSONKeyFunction'.

515-- | Same as 'fmap'. Provided for the consistency with 'ToJSONKeyFunction'.

487mapFromJSONKeyFunction :: (a -> b) -> FromJSONKeyFunction a -> FromJSONKeyFunction b

516mapFromJSONKeyFunction :: (a -> b) -> FromJSONKeyFunction a -> FromJSONKeyFunction b

@@ -768,13 +797,13 @@ withBoundedScientific' f v = withBoundedScientific_ id f v

768-- | A variant of 'withBoundedScientific_' parameterized by a function to apply

797-- | A variant of 'withBoundedScientific_' parameterized by a function to apply

769-- to the 'Parser' in case of failure.

798-- to the 'Parser' in case of failure.

770withBoundedScientific_ :: (Parser a -> Parser a) -> (Scientific -> Parser a) -> Value -> Parser a

799withBoundedScientific_ :: (Parser a -> Parser a) -> (Scientific -> Parser a) -> Value -> Parser a

771−withBoundedScientific_ whenFail f (Number scientific) =

800+withBoundedScientific_ whenFail f v@(Number scientific) =

772− if exp10 > 1024

801+ if exponent > 1024

773 then whenFail (fail msg)

802 then whenFail (fail msg)

774 else f scientific

803 else f scientific

775 where

804 where

776− exp10 = base10Exponent scientific

805+ exponent = base10Exponent scientific

777− msg = "found a number with exponent " ++ show exp10 ++ ", but it must not be greater than 1024"

806+ msg = "found a number with exponent " ++ show exponent ++ ", but it must not be greater than 1024"

778withBoundedScientific_ whenFail _ v =

807withBoundedScientific_ whenFail _ v =

779 whenFail (typeMismatch "Number" v)

808 whenFail (typeMismatch "Number" v)

780{-# INLINE withBoundedScientific_ #-}

809{-# INLINE withBoundedScientific_ #-}

@@ -794,7 +823,7 @@ withBool name _ v = prependContext name (typeMismatch "Boolean" v)

794-- | Decode a nested JSON-encoded string.

823-- | Decode a nested JSON-encoded string.

795withEmbeddedJSON :: String -> (Value -> Parser a) -> Value -> Parser a

824withEmbeddedJSON :: String -> (Value -> Parser a) -> Value -> Parser a

796withEmbeddedJSON _ innerParser (String txt) =

825withEmbeddedJSON _ innerParser (String txt) =

797− either fail innerParser $ eitherDecode (L.fromStrict $ T.encodeUtf8 txt)

826+ either fail innerParser $ eitherDecode (Compat.fromStrict $ T.encodeUtf8 txt)

798 where

827 where

799 eitherDecode = eitherFormatError . eitherDecodeWith jsonEOF ifromJSON

828 eitherDecode = eitherFormatError . eitherDecodeWith jsonEOF ifromJSON

800 eitherFormatError = either (Left . uncurry formatError) Right

829 eitherFormatError = either (Left . uncurry formatError) Right

@@ -1201,9 +1230,9 @@ class FromTaggedObject' arity f isRecord where

1201 :: String :* ConName :* TypeName :* Options :* FromArgs arity a

1230 :: String :* ConName :* TypeName :* Options :* FromArgs arity a

1202 -> Object -> Tagged isRecord (Parser (f a))

1231 -> Object -> Tagged isRecord (Parser (f a))

1203

1232

1204−instance (RecordFromJSON arity f, FieldNames f) => FromTaggedObject' arity f True where

1233+instance (RecordFromJSON arity f) => FromTaggedObject' arity f True where

1205 -- Records are unpacked in the tagged object

1234 -- Records are unpacked in the tagged object

1206− parseFromTaggedObject' (_ :* p) = Tagged . recordParseJSON (True :* p)

1235+ parseFromTaggedObject' (_ :* p) = Tagged . recordParseJSON p

1207

1236

1208instance (ConsFromJSON arity f) => FromTaggedObject' arity f False where

1237instance (ConsFromJSON arity f) => FromTaggedObject' arity f False where

1209 -- Nonnullary nonrecords are encoded in the contents field

1238 -- Nonnullary nonrecords are encoded in the contents field

@@ -1244,11 +1273,11 @@ instance OVERLAPPING_

1244 ) => ConsFromJSON' arity (S1 s a) True where

1273 ) => ConsFromJSON' arity (S1 s a) True where

1245 consParseJSON' p@(cname :* tname :* opts :* fargs)

1274 consParseJSON' p@(cname :* tname :* opts :* fargs)

1246 | unwrapUnaryRecords opts = Tagged . fmap M1 . gParseJSON opts fargs

1275 | unwrapUnaryRecords opts = Tagged . fmap M1 . gParseJSON opts fargs

1247− | otherwise = Tagged . withObject (showCons cname tname) (recordParseJSON (False :* p))

1276+ | otherwise = Tagged . withObject (showCons cname tname) (recordParseJSON p)

1248

1277

1249instance RecordFromJSON arity f => ConsFromJSON' arity f True where

1278instance RecordFromJSON arity f => ConsFromJSON' arity f True where

1250 consParseJSON' p@(cname :* tname :* _) =

1279 consParseJSON' p@(cname :* tname :* _) =

1251− Tagged . withObject (showCons cname tname) (recordParseJSON (False :* p))

1280+ Tagged . withObject (showCons cname tname) (recordParseJSON p)

1252

1281

1253instance OVERLAPPING_

1282instance OVERLAPPING_

1254 ConsFromJSON' arity U1 False where

1283 ConsFromJSON' arity U1 False where

@@ -1274,55 +1303,21 @@ instance (ProductFromJSON arity f, ProductSize f

1274

1303

1275--------------------------------------------------------------------------------

1304--------------------------------------------------------------------------------

1276

1305

1277−class FieldNames f where

1278− fieldNames :: f a -> [Text] -> [Text]

1279−

1280−instance (FieldNames a, FieldNames b) => FieldNames (a :*: b) where

1281− fieldNames _ =

1282− fieldNames (undefined :: a x) .

1283− fieldNames (undefined :: b y)

1284−

1285−instance (Selector s) => FieldNames (S1 s f) where

1286− fieldNames _ = (pack (selName (undefined :: M1 _i s _f _p)) :)

1287−

1288class RecordFromJSON arity f where

1306class RecordFromJSON arity f where

1289 recordParseJSON

1307 recordParseJSON

1290− :: Bool :* ConName :* TypeName :* Options :* FromArgs arity a

1291− -> Object -> Parser (f a)

1292−

1293−instance ( FieldNames f

1294− , RecordFromJSON' arity f

1295− ) => RecordFromJSON arity f where

1296− recordParseJSON (fromTaggedSum :* p@(cname :* tname :* opts :* _)) =

1297− \obj -> checkUnknown obj >> recordParseJSON' p obj

1298− where

1299− knownFields :: H.HashMap Text ()

1300− knownFields = H.fromList $ map (,()) $

1301− fieldNames (undefined :: f a)

1302− [pack (tagFieldName (sumEncoding opts)) | fromTaggedSum]

1303− checkUnknown =

1304− if not (rejectUnknownFields opts)

1305− then \_ -> return ()

1306− else \obj -> case H.keys (H.difference obj knownFields) of

1307− [] -> return ()

1308− unknownFields -> contextCons cname tname $

1309− fail ("unknown fields: " ++ show unknownFields)

1310−

1311−class RecordFromJSON' arity f where

1312− recordParseJSON'

1313 :: ConName :* TypeName :* Options :* FromArgs arity a

1308 :: ConName :* TypeName :* Options :* FromArgs arity a

1314 -> Object -> Parser (f a)

1309 -> Object -> Parser (f a)

1315

1310

1316−instance ( RecordFromJSON' arity a

1311+instance ( RecordFromJSON arity a

1317− , RecordFromJSON' arity b

1312+ , RecordFromJSON arity b

1318− ) => RecordFromJSON' arity (a :*: b) where

1313+ ) => RecordFromJSON arity (a :*: b) where

1319− recordParseJSON' p obj =

1314+ recordParseJSON p obj =

1320− (:*:) <$> recordParseJSON' p obj

1315+ (:*:) <$> recordParseJSON p obj

1321− <*> recordParseJSON' p obj

1316+ <*> recordParseJSON p obj

1322

1317

1323instance OVERLAPPABLE_ (Selector s, GFromJSON arity a) =>

1318instance OVERLAPPABLE_ (Selector s, GFromJSON arity a) =>

1324− RecordFromJSON' arity (S1 s a) where

1319+ RecordFromJSON arity (S1 s a) where

1325− recordParseJSON' (cname :* tname :* opts :* fargs) obj = do

1320+ recordParseJSON (cname :* tname :* opts :* fargs) obj = do

1326 fv <- contextCons cname tname (obj .: label)

1321 fv <- contextCons cname tname (obj .: label)

1327 M1 <$> gParseJSON opts fargs fv <?> Key label

1322 M1 <$> gParseJSON opts fargs fv <?> Key label

1328 where

1323 where

@@ -1330,16 +1325,16 @@ instance OVERLAPPABLE_ (Selector s, GFromJSON arity a) =>

1330 sname = selName (undefined :: M1 _i s _f _p)

1325 sname = selName (undefined :: M1 _i s _f _p)

1331

1326

1332instance INCOHERENT_ (Selector s, FromJSON a) =>

1327instance INCOHERENT_ (Selector s, FromJSON a) =>

1333− RecordFromJSON' arity (S1 s (K1 i (Maybe a))) where

1328+ RecordFromJSON arity (S1 s (K1 i (Maybe a))) where

1334− recordParseJSON' (_ :* _ :* opts :* _) obj = M1 . K1 <$> obj .:? pack label

1329+ recordParseJSON (_ :* _ :* opts :* _) obj = M1 . K1 <$> obj .:? pack label

1335 where

1330 where

1336 label = fieldLabelModifier opts sname

1331 label = fieldLabelModifier opts sname

1337 sname = selName (undefined :: M1 _i s _f _p)

1332 sname = selName (undefined :: M1 _i s _f _p)

1338

1333

1339-- Parse an Option like a Maybe.

1334-- Parse an Option like a Maybe.

1340instance INCOHERENT_ (Selector s, FromJSON a) =>

1335instance INCOHERENT_ (Selector s, FromJSON a) =>

1341− RecordFromJSON' arity (S1 s (K1 i (Semigroup.Option a))) where

1336+ RecordFromJSON arity (S1 s (K1 i (Semigroup.Option a))) where

1342− recordParseJSON' p obj = wrap <$> recordParseJSON' p obj

1337+ recordParseJSON p obj = wrap <$> recordParseJSON p obj

1343 where

1338 where

1344 wrap :: S1 s (K1 i (Maybe a)) p -> S1 s (K1 i (Semigroup.Option a)) p

1339 wrap :: S1 s (K1 i (Maybe a)) p -> S1 s (K1 i (Semigroup.Option a)) p

1345 wrap (M1 (K1 a)) = M1 (K1 (Semigroup.Option a))

1340 wrap (M1 (K1 a)) = M1 (K1 (Semigroup.Option a))

@@ -1576,22 +1571,12 @@ instance FromJSONKey Float where

1576 _ -> Scientific.toRealFloat <$> parseScientificText t

1571 _ -> Scientific.toRealFloat <$> parseScientificText t

1577

1572

1578instance (FromJSON a, Integral a) => FromJSON (Ratio a) where

1573instance (FromJSON a, Integral a) => FromJSON (Ratio a) where

1579− parseJSON (Number x)

1580− | exp10 <= 1024

1581− , exp10 >= -1024 = return $! realToFrac x

1582− | otherwise = prependContext "Ratio" $ fail msg

1583− where

1584− exp10 = base10Exponent x

1585− msg = "found a number with exponent " ++ show exp10

1586− ++ ", but it must not be greater than 1024 or less than -1024"

1587− parseJSON o = objParser o

1588− where

1589− objParser = withObject "Rational" $ \obj -> do

1574+ parseJSON = withObject "Rational" $ \obj -> do

1590− numerator <- obj .: "numerator"

1575+ numerator <- obj .: "numerator"

1591− denominator <- obj .: "denominator"

1576+ denominator <- obj .: "denominator"

1592− if denominator == 0

1577+ if denominator == 0

1593− then fail "Ratio denominator was 0"

1578+ then fail "Ratio denominator was 0"

1594− else pure $ numerator % denominator

1579+ else pure $ numerator % denominator

1595 {-# INLINE parseJSON #-}

1580 {-# INLINE parseJSON #-}

1596

1581

1597-- | This instance includes a bounds check to prevent maliciously

1582-- | This instance includes a bounds check to prevent maliciously

@@ -2006,6 +1991,7 @@ instance FromJSON DotNetTime where

2006-- primitive

1991-- primitive

2007-------------------------------------------------------------------------------

1992-------------------------------------------------------------------------------

2008

1993

1994+#if MIN_VERSION_base(4,7,0)

2009instance FromJSON a => FromJSON (PM.Array a) where

1995instance FromJSON a => FromJSON (PM.Array a) where

2010 -- note: we could do better than this if vector exposed the data

1996 -- note: we could do better than this if vector exposed the data

2011 -- constructor in Data.Vector.

1997 -- constructor in Data.Vector.

@@ -2023,6 +2009,7 @@ instance (PM.PrimUnlifted a,FromJSON a) => FromJSON (PM.UnliftedArray a) where

2023 parseJSON = fmap Exts.fromList . parseJSON

2009 parseJSON = fmap Exts.fromList . parseJSON

2024#endif

2010#endif

2025#endif

2011#endif

2012+#endif

2026

2013

2027-------------------------------------------------------------------------------

2014-------------------------------------------------------------------------------

2028-- time

2015-- time

Data/Aeson/Types/Internal.hs+1−9

@@ -64,7 +64,6 @@ module Data.Aeson.Types.Internal

64 , sumEncoding

65 , unwrapUnaryRecords

66 , tagSingleConstructors

67− , rejectUnknownFields

68 )

67 )

70 , SumEncoding(..)

69 , SumEncoding(..)

@@ -625,14 +624,10 @@ data Options = Options

625 , tagSingleConstructors :: Bool

624 , tagSingleConstructors :: Bool

626 -- ^ Encode types with a single constructor as sums,

625 -- ^ Encode types with a single constructor as sums,

627 -- so that `allNullaryToStringTag` and `sumEncoding` apply.

626 -- so that `allNullaryToStringTag` and `sumEncoding` apply.

628− , rejectUnknownFields :: Bool

629− -- ^ Applies only to 'Data.Aeson.FromJSON' instances. If a field appears in

630− -- the parsed object map, but does not appear in the target object, parsing

631− -- will fail, with an error message indicating which fields were unknown.

632 }

627 }

633

628

634instance Show Options where

629instance Show Options where

635− show (Options f c a o s u t r) =

630+ show (Options f c a o s u t) =

636 "Options {"

631 "Options {"

637 ++ intercalate ", "

632 ++ intercalate ", "

638 [ "fieldLabelModifier =~ " ++ show (f "exampleField")

633 [ "fieldLabelModifier =~ " ++ show (f "exampleField")

@@ -642,7 +637,6 @@ instance Show Options where

642 , "sumEncoding = " ++ show s

637 , "sumEncoding = " ++ show s

643 , "unwrapUnaryRecords = " ++ show u

638 , "unwrapUnaryRecords = " ++ show u

644 , "tagSingleConstructors = " ++ show t

639 , "tagSingleConstructors = " ++ show t

645− , "rejectUnknownFields = " ++ show r

646 ]

640 ]

647 ++ "}"

641 ++ "}"

648

642

@@ -724,7 +718,6 @@ data JSONKeyOptions = JSONKeyOptions

724-- , 'sumEncoding' = 'defaultTaggedObject'

718-- , 'sumEncoding' = 'defaultTaggedObject'

725-- , 'unwrapUnaryRecords' = False

719-- , 'unwrapUnaryRecords' = False

726-- , 'tagSingleConstructors' = False

720-- , 'tagSingleConstructors' = False

727−-- , 'rejectUnknownFields' = False

728-- }

721-- }

729-- @

722-- @

730defaultOptions :: Options

723defaultOptions :: Options

@@ -736,7 +729,6 @@ defaultOptions = Options

736 , sumEncoding = defaultTaggedObject

729 , sumEncoding = defaultTaggedObject

737 , unwrapUnaryRecords = False

730 , unwrapUnaryRecords = False

738 , tagSingleConstructors = False

731 , tagSingleConstructors = False

739− , rejectUnknownFields = False

740 }

732 }

741

733

742-- | Default 'TaggedObject' 'SumEncoding' options:

734-- | Default 'TaggedObject' 'SumEncoding' options:

Data/Aeson/Types/ToJSON.hs+42−3

@@ -8,12 +8,15 @@

8{-# LANGUAGE NoImplicitPrelude #-}

9{-# LANGUAGE OverloadedStrings #-}

10{-# LANGUAGE PatternGuards #-}

11−{-# LANGUAGE PolyKinds #-}

12{-# LANGUAGE RecordWildCards #-}

11{-# LANGUAGE RecordWildCards #-}

13{-# LANGUAGE ScopedTypeVariables #-}

12{-# LANGUAGE ScopedTypeVariables #-}

14{-# LANGUAGE TypeOperators #-}

13{-# LANGUAGE TypeOperators #-}

15{-# LANGUAGE UndecidableInstances #-}

14{-# LANGUAGE UndecidableInstances #-}

16+#if __GLASGOW_HASKELL__ >= 706

17+{-# LANGUAGE PolyKinds #-}

18+#endif

19+

17#include "overlapping-compat.h"

20#include "overlapping-compat.h"

18#include "incoherent-compat.h"

21#include "incoherent-compat.h"

@@ -100,6 +103,7 @@ import GHC.Generics

100import Numeric.Natural (Natural)

103import Numeric.Natural (Natural)

101import qualified Data.Aeson.Encoding as E

104import qualified Data.Aeson.Encoding as E

102import qualified Data.Aeson.Encoding.Internal as E (InArray, comma, econcat, retagEncoding)

105import qualified Data.Aeson.Encoding.Internal as E (InArray, comma, econcat, retagEncoding)

106+import qualified Data.ByteString as S

103import qualified Data.ByteString.Lazy as L

107import qualified Data.ByteString.Lazy as L

104import qualified Data.DList as DList

108import qualified Data.DList as DList

105import qualified Data.HashMap.Strict as H

109import qualified Data.HashMap.Strict as H

@@ -140,6 +144,14 @@ import qualified Data.Primitive.UnliftedArray as PM

140import qualified Data.Primitive.PrimArray as PM

144import qualified Data.Primitive.PrimArray as PM

141#endif

145#endif

142

146

147+#if !(MIN_VERSION_bytestring(0,10,0))

148+import Foreign.ForeignPtr (withForeignPtr)

149+import Foreign.Marshal.Utils (copyBytes)

150+import Foreign.Ptr (plusPtr)

151+import qualified Data.ByteString.Internal as S

152+import qualified Data.ByteString.Lazy.Internal as L

153+#endif

154+

143toJSONPair :: (a -> Value) -> (b -> Value) -> (a, b) -> Value

155toJSONPair :: (a -> Value) -> (b -> Value) -> (a, b) -> Value

144toJSONPair a b = liftToJSON2 a (listValue a) b (listValue b)

156toJSONPair a b = liftToJSON2 a (listValue a) b (listValue b)

145{-# INLINE toJSONPair #-}

157{-# INLINE toJSONPair #-}

@@ -503,7 +515,7 @@ toJSONKeyTextEnc e = ToJSONKeyText tot e

503 -- TODO: dropAround is also used in stringEncoding, which is unfortunate atm

515 -- TODO: dropAround is also used in stringEncoding, which is unfortunate atm

504 tot = T.dropAround (== '"')

516 tot = T.dropAround (== '"')

505 . T.decodeLatin1

517 . T.decodeLatin1

506− . L.toStrict

518+ . lazyToStrictByteString

507 . E.encodingToLazyByteString

519 . E.encodingToLazyByteString

508 . e

520 . e

509

521

@@ -1970,6 +1982,7 @@ formatMillis = take 3 . formatTime defaultTimeLocale "%q"

1970-- primitive

1982-- primitive

1971-------------------------------------------------------------------------------

1983-------------------------------------------------------------------------------

1972

1984

1985+#if MIN_VERSION_base(4,7,0)

1973instance ToJSON a => ToJSON (PM.Array a) where

1986instance ToJSON a => ToJSON (PM.Array a) where

1974 -- note: we could do better than this if vector exposed the data

1987 -- note: we could do better than this if vector exposed the data

1975 -- constructor in Data.Vector.

1988 -- constructor in Data.Vector.

@@ -1991,6 +2004,7 @@ instance (PM.PrimUnlifted a,ToJSON a) => ToJSON (PM.UnliftedArray a) where

1991 toEncoding = toEncoding . Exts.toList

2004 toEncoding = toEncoding . Exts.toList

1992#endif

2005#endif

1993#endif

2006#endif

2007+#endif

1994

2008

1995-------------------------------------------------------------------------------

2009-------------------------------------------------------------------------------

1996-- time

2010-- time

@@ -2040,7 +2054,7 @@ stringEncoding :: Encoding' Text -> Value

2040stringEncoding = String

2054stringEncoding = String

2041 . T.dropAround (== '"')

2055 . T.dropAround (== '"')

2042 . T.decodeLatin1

2056 . T.decodeLatin1

2043− . L.toStrict

2057+ . lazyToStrictByteString

2044 . E.encodingToLazyByteString

2058 . E.encodingToLazyByteString

2045{-# INLINE stringEncoding #-}

2059{-# INLINE stringEncoding #-}

2046

2060

@@ -2847,6 +2861,31 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,

2847 toEncoding = toEncoding2

2861 toEncoding = toEncoding2

2848 {-# INLINE toEncoding #-}

2862 {-# INLINE toEncoding #-}

2849

2863

2864+-------------------------------------------------------------------------------

2865+-- pre-bytestring-0.10 compatibility

2866+-------------------------------------------------------------------------------

2867+

2868+{-# INLINE lazyToStrictByteString #-}

2869+lazyToStrictByteString :: L.ByteString -> S.ByteString

2870+#if MIN_VERSION_bytestring(0,10,0)

2871+lazyToStrictByteString = L.toStrict

2872+#else

2873+lazyToStrictByteString = packChunks

2874+

2875+-- packChunks is taken from the blaze-builder package.

2876+

2877+-- | Pack the chunks of a lazy bytestring into a single strict bytestring.

2878+packChunks :: L.ByteString -> S.ByteString

2879+packChunks lbs =

2880+ S.unsafeCreate (fromIntegral $ L.length lbs) (copyChunks lbs)

2881+ where

2882+ copyChunks L.Empty _pf = return ()

2883+ copyChunks (L.Chunk (S.PS fpbuf o l) lbs') pf = do

2884+ withForeignPtr fpbuf $ \pbuf ->

2885+ copyBytes pf (pbuf `plusPtr` o) l

2886+ copyChunks lbs' (pf `plusPtr` l)

2887+#endif

2888+

2850--------------------------------------------------------------------------------

2889--------------------------------------------------------------------------------

2851

2890

2852-- | Wrap a list of pairs as an object.

2891-- | Wrap a list of pairs as an object.

aeson.cabal+10−4

@@ -88,6 +88,7 @@ library

88 Data.Aeson.Encode

90 other-modules:

91+ Data.Aeson.Compat

91 Data.Aeson.Encoding.Builder

92 Data.Aeson.Encoding.Builder

92 Data.Aeson.Internal.Functions

93 Data.Aeson.Internal.Functions

93 Data.Aeson.Parser.Unescape

94 Data.Aeson.Parser.Unescape

@@ -102,12 +103,11 @@ library

102

103

103 -- GHC bundled libs

104 -- GHC bundled libs

104 build-depends:

105 build-depends:

105− base >= 4.7.0.0 && < 5,

106+ base >= 4.5.0.0 && < 5,

106− bytestring >= 0.10.4.0 && < 0.11,

107− containers >= 0.5.5.1 && < 0.7,

107+ containers >= 0.4.2.1 && < 0.7,

108 deepseq >= 1.3.0.0 && < 1.5,

109 ghc-prim >= 0.2 && < 0.6,

110− template-haskell >= 2.9.0.0 && < 2.16,

110+ template-haskell >= 2.7.0.0 && < 2.16,

111 text >= 1.2.3.0 && < 1.3,

112 time >= 1.4 && < 1.10

113

@@ -119,6 +119,12 @@ library

119 base-compat >= 0.9.1 && < 0.12,

120 time-compat >= 1.9.2.2 && < 1.10

121

122+ if flag(bytestring-builder)

123+ build-depends: bytestring >= 0.9.2.1 && < 0.10.4,

124+ bytestring-builder >= 0.10.4 && < 1

125+ else

126+ build-depends: bytestring >= 0.10.4 && < 0.11

127+

122 if !impl(ghc >= 8.6)

128 if !impl(ghc >= 8.6)

123 build-depends:

129 build-depends:

124 contravariant >=1.4.1 && <1.6

130 contravariant >=1.4.1 && <1.6

attoparsec-iso8601/Data/Attoparsec/Time/Internal.hs+20

@@ -29,8 +29,16 @@ import Data.Time.Clock (diffTimeToPicoseconds)

30#endif

32+#if MIN_VERSION_base(4,7,0)

33+

32import Data.Fixed (Pico, Fixed(MkFixed))

34import Data.Fixed (Pico, Fixed(MkFixed))

36+#else

37+

38+import Data.Fixed (Pico)

39+

40+#endif

41+

34#if !MIN_VERSION_time(1,6,0)

42#if !MIN_VERSION_time(1,6,0)

36diffTimeToPicoseconds :: DiffTime -> Integer

44diffTimeToPicoseconds :: DiffTime -> Integer

@@ -38,12 +46,24 @@ diffTimeToPicoseconds = unsafeCoerce

39#endif

47#endif

49+#if MIN_VERSION_base(4,7,0)

50+

41toPico :: Integer -> Pico

51toPico :: Integer -> Pico

42toPico = MkFixed

52toPico = MkFixed

44fromPico :: Pico -> Integer

54fromPico :: Pico -> Integer

45fromPico (MkFixed i) = i

55fromPico (MkFixed i) = i

57+#else

58+

59+toPico :: Integer -> Pico

60+toPico = unsafeCoerce

61+

62+fromPico :: Pico -> Integer

63+fromPico = unsafeCoerce

64+

65+#endif

66+

47-- | Like TimeOfDay, but using a fixed-width integer for seconds.

67-- | Like TimeOfDay, but using a fixed-width integer for seconds.

48data TimeOfDay64 = TOD {-# UNPACK #-} !Int

68data TimeOfDay64 = TOD {-# UNPACK #-} !Int

49 {-# UNPACK #-} !Int

69 {-# UNPACK #-} !Int

attoparsec-iso8601/attoparsec-iso8601.cabal+1−1

@@ -36,7 +36,7 @@ library

36 Data.Attoparsec.Time

37 build-depends:

38 attoparsec >= 0.13.0.1,

39− base >= 4.7 && < 5,

39+ base >= 4.5 && < 5,

40 base-compat >= 0.9.1 && < 0.12,

41 text >= 1.1.1.0,

42 time >= 1.1.1.4

benchmarks/aeson-benchmarks.cabal+1

@@ -72,6 +72,7 @@ library

73 exposed-modules:

74 Data.Aeson

75+ Data.Aeson.Compat

75 Data.Aeson.Encoding

76 Data.Aeson.Encoding

76 Data.Aeson.Encoding.Builder

77 Data.Aeson.Encoding.Builder

77 Data.Aeson.Encoding.Internal

78 Data.Aeson.Encoding.Internal

cabal.project−1

@@ -2,4 +2,3 @@ with-compiler: ghc

2packages: .

3packages: attoparsec-iso8601

4-- packages: benchmarks

5−tests: true

changelog.md−5

@@ -1,10 +1,5 @@

1For the latest version of this document, please see [https://github.com/bos/aeson/blob/master/changelog.md](https://github.com/bos/aeson/blob/master/changelog.md).

3−### upcoming

4−

5−* `FromJSON` instance of `Ratio a` now parses numbers in addtion to

6− standard `{numerator=..., denumerator=...}` encoding.

7−

8### 1.4.6.0

3### 1.4.6.0

10* Provide a clearer error message when a required tagKey for a constructor is missing, thanks to Guru Devanla.

5* Provide a clearer error message when a required tagKey for a constructor is missing, thanks to Guru Devanla.

tests/Encoders.hs+6−25

@@ -188,6 +188,7 @@ gSomeTypeToEncoding2ElemArray = genericToEncoding opts2ElemArray

188gSomeTypeParseJSON2ElemArray :: Value -> Parser (SomeType Int)

189gSomeTypeParseJSON2ElemArray = genericParseJSON opts2ElemArray

190

191+#if __GLASGOW_HASKELL__ >= 706

191gSomeTypeLiftToEncoding2ElemArray :: LiftToEncoding SomeType a

192gSomeTypeLiftToEncoding2ElemArray :: LiftToEncoding SomeType a

192gSomeTypeLiftToEncoding2ElemArray = genericLiftToEncoding opts2ElemArray

193gSomeTypeLiftToEncoding2ElemArray = genericLiftToEncoding opts2ElemArray

193

194

@@ -196,6 +197,7 @@ gSomeTypeLiftToJSON2ElemArray = genericLiftToJSON opts2ElemArray

196

197

197gSomeTypeLiftParseJSON2ElemArray :: LiftParseJSON SomeType a

198gSomeTypeLiftParseJSON2ElemArray :: LiftParseJSON SomeType a

198gSomeTypeLiftParseJSON2ElemArray = genericLiftParseJSON opts2ElemArray

199gSomeTypeLiftParseJSON2ElemArray = genericLiftParseJSON opts2ElemArray

200+#endif

199

201

200

202

201gSomeTypeToJSONTaggedObject :: SomeType Int -> Value

203gSomeTypeToJSONTaggedObject :: SomeType Int -> Value

@@ -207,6 +209,7 @@ gSomeTypeToEncodingTaggedObject = genericToEncoding optsTaggedObject

207gSomeTypeParseJSONTaggedObject :: Value -> Parser (SomeType Int)

209gSomeTypeParseJSONTaggedObject :: Value -> Parser (SomeType Int)

208gSomeTypeParseJSONTaggedObject = genericParseJSON optsTaggedObject

210gSomeTypeParseJSONTaggedObject = genericParseJSON optsTaggedObject

209

211

212+#if __GLASGOW_HASKELL__ >= 706

210gSomeTypeLiftToEncodingTaggedObject :: LiftToEncoding SomeType a

213gSomeTypeLiftToEncodingTaggedObject :: LiftToEncoding SomeType a

211gSomeTypeLiftToEncodingTaggedObject = genericLiftToEncoding optsTaggedObject

214gSomeTypeLiftToEncodingTaggedObject = genericLiftToEncoding optsTaggedObject

212

215

@@ -215,6 +218,7 @@ gSomeTypeLiftToJSONTaggedObject = genericLiftToJSON optsTaggedObject

215

218

216gSomeTypeLiftParseJSONTaggedObject :: LiftParseJSON SomeType a

219gSomeTypeLiftParseJSONTaggedObject :: LiftParseJSON SomeType a

217gSomeTypeLiftParseJSONTaggedObject = genericLiftParseJSON optsTaggedObject

220gSomeTypeLiftParseJSONTaggedObject = genericLiftParseJSON optsTaggedObject

221+#endif

218

222

219

223

220gSomeTypeToJSONObjectWithSingleField :: SomeType Int -> Value

224gSomeTypeToJSONObjectWithSingleField :: SomeType Int -> Value

@@ -226,6 +230,7 @@ gSomeTypeToEncodingObjectWithSingleField = genericToEncoding optsObjectWithSingl

226gSomeTypeParseJSONObjectWithSingleField :: Value -> Parser (SomeType Int)

230gSomeTypeParseJSONObjectWithSingleField :: Value -> Parser (SomeType Int)

227gSomeTypeParseJSONObjectWithSingleField = genericParseJSON optsObjectWithSingleField

231gSomeTypeParseJSONObjectWithSingleField = genericParseJSON optsObjectWithSingleField

228

232

233+#if __GLASGOW_HASKELL__ >= 706

229gSomeTypeLiftToEncodingObjectWithSingleField :: LiftToEncoding SomeType a

234gSomeTypeLiftToEncodingObjectWithSingleField :: LiftToEncoding SomeType a

230gSomeTypeLiftToEncodingObjectWithSingleField = genericLiftToEncoding optsObjectWithSingleField

235gSomeTypeLiftToEncodingObjectWithSingleField = genericLiftToEncoding optsObjectWithSingleField

231

236

@@ -234,6 +239,7 @@ gSomeTypeLiftToJSONObjectWithSingleField = genericLiftToJSON optsObjectWithSingl

234

239

235gSomeTypeLiftParseJSONObjectWithSingleField :: LiftParseJSON SomeType a

240gSomeTypeLiftParseJSONObjectWithSingleField :: LiftParseJSON SomeType a

236gSomeTypeLiftParseJSONObjectWithSingleField = genericLiftParseJSON optsObjectWithSingleField

241gSomeTypeLiftParseJSONObjectWithSingleField = genericLiftParseJSON optsObjectWithSingleField

242+#endif

237

243

238

244

239gSomeTypeToJSONOmitNothingFields :: SomeType Int -> Value

245gSomeTypeToJSONOmitNothingFields :: SomeType Int -> Value

@@ -243,31 +249,6 @@ gSomeTypeToEncodingOmitNothingFields :: SomeType Int -> Encoding

243gSomeTypeToEncodingOmitNothingFields = genericToEncoding optsOmitNothingFields

249gSomeTypeToEncodingOmitNothingFields = genericToEncoding optsOmitNothingFields

244

250

245

251

246−thSomeTypeParseJSONRejectUnknownFields :: Value -> Parser (SomeType Int)

247−thSomeTypeParseJSONRejectUnknownFields = $(mkParseJSON optsRejectUnknownFields ''SomeType)

248−

249−gSomeTypeParseJSONRejectUnknownFields :: Value -> Parser (SomeType Int)

250−gSomeTypeParseJSONRejectUnknownFields = genericParseJSON optsRejectUnknownFields

251−

252−

253−--------------------------------------------------------------------------------

254−-- Foo decoders

255−--------------------------------------------------------------------------------

256−

257−thFooParseJSONRejectUnknownFields :: Value -> Parser Foo

258−thFooParseJSONRejectUnknownFields = $(mkParseJSON optsRejectUnknownFields ''Foo)

259−

260−gFooParseJSONRejectUnknownFields :: Value -> Parser Foo

261−gFooParseJSONRejectUnknownFields = genericParseJSON optsRejectUnknownFields

262−

263−

264−thFooParseJSONRejectUnknownFieldsTagged :: Value -> Parser Foo

265−thFooParseJSONRejectUnknownFieldsTagged = $(mkParseJSON optsRejectUnknownFieldsTagged ''Foo)

266−

267−gFooParseJSONRejectUnknownFieldsTagged :: Value -> Parser Foo

268−gFooParseJSONRejectUnknownFieldsTagged = genericParseJSON optsRejectUnknownFieldsTagged

269−

270−

271--------------------------------------------------------------------------------

252--------------------------------------------------------------------------------

272-- Option fields

253-- Option fields

273--------------------------------------------------------------------------------

254--------------------------------------------------------------------------------

tests/ErrorMessages.hs−26

@@ -136,29 +136,6 @@ outputGeneric choice = concat

136 , "[1,"

137 ]

138

139− , testWithSomeType "SomeType (reject unknown fields)"

140− (select

141− thSomeTypeParseJSONRejectUnknownFields

142− gSomeTypeParseJSONRejectUnknownFields)

143− [ "{\"tag\": \"record\", \"testOne\": 1.0, \"testZero\": 1}"

144− , "{\"testZero\": 1}"

145− , "{\"tag\": \"record\", \"testone\": true, \"testtwo\": null, \"testthree\": null}"

146− ]

147−

148− , testWithFoo "Foo (reject unknown fields)"

149− (select

150− thFooParseJSONRejectUnknownFields

151− gFooParseJSONRejectUnknownFields)

152− [ "{\"tag\": \"foo\"}"

153− ]

154−

155− , testWithFoo "Foo (reject unknown fields, tagged single)"

156− (select

157− thFooParseJSONRejectUnknownFieldsTagged

158− gFooParseJSONRejectUnknownFieldsTagged)

159− [ "{\"tag\": \"foo\", \"unknownField\": 0}"

160− ]

161−

162 , testWith "EitherTextInt"

139 , testWith "EitherTextInt"

163 (select

140 (select

164 thEitherTextIntParseJSONUntaggedValue

141 thEitherTextIntParseJSONUntaggedValue

@@ -219,6 +196,3 @@ testFor name _ = testWith name (parseJSON :: Value -> Parser a)

219

196

220testWithSomeType :: String -> (Value -> Parser (SomeType Int)) -> [L.ByteString] -> Output

197testWithSomeType :: String -> (Value -> Parser (SomeType Int)) -> [L.ByteString] -> Output

221testWithSomeType = testWith

198testWithSomeType = testWith

222−

223−testWithFoo :: String -> (Value -> Parser Foo) -> [L.ByteString] -> Output

224−testWithFoo = testWith

tests/Instances.hs+4−1

@@ -1,3 +1,4 @@

1+{-# LANGUAGE CPP #-}

1{-# LANGUAGE FlexibleContexts #-}

2{-# LANGUAGE FlexibleContexts #-}

2{-# LANGUAGE FlexibleInstances #-}

3{-# LANGUAGE FlexibleInstances #-}

3{-# LANGUAGE NoImplicitPrelude #-}

4{-# LANGUAGE NoImplicitPrelude #-}

@@ -24,12 +25,14 @@ import qualified Data.HashMap.Strict as HM

25import Data.Orphans ()

26import Data.Orphans ()

26import Test.QuickCheck.Instances ()

27import Test.QuickCheck.Instances ()

28+#if MIN_VERSION_base(4,7,0)

27import Data.Hashable.Time ()

29import Data.Hashable.Time ()

30+#endif

29-- "System" types.

32-- "System" types.

31instance Arbitrary DotNetTime where

34instance Arbitrary DotNetTime where

32− arbitrary = DotNetTime `fmap` arbitrary

35+ arbitrary = DotNetTime `liftM` arbitrary

33 shrink = map DotNetTime . shrink . fromDotNetTime

36 shrink = map DotNetTime . shrink . fromDotNetTime

35-- | Compare timezone part only on 'timeZoneMinutes'

38-- | Compare timezone part only on 'timeZoneMinutes'

tests/Options.hs−11

@@ -55,14 +55,3 @@ optsOptionField = optsDefault

55 { fieldLabelModifier = const "field"

56 , omitNothingFields = True

57 }

58−

59−optsRejectUnknownFields :: Options

60−optsRejectUnknownFields = optsDefault

61− { rejectUnknownFields = True

62− }

63−

64−optsRejectUnknownFieldsTagged :: Options

65−optsRejectUnknownFieldsTagged = optsDefault

66− { rejectUnknownFields = True

67− , tagSingleConstructors = True

68− }

tests/PropertyGeneric.hs+8

@@ -44,9 +44,11 @@ genericTests =

44 , testProperty "TaggedObject" (toParseJSON gSomeTypeParseJSONTaggedObject gSomeTypeToJSONTaggedObject)

45 , testProperty "ObjectWithSingleField" (toParseJSON gSomeTypeParseJSONObjectWithSingleField gSomeTypeToJSONObjectWithSingleField)

47+#if __GLASGOW_HASKELL__ >= 706

47 , testProperty "2ElemArray unary" (toParseJSON1 gSomeTypeLiftParseJSON2ElemArray gSomeTypeLiftToJSON2ElemArray)

48 , testProperty "2ElemArray unary" (toParseJSON1 gSomeTypeLiftParseJSON2ElemArray gSomeTypeLiftToJSON2ElemArray)

48 , testProperty "TaggedObject unary" (toParseJSON1 gSomeTypeLiftParseJSONTaggedObject gSomeTypeLiftToJSONTaggedObject)

49 , testProperty "TaggedObject unary" (toParseJSON1 gSomeTypeLiftParseJSONTaggedObject gSomeTypeLiftToJSONTaggedObject)

49 , testProperty "ObjectWithSingleField unary" (toParseJSON1 gSomeTypeLiftParseJSONObjectWithSingleField gSomeTypeLiftToJSONObjectWithSingleField)

50 , testProperty "ObjectWithSingleField unary" (toParseJSON1 gSomeTypeLiftParseJSONObjectWithSingleField gSomeTypeLiftToJSONObjectWithSingleField)

51+#endif

50 ]

52 ]

51 ]

53 ]

52 , testGroup "OneConstructor" [

54 , testGroup "OneConstructor" [

@@ -83,24 +85,30 @@ genericTests =

84 , testProperty "SomeType2ElemArray" $

86 , testProperty "SomeType2ElemArray" $

85 gSomeTypeToJSON2ElemArray `sameAs` gSomeTypeToEncoding2ElemArray

87 gSomeTypeToJSON2ElemArray `sameAs` gSomeTypeToEncoding2ElemArray

88+#if __GLASGOW_HASKELL__ >= 706

86 , testProperty "SomeType2ElemArray unary" $

89 , testProperty "SomeType2ElemArray unary" $

87 gSomeTypeLiftToJSON2ElemArray `sameAs1` gSomeTypeLiftToEncoding2ElemArray

90 gSomeTypeLiftToJSON2ElemArray `sameAs1` gSomeTypeLiftToEncoding2ElemArray

88 , testProperty "SomeType2ElemArray unary agree" $

91 , testProperty "SomeType2ElemArray unary agree" $

89 gSomeTypeToEncoding2ElemArray `sameAs1Agree` gSomeTypeLiftToEncoding2ElemArray

92 gSomeTypeToEncoding2ElemArray `sameAs1Agree` gSomeTypeLiftToEncoding2ElemArray

93+#endif

91 , testProperty "SomeTypeTaggedObject" $

95 , testProperty "SomeTypeTaggedObject" $

92 gSomeTypeToJSONTaggedObject `sameAs` gSomeTypeToEncodingTaggedObject

96 gSomeTypeToJSONTaggedObject `sameAs` gSomeTypeToEncodingTaggedObject

97+#if __GLASGOW_HASKELL__ >= 706

93 , testProperty "SomeTypeTaggedObject unary" $

98 , testProperty "SomeTypeTaggedObject unary" $

94 gSomeTypeLiftToJSONTaggedObject `sameAs1` gSomeTypeLiftToEncodingTaggedObject

99 gSomeTypeLiftToJSONTaggedObject `sameAs1` gSomeTypeLiftToEncodingTaggedObject

95 , testProperty "SomeTypeTaggedObject unary agree" $

100 , testProperty "SomeTypeTaggedObject unary agree" $

96 gSomeTypeToEncodingTaggedObject `sameAs1Agree` gSomeTypeLiftToEncodingTaggedObject

101 gSomeTypeToEncodingTaggedObject `sameAs1Agree` gSomeTypeLiftToEncodingTaggedObject

102+#endif

103

98 , testProperty "SomeTypeObjectWithSingleField" $

104 , testProperty "SomeTypeObjectWithSingleField" $

99 gSomeTypeToJSONObjectWithSingleField `sameAs` gSomeTypeToEncodingObjectWithSingleField

105 gSomeTypeToJSONObjectWithSingleField `sameAs` gSomeTypeToEncodingObjectWithSingleField

106+#if __GLASGOW_HASKELL__ >= 706

100 , testProperty "SomeTypeObjectWithSingleField unary" $

107 , testProperty "SomeTypeObjectWithSingleField unary" $

101 gSomeTypeLiftToJSONObjectWithSingleField `sameAs1` gSomeTypeLiftToEncodingObjectWithSingleField

108 gSomeTypeLiftToJSONObjectWithSingleField `sameAs1` gSomeTypeLiftToEncodingObjectWithSingleField

102 , testProperty "SomeTypeObjectWithSingleField unary agree" $

109 , testProperty "SomeTypeObjectWithSingleField unary agree" $

103 gSomeTypeToEncodingObjectWithSingleField `sameAs1Agree` gSomeTypeLiftToEncodingObjectWithSingleField

110 gSomeTypeToEncodingObjectWithSingleField `sameAs1Agree` gSomeTypeLiftToEncodingObjectWithSingleField

111+#endif

104

112

105 , testProperty "SomeTypeOmitNothingFields" $

113 , testProperty "SomeTypeOmitNothingFields" $

106 gSomeTypeToJSONOmitNothingFields `sameAs` gSomeTypeToEncodingOmitNothingFields

114 gSomeTypeToJSONOmitNothingFields `sameAs` gSomeTypeToEncodingOmitNothingFields

tests/PropertyKeys.hs+3

@@ -1,3 +1,4 @@

1+{-# LANGUAGE CPP #-}

1{-# LANGUAGE NoImplicitPrelude #-}

2{-# LANGUAGE NoImplicitPrelude #-}

3module PropertyKeys ( keysTests ) where

4module PropertyKeys ( keysTests ) where

@@ -30,10 +31,12 @@ keysTests =

30 , testProperty "Natural" $ roundTripKey (undefined :: Natural)

31 , testProperty "Natural" $ roundTripKey (undefined :: Natural)

31 , testProperty "Float" $ roundTripKey (undefined :: Float)

32 , testProperty "Float" $ roundTripKey (undefined :: Float)

32 , testProperty "Double" $ roundTripKey (undefined :: Double)

33 , testProperty "Double" $ roundTripKey (undefined :: Double)

34+#if MIN_VERSION_base(4,7,0)

33 , testProperty "Day" $ roundTripKey (undefined :: Day)

35 , testProperty "Day" $ roundTripKey (undefined :: Day)

34 , testProperty "LocalTime" $ roundTripKey (undefined :: LocalTime)

36 , testProperty "LocalTime" $ roundTripKey (undefined :: LocalTime)

35 , testProperty "TimeOfDay" $ roundTripKey (undefined :: TimeOfDay)

37 , testProperty "TimeOfDay" $ roundTripKey (undefined :: TimeOfDay)

36 , testProperty "UTCTime" $ roundTripKey (undefined :: UTCTime)

38 , testProperty "UTCTime" $ roundTripKey (undefined :: UTCTime)

39+#endif

37 , testProperty "Version" $ roundTripKey (undefined :: Version)

40 , testProperty "Version" $ roundTripKey (undefined :: Version)

38 , testProperty "Lazy Text" $ roundTripKey (undefined :: LT.Text)

41 , testProperty "Lazy Text" $ roundTripKey (undefined :: LT.Text)

39 , testProperty "UUID" $ roundTripKey UUID.nil

42 , testProperty "UUID" $ roundTripKey UUID.nil

tests/SerializationFormatSpec.hs+4

@@ -3,7 +3,9 @@

3{-# LANGUAGE GADTs #-}

4{-# LANGUAGE NoImplicitPrelude #-}

5{-# LANGUAGE OverloadedStrings #-}

6+#if __GLASGOW_HASKELL__ >= 708

6{-# LANGUAGE DataKinds #-}

7{-# LANGUAGE DataKinds #-}

8+#endif

8------------------------------------------------------------------------------

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

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

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

@@ -75,8 +77,10 @@ jsonExamples =

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

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

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

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

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

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

80+#if __GLASGOW_HASKELL__ >= 708

78 -- Test Tagged instance is polykinded

81 -- Test Tagged instance is polykinded

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

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

83+#endif

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

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

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

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

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

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

tests/Types.hs+2

@@ -119,7 +119,9 @@ deriving instance Generic (Sum4 a b c d)

119deriving instance Generic (Approx a)

120deriving instance Generic Nullary

121deriving instance Generic (SomeType a)

122+#if __GLASGOW_HASKELL__ >= 706

122deriving instance Generic1 SomeType

123deriving instance Generic1 SomeType

124+#endif

123deriving instance Generic OptionField

125deriving instance Generic OptionField

124deriving instance Generic EitherTextInt

126deriving instance Generic EitherTextInt

125

127

tests/UnitTests.hs+4−106

@@ -33,15 +33,15 @@ import Data.Aeson.Parser

33 ( json, jsonLast, jsonAccum, jsonNoDup

34 , json', jsonLast', jsonAccum', jsonNoDup')

35import Data.Aeson.Types

36− ( Options(..), Result(Success, Error), ToJSON(..)

36+ ( Options(..), Result(Success), ToJSON(..), Value(Array, Bool, Null, Object)

37− , Value(Array, Bool, Null, Number, Object, String), camelTo, camelTo2

38− , defaultOptions, formatPath, formatRelativePath, omitNothingFields, parse)

37+ , camelTo, camelTo2, defaultOptions, formatPath, formatRelativePath

38+ , omitNothingFields, parse)

39import Data.Attoparsec.ByteString (Parser, parseOnly)

40import Data.Char (toUpper)

41import Data.Either.Compat (isLeft, isRight)

42import Data.Hashable (hash)

43import Data.HashMap.Strict (HashMap)

44−import Data.List (sort, isSuffixOf)

44+import Data.List (sort)

45import Data.Maybe (fromMaybe)

46import Data.Scientific (Scientific, scientific)

47import Data.Tagged (Tagged(..))

@@ -112,12 +112,8 @@ tests = testGroup "unit" [

112 , testGroup "SingleMaybeField" singleMaybeField

113 , testCase "withEmbeddedJSON" withEmbeddedJSONTest

114 , testCase "SingleFieldCon" singleFieldCon

115− , testGroup "UnknownFields" unknownFields

116 , testGroup "Ordering of object keys" keyOrdering

115 , testGroup "Ordering of object keys" keyOrdering

117 , testCase "Ratio with denominator 0" ratioDenominator0

116 , testCase "Ratio with denominator 0" ratioDenominator0

118− , testCase "Rational parses number" rationalNumber

119− , testCase "Big rational" bigRationalDecoding

120− , testCase "Small rational" smallRationalDecoding

121 , testCase "Big scientific exponent" bigScientificExponent

117 , testCase "Big scientific exponent" bigScientificExponent

122 , testCase "Big integer decoding" bigIntegerDecoding

118 , testCase "Big integer decoding" bigIntegerDecoding

123 , testCase "Big natural decading" bigNaturalDecoding

119 , testCase "Big natural decading" bigNaturalDecoding

@@ -540,7 +536,6 @@ showOptions =

540 ++ ", sumEncoding = TaggedObject {tagFieldName = \"tag\", contentsFieldName = \"contents\"}"

536 ++ ", sumEncoding = TaggedObject {tagFieldName = \"tag\", contentsFieldName = \"contents\"}"

541 ++ ", unwrapUnaryRecords = False"

537 ++ ", unwrapUnaryRecords = False"

542 ++ ", tagSingleConstructors = False"

538 ++ ", tagSingleConstructors = False"

543− ++ ", rejectUnknownFields = False"

544 ++ "}")

539 ++ "}")

545 (show defaultOptions)

540 (show defaultOptions)

546

541

@@ -585,79 +580,6 @@ singleFieldCon :: Assertion

585singleFieldCon =

580singleFieldCon =

586 assertEqual "fromJSON" (Right (SingleFieldCon 0)) (eitherDecode "0")

581 assertEqual "fromJSON" (Right (SingleFieldCon 0)) (eitherDecode "0")

587

582

588−newtype UnknownFields = UnknownFields { knownField :: Int }

589− deriving (Eq, Show, Generic)

590−newtype UnknownFieldsTag = UnknownFieldsTag { tag :: Int }

591− deriving (Eq, Show, Generic)

592−newtype UnknownFieldsUnaryTagged = UnknownFieldsUnaryTagged { knownFieldUnaryTagged :: Int }

593− deriving (Eq, Show, Generic)

594−data UnknownFieldsSum

595− = UnknownFields1 { knownField1 :: Int }

596− | UnknownFields2 { knownField2 :: Int }

597− deriving (Eq, Show, Generic)

598−

599−unknownFields :: [TestTree]

600−unknownFields = concat

601− [ testsUnary

602− "unary-unknown"

603− (object [("knownField", Number 1), ("unknownField", Number 1)])

604− (Error "nknown fields: [\"unknownField\"]" :: Result UnknownFields)

605− , testsUnary

606− "unary-unknown-tag"

607− (object [("knownField", Number 1), ("tag", String "UnknownFields")])

608− (Error "nknown fields: [\"tag\"]" :: Result UnknownFields)

609− , testsUnaryTag

610− "unary-explicit-tag"

611− (object [("tag", Number 1)])

612− (Success $ UnknownFieldsTag 1)

613− , testsSum

614− "sum-tag"

615− (object [("knownField1", Number 1), ("tag", String "UnknownFields1")])

616− (Success $ UnknownFields1 1)

617− , testsSum

618− "sum-unknown-in-branch"

619− (object [("knownField1", Number 1), ("knownField2", Number 1), ("tag", String "UnknownFields1")])

620− (Error "nknown fields: [\"knownField2\"]" :: Result UnknownFieldsSum)

621− , testsSum

622− "sum-unknown"

623− (object [("knownField1", Number 1), ("unknownField", Number 1), ("tag", String "UnknownFields1")])

624− (Error "nknown fields: [\"unknownField\"]" :: Result UnknownFieldsSum)

625− , testsTagged

626− "unary-tagged"

627− (object [("knownFieldUnaryTagged", Number 1), ("tag", String "UnknownFieldsUnaryTagged")])

628− (Success $ UnknownFieldsUnaryTagged 1)

629− , -- Just a case to verify that the tag isn't optional, this is likely already tested by other unit tests

630− testsTagged

631− "unary-tagged-notag"

632− (object [("knownFieldUnaryTagged", Number 1)])

633− (Error "key \"tag\" not found" :: Result UnknownFieldsUnaryTagged)

634− , testsTagged

635− "unary-tagged-unknown"

636− (object [ ("knownFieldUnaryTagged", Number 1), ("unknownField", Number 1)

637− , ("tag", String "UnknownFieldsUnaryTagged")])

638− (Error "nknown fields: [\"unknownField\"]" :: Result UnknownFieldsUnaryTagged)

639− ]

640− where

641− opts = defaultOptions{rejectUnknownFields=True}

642− taggedOpts = opts{tagSingleConstructors=True}

643− assertApprox :: (Show a, Eq a) => Result a -> Result a -> IO ()

644− assertApprox (Error expected) (Error actual) | expected `isSuffixOf` actual = return ()

645− assertApprox expected actual = assertEqual "fromJSON" expected actual

646− testsBase :: (Show a, Eq a) => (Value -> Result a) -> (Value -> Result a)

647− -> String -> Value -> Result a -> [TestTree]

648− testsBase th g name value expected =

649− [ testCase (name ++ "-th") $ assertApprox expected (th value)

650− , testCase (name ++ "-generic") $ assertApprox expected (g value)

651− ]

652− testsUnary :: String -> Value -> Result UnknownFields -> [TestTree]

653− testsUnary = testsBase fromJSON (parse (genericParseJSON opts))

654− testsUnaryTag :: String -> Value -> Result UnknownFieldsTag -> [TestTree]

655− testsUnaryTag = testsBase fromJSON (parse (genericParseJSON opts))

656− testsSum :: String -> Value -> Result UnknownFieldsSum -> [TestTree]

657− testsSum = testsBase fromJSON (parse (genericParseJSON opts))

658− testsTagged :: String -> Value -> Result UnknownFieldsUnaryTagged -> [TestTree]

659− testsTagged = testsBase fromJSON (parse (genericParseJSON taggedOpts))

660−

661testParser :: (Eq a, Show a)

583testParser :: (Eq a, Show a)

662 => String -> Parser a -> S.ByteString -> Either String a -> TestTree

584 => String -> Parser a -> S.ByteString -> Either String a -> TestTree

663testParser name json_ s expected =

585testParser name json_ s expected =

@@ -698,25 +620,6 @@ ratioDenominator0 =

698 (Left "Error in $: Ratio denominator was 0")

620 (Left "Error in $: Ratio denominator was 0")

699 (eitherDecode "{ \"numerator\": 1, \"denominator\": 0 }" :: Either String Rational)

621 (eitherDecode "{ \"numerator\": 1, \"denominator\": 0 }" :: Either String Rational)

700

622

701−rationalNumber :: Assertion

702−rationalNumber =

703− assertEqual "Ratio with denominator 0"

704− (Right 1.37)

705− (eitherDecode "1.37" :: Either String Rational)

706−

707−bigRationalDecoding :: Assertion

708−bigRationalDecoding =

709− assertEqual "Decoding an Integer with a large exponent should fail"

710− (Left "Error in $: parsing Ratio failed, found a number with exponent 2000, but it must not be greater than 1024 or less than -1024")

711− ((eitherDecode :: L.ByteString -> Either String Rational) "1e2000")

712−

713−smallRationalDecoding :: Assertion

714−smallRationalDecoding =

715− assertEqual "Decoding an Integer with a large exponent should fail"

716− (Left "Error in $: parsing Ratio failed, found a number with exponent -2000, but it must not be greater than 1024 or less than -1024")

717− ((eitherDecode :: L.ByteString -> Either String Rational) "1e-2000")

718−

719−

720bigScientificExponent :: Assertion

623bigScientificExponent :: Assertion

721bigScientificExponent =

624bigScientificExponent =

722 assertEqual "Encoding an integral scientific with a large exponent should normalize it"

625 assertEqual "Encoding an integral scientific with a large exponent should normalize it"

@@ -753,8 +656,3 @@ deriveToJSON defaultOptions ''Foo

753deriveToJSON1 defaultOptions ''Foo

656deriveToJSON1 defaultOptions ''Foo

754

657

755deriveJSON defaultOptions{omitNothingFields=True,unwrapUnaryRecords=True} ''SingleMaybeField

658deriveJSON defaultOptions{omitNothingFields=True,unwrapUnaryRecords=True} ''SingleMaybeField

756−

757−deriveJSON defaultOptions{rejectUnknownFields=True} ''UnknownFields

758−deriveJSON defaultOptions{rejectUnknownFields=True} ''UnknownFieldsTag

759−deriveJSON defaultOptions{tagSingleConstructors=True,rejectUnknownFields=True} ''UnknownFieldsUnaryTagged

760−deriveJSON defaultOptions{rejectUnknownFields=True} ''UnknownFieldsSum

tests/golden/generic.expected−8

@@ -31,14 +31,6 @@ Error in $: parsing Types.SomeType failed, expected a 2-element Array, but encou

31Error in $: parsing Types.SomeType failed, expected Array, but encountered Object

32Error in $: not enough input. Expecting ',' or ']'

33Error in $: not enough input. Expecting json list value

34−SomeType (reject unknown fields)

35−Error in $: parsing Types.SomeType(Record) failed, unknown fields: ["testZero"]

36−Error in $: parsing Types.SomeType failed, expected Object with key "tag" containing one of ["nullary","unary","product","record","list"], key "tag" not found

37−Error in $: parsing Types.SomeType(Record) failed, unknown fields: ["testtwo","testone","testthree"]

38−Foo (reject unknown fields)

39−Error in $: parsing Types.Foo(Foo) failed, unknown fields: ["tag"]

40−Foo (reject unknown fields, tagged single)

41−Error in $: parsing Types.Foo(Foo) failed, unknown fields: ["unknownField"]

42EitherTextInt

34EitherTextInt

43Error in $: parsing Types.EitherTextInt(NoneNullary) failed, expected tag "nonenullary", but found tag "X"

35Error in $: parsing Types.EitherTextInt(NoneNullary) failed, expected tag "nonenullary", but found tag "X"

44Error in $: parsing Types.EitherTextInt(NoneNullary) failed, expected String, but encountered Array

36Error in $: parsing Types.EitherTextInt(NoneNullary) failed, expected String, but encountered Array