b67aa29 · typeable/aeson

git.iko.soy/typeable/aeson

Migrate TH code to use Data.Aeson.Encoding

commitb67aa291e1c4a70123cd8e6bbca70f65244b44b3 authorOleg Grenrus <oleg.grenrus@iki.fi> dateThu 2 Jun 2016, 21:15 (10 years ago) parent518ebeb

3 files changed+43−19

compare with master

unifiedsplit

Data/Aeson/Encode/Functions.hs+1−2 Data/Aeson/Encoding.hs+28−1 Data/Aeson/TH.hs+14−16

Data/Aeson/Encode/Functions.hs+1−2

@@ -3,12 +3,11 @@

33module Data.Aeson.Encode.Functions

44 (

55 builder

6− , char7 -- TODO: used by TH module

76 ) where

98import Data.Aeson.Encoding

109import Data.Aeson.Types.Class

11−import Data.ByteString.Builder (Builder, char7)

10+import Data.ByteString.Builder (Builder)

1211import Data.Monoid ((<>))

1312

1413builder :: ToJSON a => a -> Builder

Data/Aeson/Encoding.hs+28−1

@@ -10,12 +10,18 @@ module Data.Aeson.Encoding

1010 -- * Encoding constructors

1111 , emptyArray_

1212 , emptyObject_

13+ , wrapArray

14+ , wrapObject

15+ , text

1316 , list

14− , dict

17+ , dict

1518 , tuple

1619 , (>*<)

20+ -- ** chars

21+ , comma, colon, openBracket, closeBracket, openCurly, closeCurly

1722 ) where

1823

24+import Data.Text (Text)

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

2026import Data.Semigroup (Semigroup((<>)))

2127import Data.ByteString.Builder.Prim (primBounded)

@@ -79,6 +85,12 @@ emptyArray_ = Encoding B.emptyArray_

7985emptyObject_ :: Encoding

8086emptyObject_ = Encoding B.emptyObject_

8187

88+wrapArray :: Encoding -> Encoding

89+wrapArray e = openBracket <> e <> closeBracket

90+

91+wrapObject :: Encoding -> Encoding

92+wrapObject e = openCurly <> e <> closeCurly

93+

8294-- | Encode a series of key/value pairs, separated by commas.

8395pairs :: Series -> Encoding

8496pairs = brackets '{' '}'

@@ -126,3 +138,18 @@ Encoding a >*< Encoding b = Encoding $ a <> char7 ',' <> b

126138tuple :: Encoding -> Encoding

127139tuple b = Encoding (char7 '[' <> fromEncoding b <> char7 ']')

128140{-# INLINE tuple #-}

141+

142+text :: Text -> Encoding

143+text = Encoding . B.text

144+

145+-------------------------------------------------------------------------------

146+-- chars

147+-------------------------------------------------------------------------------

148+

149+comma, colon, openBracket, closeBracket, openCurly, closeCurly :: Encoding

150+comma = Encoding $ char7 ','

151+colon = Encoding $ char7 ':'

152+openBracket = Encoding $ char7 '['

153+closeBracket = Encoding $ char7 ']'

154+openCurly = Encoding $ char7 '{'

155+closeCurly = Encoding $ char7 '}'

Data/Aeson/TH.hs+14−16

@@ -108,7 +108,6 @@ import Data.Aeson.Types ( Value(..), Parser

108108 , defaultTaggedObject

109109 )

110110import Data.Aeson.Types.Internal ((<?>), JSONPathElement(Key))

111−import Data.Aeson.Encoding ( Encoding(..) )

112111import Control.Monad ( liftM2, return, mapM, fail )

113112import Data.Bool ( Bool(False, True), otherwise, (&&), not )

114113import Data.Either ( Either(Left, Right) )

@@ -141,8 +140,7 @@ import Prelude ( head )

141140import Text.Printf ( printf )

142141import Text.Show ( show )

143142import qualified Data.Aeson as A

144−import qualified Data.Aeson.Encode.Builder as E

145−import qualified Data.Aeson.Encode.Functions as E

143+import qualified Data.Aeson.Encoding as E

146144import qualified Data.HashMap.Strict as H ( lookup, toList )

147145import qualified Data.Map as M ( fromList, findWithDefault )

148146import qualified Data.Text as T ( Text, pack, unpack )

@@ -292,7 +290,7 @@ consToEncoding opts cons = do

292290 matches

293291 | allNullaryToStringTag opts && all isNullary cons =

294292 [ match (conP conName [])

295− (normalB $ [|Encoding|] `appE` encStr opts conName) []

293+ (normalB $ encStr opts conName) []

296294 | con <- cons

297295 , let conName = getConName con

298296 ]

@@ -459,23 +457,23 @@ isMaybe _ = False

459457infixr 6 <^>

460458

461459(<:>) :: ExpQ -> ExpQ -> ExpQ

462−(<:>) a b = a <^> [|E.char7 ':'|] <^> b

460+(<:>) a b = a <^> [|E.colon|] <^> b

463461infixr 5 <:>

464462

465463(<%>) :: ExpQ -> ExpQ -> ExpQ

466−(<%>) a b = a <^> [|E.char7 ','|] <^> b

464+(<%>) a b = a <^> [|E.comma|] <^> b

467465infixr 4 <%>

468466

469467array :: ExpQ -> ExpQ

468+array exp = [|E.wrapArray|] `appE` exp

471469

472470object :: ExpQ -> ExpQ

473−object exp = [|Encoding|] `appE` ([|E.char7 '{'|] <^> exp <^> [|E.char7 '}'|])

471+object exp = [|E.wrapObject|] `appE` exp

474472

475473sumToEncoding :: Options -> Bool -> Name -> Q Exp -> Q Exp

476474sumToEncoding opts multiCons conName exp

477475 | multiCons =

478− let fexp = [|fromEncoding|] `appE` exp in

476+ let fexp = exp in

479477 case sumEncoding opts of

480478 TwoElemArray ->

481479 array (encStr opts conName <%> fexp)

@@ -515,7 +513,7 @@ argsToEncoding opts multiCons (NormalC conName ts) = do

515513 [e] -> return ([|toEncoding|] `appE` varE e)

516514 -- Multiple arguments are converted to a JSON array.

517515 es ->

518− return (array (foldr1 (<%>) [[|E.builder|] `appE` varE x | x <- es]))

516+ return (array (foldr1 (<%>) [[|toEncoding|] `appE` varE x | x <- es]))

519517 match (conP conName $ map varP args)

520518 (normalB $ sumToEncoding opts multiCons conName js)

521519 []

@@ -529,7 +527,7 @@ argsToEncoding opts multiCons (RecC conName ts) = case (unwrapUnaryRecords opts,

529527 let exp = object objBody

530528

531529 objBody = [|mconcat|] `appE`

532− ([|intersperse (E.char7 ',')|] `appE` pairs)

530+ ([|intersperse E.comma|] `appE` pairs)

533531 pairs | omitNothingFields opts = infixApp maybeFields

534532 [|(<>)|]

535533 restFields

@@ -547,16 +545,16 @@ argsToEncoding opts multiCons (RecC conName ts) = case (unwrapUnaryRecords opts,

547545 infixApp

548546 (infixApp

549547 (infixE

550− (Just $ toFieldName field <^> [|E.char7 ':'|])

548+ (Just $ toFieldName field <^> [|E.colon|])

551549 [|(<>)|]

552550 Nothing)

553551 [|(.)|]

554− [|E.builder|])

552+ [|toEncoding|])

555553 [|(<$>)|]

556554 (varE arg)

557555

558556 toPair (arg, (field, _, _)) =

559− toFieldName field <:> [|E.builder|] `appE` varE arg

557+ toFieldName field <:> [|toEncoding|] `appE` varE arg

560558

561559 toFieldName field = [|E.text|] `appE`

562560 ([|T.pack|] `appE` fieldLabelExp opts field)

@@ -566,13 +564,13 @@ argsToEncoding opts multiCons (RecC conName ts) = case (unwrapUnaryRecords opts,

566564 $ if multiCons

567565 then case sumEncoding opts of

568566 TwoElemArray -> array $

569− encStr opts conName <%> [|fromEncoding|] `appE` exp

567+ encStr opts conName <%> exp

570568 TaggedObject{tagFieldName} -> object $

571569 ([|E.text (T.pack tagFieldName)|] <:>

572570 encStr opts conName) <%>

573571 objBody

574572 ObjectWithSingleField -> object $

575− encStr opts conName <:> [|fromEncoding|] `appE` exp

573+ encStr opts conName <:> exp

576574 else exp

577575 ) []

578576