master..eb60a38 · 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 (JSONPath, formatError, (<?>))

152+import Data.Aeson.Types.Internal (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 (eitherFormatError . eitherDecodeStrictWith jsonEOF ifromJSON) . B.readFile

260+ fmap eitherDecodeStrict . 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 (eitherFormatError . eitherDecodeStrictWith jsonEOF' ifromJSON) . B.readFile

277+ fmap eitherDecodeStrict' . B.readFile

278{-# INLINE eitherDecodeFileStrict' #-}

279

280-- $use

Data/Aeson/Encoding/Builder.hs−1

@@ -44,7 +44,6 @@ 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 ((<>))

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

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

49import Data.Text.Encoding (encodeUtf8BuilderEscaped)

48import Data.Text.Encoding (encodeUtf8BuilderEscaped)

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

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

Data/Aeson/Encoding/Internal.hs−1

@@ -63,7 +63,6 @@ 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 ((<>)))

67import Data.Text (Text)

66import Data.Text (Text)

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

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

69import Data.Typeable (Typeable)

68import Data.Typeable (Typeable)

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

@@ -67,6 +67,9 @@ 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

70import qualified Data.HashMap.Strict as H

73import qualified Data.HashMap.Strict as H

71import qualified Data.Scientific as Sci

74import qualified Data.Scientific as Sci

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

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

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

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

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

391 ISuccess a -> Right a

394 ISuccess a -> Right a

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

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

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

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

394 where

397 where

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

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

396− buildMsg [] msg = msg

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

397− buildMsg (expectation:_) msg =

400+ buildMsg notYetParsed (expectation:_) msg =

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

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

399{-# INLINE eitherDecodeWith #-}

402{-# INLINE eitherDecodeWith #-}

400

403

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+

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

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

402 -> Either (JSONPath, String) a

426 -> Either (JSONPath, String) a

403eitherDecodeStrictWith p to s =

427eitherDecodeStrictWith p to s =

Data/Aeson/TH.hs+41−14

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

116 , mkLiftParseJSON2

117 ) where

118

119−import Prelude.Compat

119+import Prelude.Compat hiding (fail)

120+

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

122+import Prelude (fail)

120

123

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

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

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

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

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

1304 tyVarNames :: [Name]

1307 tyVarNames :: [Name]

1305 tyVarNames = M.keys tvMap

1308 tyVarNames = M.keys tvMap

1306

1309

1307− itf <- isTyFamily tyCon

1310+ itf <- isInTypeFamilyApp tyVarNames tyCon tyArgs

1308− if any (`mentionsName` tyVarNames) lhsArgs

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

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

1310 then outOfPlaceTyVarError jc conName

1312 then outOfPlaceTyVarError jc conName

1311 else if any (`mentionsName` tyVarNames) rhsArgs

1313 else if any (`mentionsName` tyVarNames) rhsArgs

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

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

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

1657isTyVar (SigT t _) = isTyVar t

1659isTyVar (SigT t _) = isTyVar t

1658isTyVar _ = False

1660isTyVar _ = False

1659

1661

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

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

1661−isTyFamily :: Type -> Q Bool

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

1662−isTyFamily (ConT n) = do

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

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

1663− info <- reify n

1680+ info <- reify tcName

1664− return $ case info of

1681+ case info of

1665#if MIN_VERSION_template_haskell(2,11,0)

1682#if MIN_VERSION_template_haskell(2,11,0)

1666− FamilyI OpenTypeFamilyD{} _ -> True

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

1684+ -> withinFirstArgs bndrs

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

1686+ -> withinFirstArgs bndrs

1667#else

1687#else

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

1688+ FamilyI (FamilyD TypeFam _ bndrs _) _

1689+ -> withinFirstArgs bndrs

1690+ FamilyI (ClosedTypeFamilyD _ bndrs _ _) _

1691+ -> withinFirstArgs bndrs

1669#endif

1692#endif

1670− FamilyI ClosedTypeFamilyD{} _ -> True

1693+ _ -> return False

1671− _ -> False

1694+ where

1672−isTyFamily _ = return False

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

1696+ withinFirstArgs bndrs =

1697+ let firstArgs = take (length bndrs) tyArgs

1698+ argFVs = freeVariables firstArgs

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

1673

1700

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

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

1675unSigT :: Type -> Type

1702unSigT :: Type -> Type

Data/Aeson/Text.hs−1

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

26

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

28import Data.Aeson.Encoding (encodingToLazyByteString)

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

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

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

31import Data.Text.Lazy.Builder

30import Data.Text.Lazy.Builder

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

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

Data/Aeson/Types.hs+1

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

35 , parse

36 , parseEither

37 , parseMaybe

38+ , parseFail

38 , ToJSON(..)

39 , ToJSON(..)

39 , KeyValue(..)

40 , KeyValue(..)

40 , modifyFailure

41 , modifyFailure

Data/Aeson/Types/FromJSON.hs−1

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

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

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

98import Data.Maybe (fromMaybe)

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

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

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

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

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

102import Data.Scientific (Scientific, base10Exponent)

101import Data.Scientific (Scientific, base10Exponent)

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

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

44 , parse

45 , parseEither

46 , parseMaybe

47+ , parseFail

47 , modifyFailure

48 , modifyFailure

48 , prependFailure

49 , prependFailure

49 , parserThrowError

50 , parserThrowError

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

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

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

95import Data.List (intercalate)

96import Data.List (intercalate)

96import Data.Scientific (Scientific)

97import Data.Scientific (Scientific)

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

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

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

100import Data.Time (UTCTime)

@@ -342,6 +342,10 @@ 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+

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

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

346apP d e = do

350apP d e = do

347 b <- d

351 b <- d

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

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

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

582 -- follow the `sumEncoding`.

586 -- follow the `sumEncoding`.

583 , omitNothingFields :: Bool

587 , omitNothingFields :: Bool

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

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

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

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

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

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

587 --

591 --

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+ --

588 -- === Note

596 -- === Note

589 --

597 --

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

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

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

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

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

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

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

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

594 -- specialized upfront in the instance.

602 -- specialized upfront in the instance.

595 --

603 --

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

605+ --

596 -- ==== __Example__

606 -- ==== __Example__

597 --

607 --

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

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

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

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

600 --

610 --

601 -- @

611 -- @

602− -- data Fruit a =

612+ -- data Fruit a = Fruit

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

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

604 -- , oranges :: 'Maybe' Int

614 -- , oranges :: 'Maybe' Int

605− -- }

615+ -- } deriving 'Generic'

606− --

607− -- options :: 'Options'

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

609 --

616 --

610 -- -- apples required, oranges optional

617 -- -- apples required, oranges optional

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

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

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

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

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

614 --

620 --

615 -- -- apples optional, oranges optional

621 -- -- apples optional, oranges optional

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

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

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

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

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

624+ --

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

619 -- @

635 -- @

620 , sumEncoding :: SumEncoding

636 , sumEncoding :: SumEncoding

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

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

Data/Aeson/Types/ToJSON.hs−1

@@ -79,7 +79,6 @@ 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 ((<>))

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

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

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

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

85import Data.Scientific (Scientific)

84import Data.Scientific (Scientific)

aeson.cabal+2−2

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

116

117 -- Compat

118 build-depends:

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

119+ base-compat-batteries >= 0.10.0 && < 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+3−18

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

1−{-# LANGUAGE CPP #-}

2{-# LANGUAGE NoImplicitPrelude #-}

1{-# LANGUAGE NoImplicitPrelude #-}

3-- |

2-- |

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

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

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

19

18

20import Prelude.Compat

19import Prelude.Compat

21

20

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

22import Data.Int (Int64)

23−import Data.Time

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

24−import Unsafe.Coerce (unsafeCoerce)

25−

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

27−

28−import Data.Time.Clock (diffTimeToPicoseconds)

24+import Data.Time.Clock.Compat

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

40

25

41toPico :: Integer -> Pico

26toPico :: Integer -> Pico

42toPico = MkFixed

27toPico = MkFixed

tests/UnitTests.hs+8

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

5{-# LANGUAGE OverloadedStrings #-}

6{-# LANGUAGE ScopedTypeVariables #-}

7{-# LANGUAGE TemplateHaskell #-}

8+{-# LANGUAGE TypeFamilies #-}

8{-# LANGUAGE QuasiQuotes #-}

9{-# LANGUAGE QuasiQuotes #-}

9

10

10-- For Data.Aeson.Types.camelTo

11-- For Data.Aeson.Types.camelTo

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

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

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

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

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

749

750

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+

750deriveJSON defaultOptions{omitNothingFields=True} ''MyRecord

756deriveJSON defaultOptions{omitNothingFields=True} ''MyRecord

751

757

752deriveToJSON defaultOptions ''Foo

758deriveToJSON defaultOptions ''Foo

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

758deriveJSON defaultOptions{rejectUnknownFields=True} ''UnknownFieldsTag

764deriveJSON defaultOptions{rejectUnknownFields=True} ''UnknownFieldsTag

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

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

760deriveJSON defaultOptions{rejectUnknownFields=True} ''UnknownFieldsSum

766deriveJSON defaultOptions{rejectUnknownFields=True} ''UnknownFieldsSum

767+

768+deriveToJSON1 defaultOptions ''Newtype757