eb60a38..master · typeable/aeson

Data/Aeson.hs+3−3

@@ -149,7 +149,7 @@ import Data.Aeson.Types.FromJSON (ifromJSON, parseIndexedJSON)

149import Data.Aeson.Encoding (encodingToLazyByteString)

150import Data.Aeson.Parser.Internal (decodeWith, decodeStrictWith, eitherDecodeWith, eitherDecodeStrictWith, jsonEOF, json, jsonEOF', json')

151import Data.Aeson.Types

152−import Data.Aeson.Types.Internal (formatError)

152+import Data.Aeson.Types.Internal (JSONPath, formatError, (<?>))

153import qualified Data.ByteString as B

154import qualified Data.ByteString.Lazy as L

155

@@ -257,7 +257,7 @@ eitherDecodeStrict =

257-- | Like 'decodeFileStrict' but returns an error message when decoding fails.

258eitherDecodeFileStrict :: (FromJSON a) => FilePath -> IO (Either String a)

259eitherDecodeFileStrict =

260− fmap eitherDecodeStrict . B.readFile

260+ fmap (eitherFormatError . eitherDecodeStrictWith jsonEOF ifromJSON) . B.readFile

261{-# INLINE eitherDecodeFileStrict #-}

262

263-- | Like 'decode'' but returns an error message when decoding fails.

@@ -274,7 +274,7 @@ eitherDecodeStrict' =

274-- | Like 'decodeFileStrict'' but returns an error message when decoding fails.

275eitherDecodeFileStrict' :: (FromJSON a) => FilePath -> IO (Either String a)

276eitherDecodeFileStrict' =

277− fmap eitherDecodeStrict' . B.readFile

277+ fmap (eitherFormatError . eitherDecodeStrictWith jsonEOF' ifromJSON) . B.readFile

278{-# INLINE eitherDecodeFileStrict' #-}

279

280-- $use

Data/Aeson/Encoding/Builder.hs+1

@@ -44,6 +44,7 @@ import Data.ByteString.Builder as B

44import Data.ByteString.Builder.Prim as BP

45import Data.ByteString.Builder.Scientific (scientificBuilder)

46import Data.Char (chr, ord)

47+import Data.Semigroup ((<>))

47import Data.Scientific (Scientific, base10Exponent, coefficient)

48import Data.Scientific (Scientific, base10Exponent, coefficient)

48import Data.Text.Encoding (encodeUtf8BuilderEscaped)

49import Data.Text.Encoding (encodeUtf8BuilderEscaped)

49import Data.Time (UTCTime(..))

50import Data.Time (UTCTime(..))

Data/Aeson/Encoding/Internal.hs+1

@@ -63,6 +63,7 @@ import Data.Aeson.Types.Internal (Value)

63import Data.ByteString.Builder (Builder, char7, toLazyByteString)

64import Data.Int

65import Data.Scientific (Scientific)

66+import Data.Semigroup (Semigroup ((<>)))

66import Data.Text (Text)

67import Data.Text (Text)

67import Data.Time (Day, LocalTime, TimeOfDay, UTCTime, ZonedTime)

68import Data.Time (Day, LocalTime, TimeOfDay, UTCTime, ZonedTime)

68import Data.Typeable (Typeable)

69import Data.Typeable (Typeable)

Data/Aeson/Parser/Internal.hs+5−29

@@ -67,9 +67,6 @@ import qualified Data.Attoparsec.Lazy as L

67import qualified Data.ByteString as B

68import qualified Data.ByteString.Unsafe as B

69import qualified Data.ByteString.Lazy as L

70−import qualified Data.ByteString.Lazy as BSL

71−import qualified Data.ByteString.Lazy.Char8 as C

72−import qualified Data.ByteString.Builder as B

73import qualified Data.HashMap.Strict as H

70import qualified Data.HashMap.Strict as H

74import qualified Data.Scientific as Sci

71import qualified Data.Scientific as Sci

75import Data.Aeson.Parser.Unescape (unescapeText)

72import Data.Aeson.Parser.Unescape (unescapeText)

@@ -393,35 +390,14 @@ eitherDecodeWith p to s =

393 L.Done _ v -> case to v of

390 L.Done _ v -> case to v of

394 ISuccess a -> Right a

391 ISuccess a -> Right a

395 IError path msg -> Left (path, msg)

392 IError path msg -> Left (path, msg)

396− L.Fail notparsed ctx msg -> Left ([], buildMsg notparsed ctx msg)

393+ L.Fail _ ctx msg -> Left ([], buildMsg ctx msg)

397 where

394 where

398− buildMsg :: L.ByteString -> [String] -> String -> String

395+ buildMsg :: [String] -> String -> String

399− buildMsg notYetParsed [] msg = msg ++ formatErrorLine notYetParsed

396+ buildMsg [] msg = msg

400− buildMsg notYetParsed (expectation:_) msg =

397+ buildMsg (expectation:_) msg =

401− msg ++ ". Expecting " ++ expectation ++ formatErrorLine notYetParsed

398+ msg ++ ". Expecting " ++ expectation

402{-# INLINE eitherDecodeWith #-}

399{-# INLINE eitherDecodeWith #-}

403

400

404−-- | Grab the first 100 bytes from the non parsed portion and

405−-- format to get nicer error messages

406−formatErrorLine :: L.ByteString -> String

407−formatErrorLine bs =

408− C.unpack .

409− -- if formatting results in empty ByteString just return that

410− -- otherwise construct the error message with the bytestring builder

411− (\bs' ->

412− if BSL.null bs'

413− then BSL.empty

414− else

415− B.toLazyByteString $

416− B.stringUtf8 " at '" <> B.lazyByteString bs' <> B.stringUtf8 "'"

417− ) .

418− -- if newline is present cut at that position

419− BSL.takeWhile (10 /=) .

420− -- remove spaces, CR's, tabs, backslashes and quotes characters

421− BSL.filter (`notElem` [9, 13, 32, 34, 47, 92]) .

422− -- take 100 bytes

423− BSL.take 100 $ bs

424−

425eitherDecodeStrictWith :: Parser Value -> (Value -> IResult a) -> B.ByteString

401eitherDecodeStrictWith :: Parser Value -> (Value -> IResult a) -> B.ByteString

426 -> Either (JSONPath, String) a

402 -> Either (JSONPath, String) a

427eitherDecodeStrictWith p to s =

403eitherDecodeStrictWith p to s =

Data/Aeson/TH.hs+14−41

@@ -116,10 +116,7 @@ module Data.Aeson.TH

116 , mkLiftParseJSON2

117 ) where

118

119−import Prelude.Compat hiding (fail)

119+import Prelude.Compat

120−

121−-- We don't have MonadFail Q, so we should use `fail` from real `Prelude`

122−import Prelude (fail)

123

120

124import Control.Applicative ((<|>))

121import Control.Applicative ((<|>))

125import Data.Aeson (Object, (.:), FromJSON(..), FromJSON1(..), FromJSON2(..), ToJSON(..), ToJSON1(..), ToJSON2(..))

122import Data.Aeson (Object, (.:), FromJSON(..), FromJSON1(..), FromJSON2(..), ToJSON(..), ToJSON1(..), ToJSON2(..))

@@ -1307,8 +1304,9 @@ dispatchFunByType jc jf conName tvMap list ty = do

1307 tyVarNames :: [Name]

1304 tyVarNames :: [Name]

1308 tyVarNames = M.keys tvMap

1305 tyVarNames = M.keys tvMap

1309

1306

1310− itf <- isInTypeFamilyApp tyVarNames tyCon tyArgs

1307+ itf <- isTyFamily tyCon

1311− if any (`mentionsName` tyVarNames) lhsArgs || itf

1308+ if any (`mentionsName` tyVarNames) lhsArgs

1309+ || itf && any (`mentionsName` tyVarNames) tyArgs

1312 then outOfPlaceTyVarError jc conName

1310 then outOfPlaceTyVarError jc conName

1313 else if any (`mentionsName` tyVarNames) rhsArgs

1311 else if any (`mentionsName` tyVarNames) rhsArgs

1314 then appsE $ varE (jsonFunValOrListName list jf $ toEnum numLastArgs)

1312 then appsE $ varE (jsonFunValOrListName list jf $ toEnum numLastArgs)

@@ -1659,44 +1657,19 @@ isTyVar (VarT _) = True

1659isTyVar (SigT t _) = isTyVar t

1657isTyVar (SigT t _) = isTyVar t

1660isTyVar _ = False

1658isTyVar _ = False

1661

1659

1662−-- | Detect if a Name in a list of provided Names occurs as an argument to some

1660+-- | Is the given type a type family constructor (and not a data family constructor)?

1663−-- type family. This makes an effort to exclude /oversaturated/ arguments to

1661+isTyFamily :: Type -> Q Bool

1664−-- type families. For instance, if one declared the following type family:

1662+isTyFamily (ConT n) = do

1665−--

1666−-- @

1667−-- type family F a :: Type -> Type

1668−-- @

1669−--

1670−-- Then in the type @F a b@, we would consider @a@ to be an argument to @F@,

1671−-- but not @b@.

1672−isInTypeFamilyApp :: [Name] -> Type -> [Type] -> Q Bool

1673−isInTypeFamilyApp names tyFun tyArgs =

1674− case tyFun of

1675− ConT tcName -> go tcName

1676− _ -> return False

1677− where

1678− go :: Name -> Q Bool

1679− go tcName = do

1680− info <- reify tcName

1663+ info <- reify n

1681− case info of

1664+ return $ case info of

1682#if MIN_VERSION_template_haskell(2,11,0)

1665#if MIN_VERSION_template_haskell(2,11,0)

1683− FamilyI (OpenTypeFamilyD (TypeFamilyHead _ bndrs _ _)) _

1666+ FamilyI OpenTypeFamilyD{} _ -> True

1684− -> withinFirstArgs bndrs

1685− FamilyI (ClosedTypeFamilyD (TypeFamilyHead _ bndrs _ _) _) _

1686− -> withinFirstArgs bndrs

1687#else

1667#else

1688− FamilyI (FamilyD TypeFam _ bndrs _) _

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

1689− -> withinFirstArgs bndrs

1690− FamilyI (ClosedTypeFamilyD _ bndrs _ _) _

1691− -> withinFirstArgs bndrs

1692#endif

1669#endif

1693− _ -> return False

1670+ FamilyI ClosedTypeFamilyD{} _ -> True

1694− where

1671+ _ -> False

1695− withinFirstArgs :: [a] -> Q Bool

1672+isTyFamily _ = return False

1696− withinFirstArgs bndrs =

1697− let firstArgs = take (length bndrs) tyArgs

1698− argFVs = freeVariables firstArgs

1699− in return $ any (`elem` argFVs) names

1700

1673

1701-- | Peel off a kind signature from a Type (if it has one).

1674-- | Peel off a kind signature from a Type (if it has one).

1702unSigT :: Type -> Type

1675unSigT :: Type -> Type

Data/Aeson/Text.hs+1

@@ -26,6 +26,7 @@ import Prelude.Compat

26

27import Data.Aeson.Types (Value(..), ToJSON(..))

28import Data.Aeson.Encoding (encodingToLazyByteString)

29+import Data.Semigroup ((<>))

29import Data.Scientific (FPFormat(..), Scientific, base10Exponent)

30import Data.Scientific (FPFormat(..), Scientific, base10Exponent)

30import Data.Text.Lazy.Builder

31import Data.Text.Lazy.Builder

31import Data.Text.Lazy.Builder.Scientific (formatScientificBuilder)

32import Data.Text.Lazy.Builder.Scientific (formatScientificBuilder)

Data/Aeson/Types.hs−1

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

35 , parse

36 , parseEither

37 , parseMaybe

38− , parseFail

39 , ToJSON(..)

38 , ToJSON(..)

40 , KeyValue(..)

39 , KeyValue(..)

41 , modifyFailure

40 , modifyFailure

Data/Aeson/Types/FromJSON.hs+1

@@ -96,6 +96,7 @@ import Data.Hashable (Hashable(..))

96import Data.Int (Int16, Int32, Int64, Int8)

97import Data.List.NonEmpty (NonEmpty(..))

98import Data.Maybe (fromMaybe)

99+import Data.Semigroup ((<>))

99import Data.Proxy (Proxy(..))

100import Data.Proxy (Proxy(..))

100import Data.Ratio ((%), Ratio)

101import Data.Ratio ((%), Ratio)

101import Data.Scientific (Scientific, base10Exponent)

102import Data.Scientific (Scientific, base10Exponent)

Data/Aeson/Types/Internal.hs+14−30

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

44 , parse

45 , parseEither

46 , parseMaybe

47− , parseFail

48 , modifyFailure

47 , modifyFailure

49 , prependFailure

48 , prependFailure

50 , parserThrowError

49 , parserThrowError

@@ -95,6 +94,7 @@ import Data.HashMap.Strict (HashMap)

95import Data.Hashable (Hashable(..))

94import Data.Hashable (Hashable(..))

96import Data.List (intercalate)

95import Data.List (intercalate)

97import Data.Scientific (Scientific)

96import Data.Scientific (Scientific)

97+import Data.Semigroup (Semigroup((<>)))

98import Data.String (IsString(..))

99import Data.Text (Text, pack, unpack)

100import Data.Time (UTCTime)

@@ -342,10 +342,6 @@ instance Monoid (Parser a) where

342 mappend = (<>)

343 {-# INLINE mappend #-}

344

345−-- | Raise a parsing failure with some custom message.

346−parseFail :: String -> Parser a

347−parseFail = fail

348−

349apP :: Parser (a -> b) -> Parser a -> Parser b

345apP :: Parser (a -> b) -> Parser a -> Parser b

350apP d e = do

346apP d e = do

351 b <- d

347 b <- d

@@ -585,53 +581,41 @@ data Options = Options

585 -- the constructor tag. If 'False' the encoding will always

581 -- the constructor tag. If 'False' the encoding will always

586 -- follow the `sumEncoding`.

582 -- follow the `sumEncoding`.

587 , omitNothingFields :: Bool

583 , omitNothingFields :: Bool

588− -- ^ If 'True', record fields with a 'Nothing' value will be

584+ -- ^ If 'True' record fields with a 'Nothing' value will be

589− -- omitted from the resulting object. If 'False', the resulting

585+ -- omitted from the resulting object. If 'False' the resulting

590 -- object will include those fields mapping to @null@.

586 -- object will include those fields mapping to @null@.

591 --

587 --

592− -- Note that this /does not/ affect parsing: 'Maybe' fields are

593− -- optional regardless of the value of 'omitNothingFields', subject

594− -- to the note below.

595− --

596 -- === Note

588 -- === Note

597 --

589 --

598 -- Setting 'omitNothingFields' to 'True' only affects fields which are of

590 -- Setting 'omitNothingFields' to 'True' only affects fields which are of

599− -- type 'Maybe' /uniformly/ in the 'ToJSON' instance.

591+ -- type 'Maybe' /uniformly/ in the 'ToJSON' or 'FromJSON' instance. In

600− -- In particular, if the type of a field is declared as a type variable, it

592+ -- particular, if the type of a field is declared as a type variable, it

601 -- will not be omitted from the JSON object, unless the field is

593 -- will not be omitted from the JSON object, unless the field is

602 -- specialized upfront in the instance.

594 -- specialized upfront in the instance.

603 --

595 --

604− -- The same holds for 'Maybe' fields being optional in the 'FromJSON' instance.

605− --

606 -- ==== __Example__

596 -- ==== __Example__

607 --

597 --

608 -- The generic instance for the following type @Fruit@ depends on whether

598 -- The generic instance for the following type @Fruit@ depends on whether

609 -- the instance head is @Fruit a@ or @Fruit (Maybe a)@.

599 -- the instance head is @Fruit a@ or @Fruit (Maybe a)@.

610 --

600 --

611 -- @

601 -- @

612− -- data Fruit a = Fruit

602+ -- data Fruit a =

613 -- { apples :: a -- A field whose type is a type variable.

603 -- { apples :: a -- A field whose type is a type variable.

614 -- , oranges :: 'Maybe' Int

604 -- , oranges :: 'Maybe' Int

615− -- } deriving 'Generic'

605+ -- }

606+ --

607+ -- options :: 'Options'

608+ -- options = 'defaultOptions' { 'omitNothingFields' = 'True' }

616 --

609 --

617 -- -- apples required, oranges optional

610 -- -- apples required, oranges optional

618 -- -- Even if 'Data.Aeson.fromJSON' is then specialized to (Fruit ('Maybe' a)).

611 -- -- Even if 'Data.Aeson.fromJSON' is then specialized to (Fruit ('Maybe' a)).

619− -- instance 'Data.Aeson.FromJSON' a => 'Data.Aeson.FromJSON' (Fruit a)

612+ -- instance 'Data.Aeson.FromJSON' a => 'Data.Aeson.FromJSON' (Fruit a) where

613+ -- 'Data.Aeson.fromJSON' = 'Data.Aeson.genericFromJSON' options

620 --

614 --

621 -- -- apples optional, oranges optional

615 -- -- apples optional, oranges optional

622 -- -- In this instance, the field apples is uniformly of type ('Maybe' a).

616 -- -- In this instance, the field apples is uniformly of type ('Maybe' a).

623− -- instance 'Data.Aeson.FromJSON' a => 'Data.Aeson.FromJSON' (Fruit ('Maybe' a))

617+ -- instance 'Data.Aeson.FromJSON' a => 'Data.Aeson.FromJSON' (Fruit ('Maybe' a)) where

624− --

618+ -- 'Data.Aeson.fromJSON' = 'Data.Aeson.genericFromJSON' options

625− -- options :: 'Options'

626− -- options = 'defaultOptions' { 'omitNothingFields' = 'True' }

627− --

628− -- -- apples always present in the output, oranges is omitted if 'Nothing'

629− -- instance 'Data.Aeson.ToJSON' a => 'Data.Aeson.ToJSON' (Fruit a) where

630− -- 'Data.Aeson.toJSON' = 'Data.Aeson.genericToJSON' options

631− --

632− -- -- both apples and oranges are omitted if 'Nothing'

633− -- instance 'Data.Aeson.ToJSON' a => 'Data.Aeson.ToJSON' (Fruit ('Maybe' a)) where

634− -- 'Data.Aeson.toJSON' = 'Data.Aeson.genericToJSON' options

635 -- @

619 -- @

636 , sumEncoding :: SumEncoding

620 , sumEncoding :: SumEncoding

637 -- ^ Specifies how to encode constructors of a sum datatype.

621 -- ^ Specifies how to encode constructors of a sum datatype.

Data/Aeson/Types/ToJSON.hs+1

@@ -79,6 +79,7 @@ import Data.Functor.Sum (Sum(..))

79import Data.Int (Int16, Int32, Int64, Int8)

80import Data.List (intersperse)

81import Data.List.NonEmpty (NonEmpty(..))

82+import Data.Semigroup ((<>))

82import Data.Proxy (Proxy(..))

83import Data.Proxy (Proxy(..))

83import Data.Ratio (Ratio, denominator, numerator)

84import Data.Ratio (Ratio, denominator, numerator)

84import Data.Scientific (Scientific)

85import Data.Scientific (Scientific)

aeson.cabal+2−2

@@ -116,8 +116,8 @@ library

116

117 -- Compat

118 build-depends:

119− base-compat-batteries >= 0.10.0 && < 0.12,

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

120− time-compat >= 1.9.2.2 && < 1.10

120+ time-compat >= 1.9.2.2 && < 1.10

121

122 if !impl(ghc >= 8.6)

123 build-depends:

attoparsec-iso8601/Data/Attoparsec/Time/Internal.hs+18−3

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

1+{-# LANGUAGE CPP #-}

1{-# LANGUAGE NoImplicitPrelude #-}

2{-# LANGUAGE NoImplicitPrelude #-}

2-- |

3-- |

3-- Module: Data.Aeson.Internal.Time

4-- Module: Data.Aeson.Internal.Time

@@ -18,10 +19,24 @@ module Data.Attoparsec.Time.Internal

18

19

19import Prelude.Compat

20import Prelude.Compat

20

21

21−import Data.Fixed (Fixed(MkFixed), Pico)

22import Data.Int (Int64)

23−import Data.Time (TimeOfDay(..))

23+import Data.Time

24+import Unsafe.Coerce (unsafeCoerce)

25+

26+#if MIN_VERSION_time(1,6,0)

27+

24−import Data.Time.Clock.Compat

28+import Data.Time.Clock (diffTimeToPicoseconds)

29+

30+#endif

31+

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

33+

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

35+

36+diffTimeToPicoseconds :: DiffTime -> Integer

37+diffTimeToPicoseconds = unsafeCoerce

38+

39+#endif

25

40

26toPico :: Integer -> Pico

41toPico :: Integer -> Pico

27toPico = MkFixed

42toPico = MkFixed

tests/UnitTests.hs−8

@@ -5,7 +5,6 @@

5{-# LANGUAGE OverloadedStrings #-}

6{-# LANGUAGE ScopedTypeVariables #-}

7{-# LANGUAGE TemplateHaskell #-}

8−{-# LANGUAGE TypeFamilies #-}

9{-# LANGUAGE QuasiQuotes #-}

8{-# LANGUAGE QuasiQuotes #-}

10

9

11-- For Data.Aeson.Types.camelTo

10-- For Data.Aeson.Types.camelTo

@@ -748,11 +747,6 @@ bigNaturalKeyDecoding =

748 (Left "Error in $['1e2000']: found a number with exponent 2000, but it must not be greater than 1024")

747 (Left "Error in $['1e2000']: found a number with exponent 2000, but it must not be greater than 1024")

749 ((eitherDecode :: L.ByteString -> Either String (HashMap Natural Value)) "{ \"1e2000\": null }")

748 ((eitherDecode :: L.ByteString -> Either String (HashMap Natural Value)) "{ \"1e2000\": null }")

750

749

751−-- A regression test for: https://github.com/bos/aeson/issues/757

752−type family Fam757 :: * -> *

753−type instance Fam757 = Maybe

754−newtype Newtype757 a = MkNewtype757 (Fam757 a)

755−

756deriveJSON defaultOptions{omitNothingFields=True} ''MyRecord

750deriveJSON defaultOptions{omitNothingFields=True} ''MyRecord

757

751

758deriveToJSON defaultOptions ''Foo

752deriveToJSON defaultOptions ''Foo

@@ -764,5 +758,3 @@ deriveJSON defaultOptions{rejectUnknownFields=True} ''UnknownFields

764deriveJSON defaultOptions{rejectUnknownFields=True} ''UnknownFieldsTag

758deriveJSON defaultOptions{rejectUnknownFields=True} ''UnknownFieldsTag

765deriveJSON defaultOptions{tagSingleConstructors=True,rejectUnknownFields=True} ''UnknownFieldsUnaryTagged

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

766deriveJSON defaultOptions{rejectUnknownFields=True} ''UnknownFieldsSum

760deriveJSON defaultOptions{rejectUnknownFields=True} ''UnknownFieldsSum

767−

768−deriveToJSON1 defaultOptions ''Newtype757