eb60a38..master · typeable/aeson

git.iko.soy/typeable/aeson

13 files changed+61−117

unifiedsplit

Data/Aeson.hs+3−3 Data/Aeson/Encoding/Builder.hs+1 Data/Aeson/Encoding/Internal.hs+1 Data/Aeson/Parser/Internal.hs+5−29 Data/Aeson/TH.hs+14−41 Data/Aeson/Text.hs+1 Data/Aeson/Types.hs−1 Data/Aeson/Types/FromJSON.hs+1 Data/Aeson/Types/Internal.hs+14−30 Data/Aeson/Types/ToJSON.hs+1 aeson.cabal+2−2 attoparsec-iso8601/Data/Attoparsec/Time/Internal.hs+18−3 tests/UnitTests.hs−8

Data/Aeson.hs+3−3

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

149149import Data.Aeson.Encoding (encodingToLazyByteString)

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

151151import Data.Aeson.Types

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

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

153153import qualified Data.ByteString as B

154154import qualified Data.ByteString.Lazy as L

155155

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

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

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

259259eitherDecodeFileStrict =

260− fmap eitherDecodeStrict . B.readFile

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

261261{-# INLINE eitherDecodeFileStrict #-}

262262

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

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

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

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

276276eitherDecodeFileStrict' =

277− fmap eitherDecodeStrict' . B.readFile

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

278278{-# INLINE eitherDecodeFileStrict' #-}

279279

280280-- $use

Data/Aeson/Encoding/Builder.hs+1

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

4444import Data.ByteString.Builder.Prim as BP

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

4646import Data.Char (chr, ord)

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

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

4849import Data.Text.Encoding (encodeUtf8BuilderEscaped)

4950import Data.Time (UTCTime(..))

Data/Aeson/Encoding/Internal.hs+1

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

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

6464import Data.Int

6565import Data.Scientific (Scientific)

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

6667import Data.Text (Text)

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

6869import Data.Typeable (Typeable)

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

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

6767import qualified Data.ByteString as B

6868import qualified Data.ByteString.Unsafe as B

6969import 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

7370import qualified Data.HashMap.Strict as H

7471import qualified Data.Scientific as Sci

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

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

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

394391 ISuccess a -> Right a

395392 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)

397394 where

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

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

400− buildMsg notYetParsed (expectation:_) msg =

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

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

396+ buildMsg [] msg = msg

397+ buildMsg (expectation:_) msg =

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

402399{-# INLINE eitherDecodeWith #-}

403400

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−

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

426402 -> Either (JSONPath, String) a

427403eitherDecodeStrictWith p to s =

Data/Aeson/TH.hs+14−41

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

116116 , mkLiftParseJSON2

117117 ) where

118118

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)

119+import Prelude.Compat

123120

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

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

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

13071304 tyVarNames :: [Name]

13081305 tyVarNames = M.keys tvMap

13091306

1310− itf <- isInTypeFamilyApp tyVarNames tyCon tyArgs

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

1307+ itf <- isTyFamily tyCon

1308+ if any (`mentionsName` tyVarNames) lhsArgs

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

13121310 then outOfPlaceTyVarError jc conName

13131311 else if any (`mentionsName` tyVarNames) rhsArgs

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

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

16591657isTyVar (SigT t _) = isTyVar t

16601658isTyVar _ = False

16611659

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

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

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

1680− info <- reify tcName

1681− case info of

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

1661+isTyFamily :: Type -> Q Bool

1662+isTyFamily (ConT n) = do

1663+ info <- reify n

1664+ return $ case info of

16821665#if MIN_VERSION_template_haskell(2,11,0)

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

1684− -> withinFirstArgs bndrs

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

1686− -> withinFirstArgs bndrs

1666+ FamilyI OpenTypeFamilyD{} _ -> True

16871667#else

1688− FamilyI (FamilyD TypeFam _ bndrs _) _

1689− -> withinFirstArgs bndrs

1690− FamilyI (ClosedTypeFamilyD _ bndrs _ _) _

1691− -> withinFirstArgs bndrs

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

16921669#endif

1693− _ -> return False

1694− where

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

1670+ FamilyI ClosedTypeFamilyD{} _ -> True

1671+ _ -> False

1672+isTyFamily _ = return False

17001673

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

17021675unSigT :: Type -> Type

Data/Aeson/Text.hs+1

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

2626

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

2828import Data.Aeson.Encoding (encodingToLazyByteString)

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

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

3031import Data.Text.Lazy.Builder

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

Data/Aeson/Types.hs−1

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

3535 , parse

3636 , parseEither

3737 , parseMaybe

38− , parseFail

3938 , ToJSON(..)

4039 , KeyValue(..)

4140 , modifyFailure

Data/Aeson/Types/FromJSON.hs+1

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

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

9797import Data.List.NonEmpty (NonEmpty(..))

9898import Data.Maybe (fromMaybe)

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

99100import Data.Proxy (Proxy(..))

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

101102import Data.Scientific (Scientific, base10Exponent)

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

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

4444 , parse

4545 , parseEither

4646 , parseMaybe

47− , parseFail

4847 , modifyFailure

4948 , prependFailure

5049 , parserThrowError

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

9594import Data.Hashable (Hashable(..))

9695import Data.List (intercalate)

9796import Data.Scientific (Scientific)

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

9898import Data.String (IsString(..))

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

100100import Data.Time (UTCTime)

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

342342 mappend = (<>)

343343 {-# INLINE mappend #-}

344344

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

346−parseFail :: String -> Parser a

347−parseFail = fail

348−

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

350346apP d e = do

351347 b <- d

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

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

586582 -- follow the `sumEncoding`.

587583 , omitNothingFields :: Bool

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

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

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

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

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

591587 --

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

596588 -- === Note

597589 --

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

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

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

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

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

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

602594 -- specialized upfront in the instance.

603595 --

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

605− --

606596 -- ==== __Example__

607597 --

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

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

610600 --

611601 -- @

612− -- data Fruit a = Fruit

602+ -- data Fruit a =

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

614604 -- , oranges :: 'Maybe' Int

615− -- } deriving 'Generic'

605+ -- }

606+ --

607+ -- options :: 'Options'

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

616609 --

617610 -- -- apples required, oranges optional

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

620614 --

621615 -- -- apples optional, oranges optional

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

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

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

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

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

635619 -- @

636620 , sumEncoding :: SumEncoding

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

Data/Aeson/Types/ToJSON.hs+1

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

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

8080import Data.List (intersperse)

8181import Data.List.NonEmpty (NonEmpty(..))

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

8283import Data.Proxy (Proxy(..))

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

8485import Data.Scientific (Scientific)

aeson.cabal+2−2

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

116116

117117 -- Compat

118118 build-depends:

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

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

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

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

121121

122122 if !impl(ghc >= 8.6)

123123 build-depends:

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

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

1+{-# LANGUAGE CPP #-}

12{-# LANGUAGE NoImplicitPrelude #-}

23-- |

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

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

1819

1920import Prelude.Compat

2021

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

2222import Data.Int (Int64)

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

24−import Data.Time.Clock.Compat

23+import Data.Time

24+import Unsafe.Coerce (unsafeCoerce)

25+

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

27+

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

2540

2641toPico :: Integer -> Pico

2742toPico = MkFixed

tests/UnitTests.hs−8

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

55{-# LANGUAGE OverloadedStrings #-}

66{-# LANGUAGE ScopedTypeVariables #-}

77{-# LANGUAGE TemplateHaskell #-}

8−{-# LANGUAGE TypeFamilies #-}

98{-# LANGUAGE QuasiQuotes #-}

109

1110-- For Data.Aeson.Types.camelTo

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

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

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

750749

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−

756750deriveJSON defaultOptions{omitNothingFields=True} ''MyRecord

757751

758752deriveToJSON defaultOptions ''Foo

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

764758deriveJSON defaultOptions{rejectUnknownFields=True} ''UnknownFieldsTag

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

766760deriveJSON defaultOptions{rejectUnknownFields=True} ''UnknownFieldsSum

767−

768−deriveToJSON1 defaultOptions ''Newtype757