@@ -13,19 +13,25 @@ import Data.Data (Data)
1313import GHC.Generics (Generic)
1414
1515import Data.Aeson.Types
16−import Data.Aeson.TH (mkToJSON, mkParseJSON)
16+import Data.Aeson.TH
1717import qualified Data.Aeson.Generic as G (fromJSON, toJSON)
1818
19+import Data.Aeson.Encode
20+
21+import Options
22+
1923--------------------------------------------------------------------------------
2024
21−-- Taken from the documentation of Data.Aeson.TH:
2225data D a = Nullary
2326 | Unary Int
2427 | Product String Char a
2528 | Record { testOne :: Double
2629 , testTwo :: Bool
2730 , testThree :: D a
28− } deriving (Show, Eq, Generic, Data, Typeable)
31+ }
32+ deriving (Show, Eq, Data, Typeable)
33+
34+deriveJSON opts ''D
2935
3036instance NFData a => NFData (D a) where
3137 rnf Nullary = ()
@@ -47,17 +53,42 @@ d = Record
4753 }
4854 }
4955
50−instance ToJSON a => ToJSON (D a)
51−instance FromJSON a => FromJSON (D a)
52−
53−thDToJSON :: ToJSON a => D a -> Value
54−thDToJSON = $(mkToJSON defaultOptions ''D)
55−
56−thDParseJSON :: FromJSON a => Value -> Parser (D a)
57−thDParseJSON = $(mkParseJSON defaultOptions ''D)
56+--------------------------------------------------------------------------------
5857
59−thDFromJSON :: FromJSON a => Value -> Result (D a)
60−thDFromJSON = parse thDParseJSON
58+data D' a = Nullary'
59+ | Unary' Int
60+ | Product' String Char a
61+ | Record' { testOne' :: Double
62+ , testTwo' :: Bool
63+ , testThree' :: D' a
64+ }
65+ deriving (Show, Eq, Generic, Data, Typeable)
66+
67+instance ToJSON a => ToJSON (D' a) where
68+ toJSON = genericToJSON opts
69+
70+instance FromJSON a => FromJSON (D' a) where
71+ parseJSON = genericParseJSON opts
72+
73+instance NFData a => NFData (D' a) where
74+ rnf Nullary' = ()
75+ rnf (Unary' n) = rnf n
76+ rnf (Product' s c x) = s `deepseq` c `deepseq` rnf x
77+ rnf (Record' d b y) = d `deepseq` b `deepseq` rnf y
78+
79+type T' = D' (D' (D' ()))
80+
81+d' :: T'
82+d' = Record'
83+ { testOne' = 1234.56789
84+ , testTwo' = True
85+ , testThree' = Product' "Hello World!" 'a' $
86+ Record'
87+ { testOne' = 9876.54321
88+ , testTwo' = False
89+ , testThree' = Product' "Yeehaa!!!" '\n' Nullary'
90+ }
91+ }
6192
6293--------------------------------------------------------------------------------
6394
@@ -77,17 +108,17 @@ bigRecord = BigRecord 1 2 3 4 5
77108 16 17 18 19 20
78109 21 22 23 24 25
79110
80−instance ToJSON BigRecord
81−instance FromJSON BigRecord
111+gBigRecordToJSON :: BigRecord -> Value
112+gBigRecordToJSON = genericToJSON opts
82113
83−thBigRecordToJSON :: BigRecord -> Value
84−thBigRecordToJSON = $(mkToJSON defaultOptions ''BigRecord)
114+gBigRecordFromJSON :: Value -> Result BigRecord
115+gBigRecordFromJSON = parse $ genericParseJSON opts
85116
86−thBigRecordParseJSON :: Value -> Parser BigRecord
87−thBigRecordParseJSON = $(mkParseJSON defaultOptions ''BigRecord)
117+thBigRecordToJSON :: BigRecord -> Value
118+thBigRecordToJSON = $(mkToJSON opts ''BigRecord)
88119
89120thBigRecordFromJSON :: Value -> Result BigRecord
90−thBigRecordFromJSON = parse thBigRecordParseJSON
121+thBigRecordFromJSON = parse $(mkParseJSON opts ''BigRecord)
91122
92123--------------------------------------------------------------------------------
93124
@@ -107,17 +138,17 @@ bigProduct = BigProduct 1 2 3 4 5
107138 16 17 18 19 20
108139 21 22 23 24 25
109140
110−instance ToJSON BigProduct
111−instance FromJSON BigProduct
141+gBigProductToJSON :: BigProduct -> Value
142+gBigProductToJSON = genericToJSON opts
112143
113−thBigProductToJSON :: BigProduct -> Value
114−thBigProductToJSON = $(mkToJSON defaultOptions ''BigProduct)
144+gBigProductFromJSON :: Value -> Result BigProduct
145+gBigProductFromJSON = parse $ genericParseJSON opts
115146
116−thBigProductParseJSON :: Value -> Parser BigProduct
117−thBigProductParseJSON = $(mkParseJSON defaultOptions ''BigProduct)
147+thBigProductToJSON :: BigProduct -> Value
148+thBigProductToJSON = $(mkToJSON opts ''BigProduct)
118149
119150thBigProductFromJSON :: Value -> Result BigProduct
120−thBigProductFromJSON = parse thBigProductParseJSON
151+thBigProductFromJSON = parse $(mkParseJSON opts ''BigProduct)
121152
122153--------------------------------------------------------------------------------
123154
@@ -132,17 +163,17 @@ instance NFData BigSum
132163
133164bigSum = F25
134165
135−instance ToJSON BigSum
136−instance FromJSON BigSum
166+gBigSumToJSON :: BigSum -> Value
167+gBigSumToJSON = genericToJSON opts
137168
138−thBigSumToJSON :: BigSum -> Value
139−thBigSumToJSON = $(mkToJSON defaultOptions ''BigSum)
169+gBigSumFromJSON :: Value -> Result BigSum
170+gBigSumFromJSON = parse $ genericParseJSON opts
140171
141−thBigSumParseJSON :: Value -> Parser BigSum
142−thBigSumParseJSON = $(mkParseJSON defaultOptions ''BigSum)
172+thBigSumToJSON :: BigSum -> Value
173+thBigSumToJSON = $(mkToJSON opts ''BigSum)
143174
144175thBigSumFromJSON :: Value -> Result BigSum
145−thBigSumFromJSON = parse thBigSumParseJSON
176+thBigSumFromJSON = parse $(mkParseJSON opts ''BigSum)
146177
147178--------------------------------------------------------------------------------
148179
@@ -150,45 +181,45 @@ type FJ a = Value -> Result a
150181
151182main :: IO ()
152183main = defaultMain
153− [ let v = thDToJSON d
154− in d `deepseq` v `deepseq`
184+ [ let v = toJSON d
185+ in (d, d', v) `deepseq`
155186 bgroup "D"
156− [ group "toJSON" (nf thDToJSON d)
157− (nf G.toJSON d)
158− (nf toJSON d)
159− , group "fromJSON" (nf (thDFromJSON :: FJ T) v)
160− (nf (G.fromJSON :: FJ T) v)
161− (nf (fromJSON :: FJ T) v)
187+ [ group "toJSON" (nf toJSON d)
188+ (nf G.toJSON d)
189+ (nf toJSON d')
190+ , group "fromJSON" (nf ( fromJSON :: FJ T ) v)
191+ (nf (G.fromJSON :: FJ T ) v)
192+ (nf ( fromJSON :: FJ T') v)
162193 ]
163194 , let v = thBigRecordToJSON bigRecord
164195 in bigRecord `deepseq` v `deepseq`
165196 bgroup "BigRecord"
166197 [ group "toJSON" (nf thBigRecordToJSON bigRecord)
167198 (nf G.toJSON bigRecord)
168− (nf toJSON bigRecord)
199+ (nf gBigRecordToJSON bigRecord)
169200 , group "fromJSON" (nf (thBigRecordFromJSON :: FJ BigRecord) v)
170201 (nf (G.fromJSON :: FJ BigRecord) v)
171− (nf (fromJSON :: FJ BigRecord) v)
202+ (nf (gBigRecordFromJSON :: FJ BigRecord) v)
172203 ]
173204 , let v = thBigProductToJSON bigProduct
174205 in bigProduct `deepseq` v `deepseq`
175206 bgroup "BigProduct"
176207 [ group "toJSON" (nf thBigProductToJSON bigProduct)
177208 (nf G.toJSON bigProduct)
178− (nf toJSON bigProduct)
209+ (nf gBigProductToJSON bigProduct)
179210 , group "fromJSON" (nf (thBigProductFromJSON :: FJ BigProduct) v)
180211 (nf (G.fromJSON :: FJ BigProduct) v)
181− (nf (fromJSON :: FJ BigProduct) v)
212+ (nf (gBigProductFromJSON :: FJ BigProduct) v)
182213 ]
183214 , let v = thBigSumToJSON bigSum
184215 in bigSum `deepseq` v `deepseq`
185216 bgroup "BigSum"
186217 [ group "toJSON" (nf thBigSumToJSON bigSum)
187218 (nf G.toJSON bigSum)
188− (nf toJSON bigSum)
219+ (nf gBigSumToJSON bigSum)
189220 , group "fromJSON" (nf (thBigSumFromJSON :: FJ BigSum) v)
190221 (nf (G.fromJSON :: FJ BigSum) v)
191− (nf (fromJSON :: FJ BigSum) v)
222+ (nf (gBigSumFromJSON :: FJ BigSum) v)
192223 ]
193224 ]
194225