1329a06 · typeable/aeson

54

55instance (ConsToJSON a) => GToJSON (C1 c a) where

56 -- Constructors need to be encoded differently depending on whether they're

57− -- a record or not. This distinction is made by constToJSON:

57+ -- a record or not. This distinction is made by 'constToJSON':

58 gToJSON opts = consToJSON opts . unM1

59 {-# INLINE gToJSON #-}

60

61instance ( WriteProduct a, WriteProduct b

62 , ProductSize a, ProductSize b ) => GToJSON (a :*: b) where

63 -- Products are encoded to an array. Here we allocate a mutable vector of

64− -- the the same size as the product and write the product's elements to it

64+ -- the same size as the product and write the product's elements to it using

65− -- using writeProduct:

65+ -- 'writeProduct':

66 gToJSON opts p =

67 Array $ V.create $ do

68 mv <- VM.unsafeNew lenProduct

73 productSize

74 {-# INLINE gToJSON #-}

75

76−instance ( AllNullary (a :+: b) bool

76+instance ( AllNullary (a :+: b) allNullary

77− , SumToJSON (a :+: b) bool ) => GToJSON (a :+: b) where

77+ , SumToJSON (a :+: b) allNullary ) => GToJSON (a :+: b) where

78 -- If all constructors of a sum datatype are nullary and the

79 -- 'nullaryToString' option is set they are encoded to strings.

80 -- This distinction is made by 'sumToJSON':

81− gToJSON opts = (unTagged :: Tagged bool Value -> Value)

81+ gToJSON opts = (unTagged :: Tagged allNullary Value -> Value)

82 . sumToJSON opts

83 {-# INLINE gToJSON #-}

84

85--------------------------------------------------------------------------------

86

87−class SumToJSON f bool where

87+class SumToJSON f allNullary where

88− sumToJSON :: Options -> f a -> Tagged bool Value

88+ sumToJSON :: Options -> f a -> Tagged allNullary Value

89

90instance ( GetConName f

91 , ObjectWithType f

128 objectWithType opts typeFieldName valueFieldName x

129 {-# INLINE objectWithType #-}

130

131−instance ( IsRecord a bool

131+instance ( IsRecord a isRecord

132− , ObjectWithType' a bool

132+ , ObjectWithType' a isRecord

133 , Constructor c ) => ObjectWithType (C1 c a) where

134 objectWithType opts typeFieldName valueFieldName =

135 (pack typeFieldName .= constructorNameModifier opts

136 (conName (undefined :: t c a p)) :) .

137− (unTagged :: Tagged bool [Pair] -> [Pair]) .

137+ (unTagged :: Tagged isRecord [Pair] -> [Pair]) .

138 objectWithType' opts valueFieldName . unM1

139 {-# INLINE objectWithType #-}

140

141−class ObjectWithType' f bool where

141+class ObjectWithType' f isRecord where

142− objectWithType' :: Options -> String -> f a -> Tagged bool [Pair]

142+ objectWithType' :: Options -> String -> f a -> Tagged isRecord [Pair]

143

144−instance (GRecordToPairs f) => ObjectWithType' f True where

144+instance (RecordToPairs f) => ObjectWithType' f True where

145− objectWithType' opts _ = Tagged . toList . gRecordToPairs opts

145+ objectWithType' opts _ = Tagged . toList . recordToPairs opts

146 {-# INLINE objectWithType' #-}

147

148instance (GToJSON f) => ObjectWithType' f False where

190class ConsToJSON f where

191 consToJSON :: Options -> f a -> Value

192

193−class ConsToJSON' f bool where

193+class ConsToJSON' f isRecord where

194− consToJSON' :: Options -> f a -> Tagged bool Value

194+ consToJSON' :: Options -> f a -> Tagged isRecord Value

195

196−instance ( IsRecord f bool

196+instance ( IsRecord f isRecord

197− , ConsToJSON' f bool ) => ConsToJSON f where

197+ , ConsToJSON' f isRecord ) => ConsToJSON f where

198− consToJSON opts = (unTagged :: Tagged bool Value -> Value)

198+ consToJSON opts = (unTagged :: Tagged isRecord Value -> Value)

199 . consToJSON' opts

200 {-# INLINE consToJSON #-}

201

202−instance (GRecordToPairs f) => ConsToJSON' f True where

202+instance (RecordToPairs f) => ConsToJSON' f True where

203− consToJSON' opts = Tagged . object . toList . gRecordToPairs opts

203+ consToJSON' opts = Tagged . object . toList . recordToPairs opts

204 {-# INLINE consToJSON' #-}

205

206instance GToJSON f => ConsToJSON' f False where

209

210--------------------------------------------------------------------------------

211

212−class GRecordToPairs f where

212+class RecordToPairs f where

213− gRecordToPairs :: Options -> f a -> DList Pair

213+ recordToPairs :: Options -> f a -> DList Pair

214

215−instance (GRecordToPairs a, GRecordToPairs b) => GRecordToPairs (a :*: b) where

215+instance (RecordToPairs a, RecordToPairs b) => RecordToPairs (a :*: b) where

216− gRecordToPairs opts (a :*: b) = gRecordToPairs opts a `mappend`

216+ recordToPairs opts (a :*: b) = recordToPairs opts a `mappend`

217− gRecordToPairs opts b

217+ recordToPairs opts b

218− {-# INLINE gRecordToPairs #-}

218+ {-# INLINE recordToPairs #-}

219

220−instance (Selector s, GToJSON a) => GRecordToPairs (S1 s a) where

220+instance (Selector s, GToJSON a) => RecordToPairs (S1 s a) where

221− gRecordToPairs opts m1 = pure ( pack $ fieldNameModifier opts $ selName m1

221+ recordToPairs = fieldToPair

222− , gToJSON opts (unM1 m1)

222+ {-# INLINE recordToPairs #-}

223− )

224− {-# INLINE gRecordToPairs #-}

225

223

226−instance (Selector s, ToJSON a) => GRecordToPairs (S1 s (K1 i (Maybe a))) where

224+instance (Selector s, ToJSON a) => RecordToPairs (S1 s (K1 i (Maybe a))) where

227− gRecordToPairs opts (M1 k1) | omitNothingFields opts

225+ recordToPairs opts (M1 k1) | omitNothingFields opts

228− , K1 Nothing <- k1 = empty

226+ , K1 Nothing <- k1 = empty

227+ recordToPairs opts m1 = fieldToPair opts m1

228+ {-# INLINE recordToPairs #-}

229+

230+fieldToPair :: (Selector s, GToJSON a) => Options -> S1 s a p -> DList Pair

229− gRecordToPairs opts m1 = pure ( pack $ fieldNameModifier opts $ selName m1

231+fieldToPair opts m1 = pure ( pack $ fieldNameModifier opts $ selName m1

230− , gToJSON opts (unM1 m1)

232+ , gToJSON opts (unM1 m1)

231− )

233+ )

232− {-# INLINE gRecordToPairs #-}

234+{-# INLINE fieldToPair #-}

233

235

234--------------------------------------------------------------------------------

236--------------------------------------------------------------------------------

235

237

318 " elements instead"

320 " elements instead"

319 {-# INLINE gParseJSON #-}

321 {-# INLINE gParseJSON #-}

320

322

321−instance ( AllNullary (a :+: b) bool

323+instance ( AllNullary (a :+: b) allNullary

322− , ParseSum (a :+: b) bool ) => GFromJSON (a :+: b) where

324+ , ParseSum (a :+: b) allNullary ) => GFromJSON (a :+: b) where

323 -- If all constructors of a sum datatype are nullary and the

325 -- If all constructors of a sum datatype are nullary and the

324 -- 'nullaryToString' option is set they are expected to be encoded as

326 -- 'nullaryToString' option is set they are expected to be encoded as

325 -- strings. This distinction is made by 'parseSum':

327 -- strings. This distinction is made by 'parseSum':

326− gParseJSON opts = (unTagged :: Tagged bool (Parser ((a :+: b) d)) ->

328+ gParseJSON opts = (unTagged :: Tagged allNullary (Parser ((a :+: b) d)) ->

327− (Parser ((a :+: b) d)))

329+ (Parser ((a :+: b) d)))

328 . parseSum opts

330 . parseSum opts

329 {-# INLINE gParseJSON #-}

331 {-# INLINE gParseJSON #-}

330

332

331--------------------------------------------------------------------------------

333--------------------------------------------------------------------------------

332

334

333−class ParseSum f bool where

335+class ParseSum f allNullary where

334− parseSum :: Options -> Value -> Tagged bool (Parser (f a))

336+ parseSum :: Options -> Value -> Tagged allNullary (Parser (f a))

335

337

336instance ( SumFromString (a :+: b)

338instance ( SumFromString (a :+: b)

337 , FromPair (a :+: b)

339 , FromPair (a :+: b)

429class FromObjectWithType' f where

431class FromObjectWithType' f where

430 parseFromObjectWithType' :: Options -> String -> Object -> Parser (f a)

432 parseFromObjectWithType' :: Options -> String -> Object -> Parser (f a)

431

433

432−class FromObjectWithType'' f bool where

434+class FromObjectWithType'' f isRecord where

433 parseFromObjectWithType'' :: Options -> String -> Object

435 parseFromObjectWithType'' :: Options -> String -> Object

434− -> Tagged bool (Parser (f a))

436+ -> Tagged isRecord (Parser (f a))

435

437

436−instance ( IsRecord f bool

438+instance ( IsRecord f isRecord

437− , FromObjectWithType'' f bool

439+ , FromObjectWithType'' f isRecord

438 ) => FromObjectWithType' f where

440 ) => FromObjectWithType' f where

439 parseFromObjectWithType' opts valueFieldName =

441 parseFromObjectWithType' opts valueFieldName =

440− (unTagged :: Tagged bool (Parser (f a)) -> Parser (f a)) .

442+ (unTagged :: Tagged isRecord (Parser (f a)) -> Parser (f a)) .

441 parseFromObjectWithType'' opts valueFieldName

443 parseFromObjectWithType'' opts valueFieldName

442 {-# INLINE parseFromObjectWithType' #-}

444 {-# INLINE parseFromObjectWithType' #-}

443

445

455class ConsFromJSON f where

457class ConsFromJSON f where

456 consParseJSON :: Options -> Value -> Parser (f a)

458 consParseJSON :: Options -> Value -> Parser (f a)

457

459

458−class ConsFromJSON' f bool where

460+class ConsFromJSON' f isRecord where

459− consParseJSON' :: Options -> Value -> Tagged bool (Parser (f a))

461+ consParseJSON' :: Options -> Value -> Tagged isRecord (Parser (f a))

460

462

461−instance ( IsRecord f bool

463+instance ( IsRecord f isRecord

462− , ConsFromJSON' f bool

464+ , ConsFromJSON' f isRecord

463 ) => ConsFromJSON f where

465 ) => ConsFromJSON f where

464− consParseJSON opts = (unTagged :: Tagged bool (Parser (f a)) -> Parser (f a))

466+ consParseJSON opts = (unTagged :: Tagged isRecord (Parser (f a)) -> Parser (f a))

465 . consParseJSON' opts

467 . consParseJSON' opts

466 {-# INLINE consParseJSON #-}

468 {-# INLINE consParseJSON #-}

467

469

551

553

552--------------------------------------------------------------------------------

554--------------------------------------------------------------------------------

553

555

554−class IsRecord (f :: * -> *) bool | f -> bool

556+class IsRecord (f :: * -> *) isRecord | f -> isRecord

555

557

556−data True

557−data False

558−

559−instance (IsRecord f bool) => IsRecord (f :*: g) bool

558+instance (IsRecord f isRecord) => IsRecord (f :*: g) isRecord

560instance IsRecord (M1 S NoSelector f) False

559instance IsRecord (M1 S NoSelector f) False

561−instance (IsRecord f bool) => IsRecord (M1 S c f) bool

560+instance (IsRecord f isRecord) => IsRecord (M1 S c f) isRecord

562instance IsRecord (K1 i c) True

561instance IsRecord (K1 i c) True

563instance IsRecord U1 False

562instance IsRecord U1 False

564

563

565--------------------------------------------------------------------------------

564--------------------------------------------------------------------------------

566

565

567−class AllNullary (f :: * -> *) bool | f -> bool

566+class AllNullary (f :: * -> *) allNullary | f -> allNullary

568

567

569−instance ( AllNullary a bool1

568+instance ( AllNullary a allNullaryL

570− , AllNullary b bool2

569+ , AllNullary b allNullaryR

571− , And bool1 bool2 bool3

570+ , And allNullaryL allNullaryR allNullary

572− ) => AllNullary (a :+: b) bool3

571+ ) => AllNullary (a :+: b) allNullary

573−instance AllNullary a bool => AllNullary (M1 i c a) bool

572+instance AllNullary a allNullary => AllNullary (M1 i c a) allNullary

574instance AllNullary (a :*: b) False

573instance AllNullary (a :*: b) False

575instance AllNullary (K1 i c) False

574instance AllNullary (K1 i c) False

576instance AllNullary U1 True

575instance AllNullary U1 True

577

576

577+--------------------------------------------------------------------------------

578+

579+data True

580+data False

581+

578class And bool1 bool2 bool3 | bool1 bool2 -> bool3

582class And bool1 bool2 bool3 | bool1 bool2 -> bool3

579

583

580instance And True True True

584instance And True True True