git.iko.soy/typeable/aeson
on 63e731c help sign in
817ad94
swap
5 ahead, 0 behind
3 files changed+64−28
since splitsnapshots
unifiedsplit
Data/Aeson.hs+2−2 Data/Aeson/TH.hs+37−13 Data/Aeson/Types/Internal.hs+25−13
Data/Aeson.hs+2−2
@@ -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 (eitherFormatError . eitherDecodeStrictWith jsonEOF ifromJSON) . B.readFile
260+ fmap eitherDecodeStrict . 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 (eitherFormatError . eitherDecodeStrictWith jsonEOF' ifromJSON) . B.readFile
277+ fmap eitherDecodeStrict' . B.readFile
278278{-# INLINE eitherDecodeFileStrict' #-}
279279
280280-- $use
Data/Aeson/TH.hs+37−13
@@ -1304,9 +1304,8 @@ dispatchFunByType jc jf conName tvMap list ty = do
13041304 tyVarNames :: [Name]
13051305 tyVarNames = M.keys tvMap
13061306
1307− itf <- isTyFamily tyCon
1308− if any (`mentionsName` tyVarNames) lhsArgs
1309− || itf && any (`mentionsName` tyVarNames) tyArgs
1307+ itf <- isInTypeFamilyApp tyVarNames tyCon tyArgs
1308+ if any (`mentionsName` tyVarNames) lhsArgs || itf
13101309 then outOfPlaceTyVarError jc conName
13111310 else if any (`mentionsName` tyVarNames) rhsArgs
13121311 then appsE $ varE (jsonFunValOrListName list jf $ toEnum numLastArgs)
@@ -1657,19 +1656,44 @@ isTyVar (VarT _) = True
16571656isTyVar (SigT t _) = isTyVar t
16581657isTyVar _ = False
16591658
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
1659+-- | Detect if a Name in a list of provided Names occurs as an argument to some
1660+-- type family. This makes an effort to exclude /oversaturated/ arguments to
1661+-- type families. For instance, if one declared the following type family:
1662+--
1663+-- @
1664+-- type family F a :: Type -> Type
1665+-- @
1666+--
1667+-- Then in the type @F a b@, we would consider @a@ to be an argument to @F@,
1668+-- but not @b@.
1669+isInTypeFamilyApp :: [Name] -> Type -> [Type] -> Q Bool
1670+isInTypeFamilyApp names tyFun tyArgs =
1671+ case tyFun of
1672+ ConT tcName -> go tcName
1673+ _ -> return False
1674+ where
1675+ go :: Name -> Q Bool
1676+ go tcName = do
1677+ info <- reify tcName
1678+ case info of
16651679#if MIN_VERSION_template_haskell(2,11,0)
1666− FamilyI OpenTypeFamilyD{} _ -> True
1680+ FamilyI (OpenTypeFamilyD (TypeFamilyHead _ bndrs _ _)) _
1681+ -> withinFirstArgs bndrs
1682+ FamilyI (ClosedTypeFamilyD (TypeFamilyHead _ bndrs _ _) _) _
1683+ -> withinFirstArgs bndrs
16671684#else
1668− FamilyI (FamilyD TypeFam _ _ _) _ -> True
1685+ FamilyI (FamilyD TypeFam _ bndrs _) _
1686+ -> withinFirstArgs bndrs
1687+ FamilyI (ClosedTypeFamilyD _ bndrs _ _) _
1688+ -> withinFirstArgs bndrs
16691689#endif
1670− FamilyI ClosedTypeFamilyD{} _ -> True
1671− _ -> False
1672−isTyFamily _ = return False
1690+ _ -> return False
1691+ where
1692+ withinFirstArgs :: [a] -> Q Bool
1693+ withinFirstArgs bndrs =
1694+ let firstArgs = take (length bndrs) tyArgs
1695+ argFVs = freeVariables firstArgs
1696+ in return $ any (`elem` argFVs) names
16731697
16741698-- | Peel off a kind signature from a Type (if it has one).
16751699unSigT :: Type -> Type
Data/Aeson/Types/Internal.hs+25−13
@@ -581,41 +581,53 @@ data Options = Options
581581 -- the constructor tag. If 'False' the encoding will always
582582 -- follow the `sumEncoding`.
583583 , omitNothingFields :: Bool
584− -- ^ If 'True' record fields with a 'Nothing' value will be
585− -- 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
586586 -- object will include those fields mapping to @null@.
587587 --
588+ -- Note that this /does not/ affect parsing: 'Maybe' fields are
589+ -- optional regardless of the value of 'omitNothingFields', subject
590+ -- to the note below.
591+ --
588592 -- === Note
589593 --
590594 -- Setting 'omitNothingFields' to 'True' only affects fields which are of
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
595+ -- type 'Maybe' /uniformly/ in the 'ToJSON' instance.
596+ -- In particular, if the type of a field is declared as a type variable, it
593597 -- will not be omitted from the JSON object, unless the field is
594598 -- specialized upfront in the instance.
595599 --
600+ -- The same holds for 'Maybe' fields being optional in the 'FromJSON' instance.
601+ --
596602 -- ==== __Example__
597603 --
598604 -- The generic instance for the following type @Fruit@ depends on whether
599605 -- the instance head is @Fruit a@ or @Fruit (Maybe a)@.
600606 --
601607 -- @
602− -- data Fruit a =
608+ -- data Fruit a = Fruit
603609 -- { apples :: a -- A field whose type is a type variable.
604610 -- , oranges :: 'Maybe' Int
605− -- }
606− --
607− -- options :: 'Options'
608− -- options = 'defaultOptions' { 'omitNothingFields' = 'True' }
611+ -- } deriving 'Generic'
609612 --
610613 -- -- apples required, oranges optional
611614 -- -- Even if 'Data.Aeson.fromJSON' is then specialized to (Fruit ('Maybe' a)).
612− -- instance 'Data.Aeson.FromJSON' a => 'Data.Aeson.FromJSON' (Fruit a) where
613− -- 'Data.Aeson.fromJSON' = 'Data.Aeson.genericFromJSON' options
615+ -- instance 'Data.Aeson.FromJSON' a => 'Data.Aeson.FromJSON' (Fruit a)
614616 --
615617 -- -- apples optional, oranges optional
616618 -- -- 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
618− -- 'Data.Aeson.fromJSON' = 'Data.Aeson.genericFromJSON' options
619+ -- instance 'Data.Aeson.FromJSON' a => 'Data.Aeson.FromJSON' (Fruit ('Maybe' a))
620+ --
621+ -- options :: 'Options'
622+ -- options = 'defaultOptions' { 'omitNothingFields' = 'True' }
623+ --
624+ -- -- apples always present in the output, oranges is omitted if 'Nothing'
625+ -- instance 'Data.Aeson.ToJSON' a => 'Data.Aeson.ToJSON' (Fruit a) where
626+ -- 'Data.Aeson.toJSON' = 'Data.Aeson.genericToJSON' options
627+ --
628+ -- -- both apples and oranges are omitted if 'Nothing'
629+ -- instance 'Data.Aeson.ToJSON' a => 'Data.Aeson.ToJSON' (Fruit ('Maybe' a)) where
630+ -- 'Data.Aeson.toJSON' = 'Data.Aeson.genericToJSON' options
619631 -- @
620632 , sumEncoding :: SumEncoding
621633 -- ^ Specifies how to encode constructors of a sum datatype.