on 1.4.1.0 help sign in
typeable/aeson/tests/Encoders.hs
416 lines 17 kB history raw
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE GADTs #-}
3{-# LANGUAGE NoImplicitPrelude #-}
4{-# LANGUAGE TemplateHaskell #-}
6module Encoders (module Encoders) where
8import Prelude.Compat
10import Data.Aeson.TH
11import Data.Aeson.Types
12import Options
13import Types
15--------------------------------------------------------------------------------
16-- Nullary encoders/decoders
17--------------------------------------------------------------------------------
19thNullaryToJSONString :: Nullary -> Value
20thNullaryToJSONString = $(mkToJSON defaultOptions ''Nullary)
22thNullaryToEncodingString :: Nullary -> Encoding
23thNullaryToEncodingString = $(mkToEncoding defaultOptions ''Nullary)
25thNullaryParseJSONString :: Value -> Parser Nullary
26thNullaryParseJSONString = $(mkParseJSON defaultOptions ''Nullary)
29thNullaryToJSON2ElemArray :: Nullary -> Value
30thNullaryToJSON2ElemArray = $(mkToJSON opts2ElemArray ''Nullary)
32thNullaryToEncoding2ElemArray :: Nullary -> Encoding
33thNullaryToEncoding2ElemArray = $(mkToEncoding opts2ElemArray ''Nullary)
35thNullaryParseJSON2ElemArray :: Value -> Parser Nullary
36thNullaryParseJSON2ElemArray = $(mkParseJSON opts2ElemArray ''Nullary)
39thNullaryToJSONTaggedObject :: Nullary -> Value
40thNullaryToJSONTaggedObject = $(mkToJSON optsTaggedObject ''Nullary)
42thNullaryToEncodingTaggedObject :: Nullary -> Encoding
43thNullaryToEncodingTaggedObject = $(mkToEncoding optsTaggedObject ''Nullary)
45thNullaryParseJSONTaggedObject :: Value -> Parser Nullary
46thNullaryParseJSONTaggedObject = $(mkParseJSON optsTaggedObject ''Nullary)
49thNullaryToJSONObjectWithSingleField :: Nullary -> Value
50thNullaryToJSONObjectWithSingleField =
51 $(mkToJSON optsObjectWithSingleField ''Nullary)
53thNullaryToEncodingObjectWithSingleField :: Nullary -> Encoding
54thNullaryToEncodingObjectWithSingleField =
55 $(mkToEncoding optsObjectWithSingleField ''Nullary)
57thNullaryParseJSONObjectWithSingleField :: Value -> Parser Nullary
58thNullaryParseJSONObjectWithSingleField = $(mkParseJSON optsObjectWithSingleField ''Nullary)
60gNullaryToJSONString :: Nullary -> Value
61gNullaryToJSONString = genericToJSON defaultOptions
63gNullaryToEncodingString :: Nullary -> Encoding
64gNullaryToEncodingString = genericToEncoding defaultOptions
66gNullaryParseJSONString :: Value -> Parser Nullary
67gNullaryParseJSONString = genericParseJSON defaultOptions
70gNullaryToJSON2ElemArray :: Nullary -> Value
71gNullaryToJSON2ElemArray = genericToJSON opts2ElemArray
73gNullaryToEncoding2ElemArray :: Nullary -> Encoding
74gNullaryToEncoding2ElemArray = genericToEncoding opts2ElemArray
76gNullaryParseJSON2ElemArray :: Value -> Parser Nullary
77gNullaryParseJSON2ElemArray = genericParseJSON opts2ElemArray
80gNullaryToJSONTaggedObject :: Nullary -> Value
81gNullaryToJSONTaggedObject = genericToJSON optsTaggedObject
83gNullaryToEncodingTaggedObject :: Nullary -> Encoding
84gNullaryToEncodingTaggedObject = genericToEncoding optsTaggedObject
86gNullaryParseJSONTaggedObject :: Value -> Parser Nullary
87gNullaryParseJSONTaggedObject = genericParseJSON optsTaggedObject
90gNullaryToJSONObjectWithSingleField :: Nullary -> Value
91gNullaryToJSONObjectWithSingleField = genericToJSON optsObjectWithSingleField
93gNullaryToEncodingObjectWithSingleField :: Nullary -> Encoding
94gNullaryToEncodingObjectWithSingleField = genericToEncoding optsObjectWithSingleField
96gNullaryParseJSONObjectWithSingleField :: Value -> Parser Nullary
97gNullaryParseJSONObjectWithSingleField = genericParseJSON optsObjectWithSingleField
100--------------------------------------------------------------------------------
101-- SomeType encoders/decoders
102--------------------------------------------------------------------------------
104-- Unary types
105type LiftToJSON f a =
106 (a -> Value) -> ([a] -> Value) -> f a -> Value
107type LiftToEncoding f a =
108 (a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding
109type LiftParseJSON f a =
110 (Value -> Parser a) -> (Value -> Parser [a]) -> Value -> Parser (f a)
112thSomeTypeToJSON2ElemArray :: SomeType Int -> Value
113thSomeTypeToJSON2ElemArray = $(mkToJSON opts2ElemArray ''SomeType)
115thSomeTypeToEncoding2ElemArray :: SomeType Int -> Encoding
116thSomeTypeToEncoding2ElemArray = $(mkToEncoding opts2ElemArray ''SomeType)
118thSomeTypeLiftToJSON2ElemArray :: LiftToJSON SomeType a
119thSomeTypeLiftToJSON2ElemArray = $(mkLiftToJSON opts2ElemArray ''SomeType)
121thSomeTypeLiftToEncoding2ElemArray :: LiftToEncoding SomeType a
122thSomeTypeLiftToEncoding2ElemArray = $(mkLiftToEncoding opts2ElemArray ''SomeType)
124thSomeTypeParseJSON2ElemArray :: Value -> Parser (SomeType Int)
125thSomeTypeParseJSON2ElemArray = $(mkParseJSON opts2ElemArray ''SomeType)
127thSomeTypeLiftParseJSON2ElemArray :: LiftParseJSON SomeType a
128thSomeTypeLiftParseJSON2ElemArray = $(mkLiftParseJSON opts2ElemArray ''SomeType)
131thSomeTypeToJSONTaggedObject :: SomeType Int -> Value
132thSomeTypeToJSONTaggedObject = $(mkToJSON optsTaggedObject ''SomeType)
134thSomeTypeToEncodingTaggedObject :: SomeType Int -> Encoding
135thSomeTypeToEncodingTaggedObject = $(mkToEncoding optsTaggedObject ''SomeType)
137thSomeTypeLiftToJSONTaggedObject :: LiftToJSON SomeType a
138thSomeTypeLiftToJSONTaggedObject = $(mkLiftToJSON optsTaggedObject ''SomeType)
140thSomeTypeLiftToEncodingTaggedObject :: LiftToEncoding SomeType a
141thSomeTypeLiftToEncodingTaggedObject = $(mkLiftToEncoding optsTaggedObject ''SomeType)
143thSomeTypeParseJSONTaggedObject :: Value -> Parser (SomeType Int)
144thSomeTypeParseJSONTaggedObject = $(mkParseJSON optsTaggedObject ''SomeType)
146thSomeTypeLiftParseJSONTaggedObject :: LiftParseJSON SomeType a
147thSomeTypeLiftParseJSONTaggedObject = $(mkLiftParseJSON optsTaggedObject ''SomeType)
150thSomeTypeToJSONObjectWithSingleField :: SomeType Int -> Value
151thSomeTypeToJSONObjectWithSingleField = $(mkToJSON optsObjectWithSingleField ''SomeType)
153thSomeTypeToEncodingObjectWithSingleField :: SomeType Int -> Encoding
154thSomeTypeToEncodingObjectWithSingleField = $(mkToEncoding optsObjectWithSingleField ''SomeType)
156thSomeTypeLiftToJSONObjectWithSingleField :: LiftToJSON SomeType a
157thSomeTypeLiftToJSONObjectWithSingleField = $(mkLiftToJSON optsObjectWithSingleField ''SomeType)
159thSomeTypeLiftToEncodingObjectWithSingleField :: LiftToEncoding SomeType a
160thSomeTypeLiftToEncodingObjectWithSingleField = $(mkLiftToEncoding optsObjectWithSingleField ''SomeType)
162thSomeTypeParseJSONObjectWithSingleField :: Value -> Parser (SomeType Int)
163thSomeTypeParseJSONObjectWithSingleField = $(mkParseJSON optsObjectWithSingleField ''SomeType)
165thSomeTypeLiftParseJSONObjectWithSingleField :: LiftParseJSON SomeType a
166thSomeTypeLiftParseJSONObjectWithSingleField = $(mkLiftParseJSON optsObjectWithSingleField ''SomeType)
169gSomeTypeToJSON2ElemArray :: SomeType Int -> Value
170gSomeTypeToJSON2ElemArray = genericToJSON opts2ElemArray
172gSomeTypeToEncoding2ElemArray :: SomeType Int -> Encoding
173gSomeTypeToEncoding2ElemArray = genericToEncoding opts2ElemArray
175gSomeTypeParseJSON2ElemArray :: Value -> Parser (SomeType Int)
176gSomeTypeParseJSON2ElemArray = genericParseJSON opts2ElemArray
178#if __GLASGOW_HASKELL__ >= 706
179gSomeTypeLiftToEncoding2ElemArray :: LiftToEncoding SomeType a
180gSomeTypeLiftToEncoding2ElemArray = genericLiftToEncoding opts2ElemArray
182gSomeTypeLiftToJSON2ElemArray :: LiftToJSON SomeType a
183gSomeTypeLiftToJSON2ElemArray = genericLiftToJSON opts2ElemArray
185gSomeTypeLiftParseJSON2ElemArray :: LiftParseJSON SomeType a
186gSomeTypeLiftParseJSON2ElemArray = genericLiftParseJSON opts2ElemArray
187#endif
190gSomeTypeToJSONTaggedObject :: SomeType Int -> Value
191gSomeTypeToJSONTaggedObject = genericToJSON optsTaggedObject
193gSomeTypeToEncodingTaggedObject :: SomeType Int -> Encoding
194gSomeTypeToEncodingTaggedObject = genericToEncoding optsTaggedObject
196gSomeTypeParseJSONTaggedObject :: Value -> Parser (SomeType Int)
197gSomeTypeParseJSONTaggedObject = genericParseJSON optsTaggedObject
199#if __GLASGOW_HASKELL__ >= 706
200gSomeTypeLiftToEncodingTaggedObject :: LiftToEncoding SomeType a
201gSomeTypeLiftToEncodingTaggedObject = genericLiftToEncoding optsTaggedObject
203gSomeTypeLiftToJSONTaggedObject :: LiftToJSON SomeType a
204gSomeTypeLiftToJSONTaggedObject = genericLiftToJSON optsTaggedObject
206gSomeTypeLiftParseJSONTaggedObject :: LiftParseJSON SomeType a
207gSomeTypeLiftParseJSONTaggedObject = genericLiftParseJSON optsTaggedObject
208#endif
211gSomeTypeToJSONObjectWithSingleField :: SomeType Int -> Value
212gSomeTypeToJSONObjectWithSingleField = genericToJSON optsObjectWithSingleField
214gSomeTypeToEncodingObjectWithSingleField :: SomeType Int -> Encoding
215gSomeTypeToEncodingObjectWithSingleField = genericToEncoding optsObjectWithSingleField
217gSomeTypeParseJSONObjectWithSingleField :: Value -> Parser (SomeType Int)
218gSomeTypeParseJSONObjectWithSingleField = genericParseJSON optsObjectWithSingleField
220#if __GLASGOW_HASKELL__ >= 706
221gSomeTypeLiftToEncodingObjectWithSingleField :: LiftToEncoding SomeType a
222gSomeTypeLiftToEncodingObjectWithSingleField = genericLiftToEncoding optsObjectWithSingleField
224gSomeTypeLiftToJSONObjectWithSingleField :: LiftToJSON SomeType a
225gSomeTypeLiftToJSONObjectWithSingleField = genericLiftToJSON optsObjectWithSingleField
227gSomeTypeLiftParseJSONObjectWithSingleField :: LiftParseJSON SomeType a
228gSomeTypeLiftParseJSONObjectWithSingleField = genericLiftParseJSON optsObjectWithSingleField
229#endif
232gSomeTypeToJSONOmitNothingFields :: SomeType Int -> Value
233gSomeTypeToJSONOmitNothingFields = genericToJSON optsOmitNothingFields
235gSomeTypeToEncodingOmitNothingFields :: SomeType Int -> Encoding
236gSomeTypeToEncodingOmitNothingFields = genericToEncoding optsOmitNothingFields
239--------------------------------------------------------------------------------
240-- Option fields
241--------------------------------------------------------------------------------
243thOptionFieldToJSON :: OptionField -> Value
244thOptionFieldToJSON = $(mkToJSON optsOptionField 'OptionField)
246thOptionFieldToEncoding :: OptionField -> Encoding
247thOptionFieldToEncoding = $(mkToEncoding optsOptionField 'OptionField)
249thOptionFieldParseJSON :: Value -> Parser OptionField
250thOptionFieldParseJSON = $(mkParseJSON optsOptionField 'OptionField)
252gOptionFieldToJSON :: OptionField -> Value
253gOptionFieldToJSON = genericToJSON optsOptionField
255gOptionFieldToEncoding :: OptionField -> Encoding
256gOptionFieldToEncoding = genericToEncoding optsOptionField
258gOptionFieldParseJSON :: Value -> Parser OptionField
259gOptionFieldParseJSON = genericParseJSON optsOptionField
261thMaybeFieldToJSON :: MaybeField -> Value
262thMaybeFieldToJSON = $(mkToJSON optsOptionField 'MaybeField)
265--------------------------------------------------------------------------------
266-- IncoherentInstancesNeeded
267--------------------------------------------------------------------------------
269-- | This test demonstrates the need for IncoherentInstances. See the definition
270-- of 'IncoherentInstancesNeeded' for a discussion of the issue.
271--
272-- NOTE 1: We only need to compile this test. We do not need to run it.
273--
274-- NOTE 2: We actually only use the INCOHERENT pragma on specific instances
275-- instead of the IncoherentInstances language extension. Therefore, this is
276-- only supported on GHC versions >= 7.10.
277#if __GLASGOW_HASKELL__ >= 710
278incoherentInstancesNeededParseJSONString :: FromJSON a => Value -> Parser (IncoherentInstancesNeeded a)
279incoherentInstancesNeededParseJSONString = case () of
280 _ | True -> $(mkParseJSON defaultOptions ''IncoherentInstancesNeeded)
281 | False -> genericParseJSON defaultOptions
283incoherentInstancesNeededToJSON :: ToJSON a => IncoherentInstancesNeeded a -> Value
284incoherentInstancesNeededToJSON = case () of
285 _ | True -> $(mkToJSON defaultOptions ''IncoherentInstancesNeeded)
286 | False -> genericToJSON defaultOptions
287#endif
289-------------------------------------------------------------------------------
290-- EitherTextInt encoders/decodes
291-------------------------------------------------------------------------------
293thEitherTextIntToJSONUntaggedValue :: EitherTextInt -> Value
294thEitherTextIntToJSONUntaggedValue = $(mkToJSON optsUntaggedValue ''EitherTextInt)
296thEitherTextIntToEncodingUntaggedValue :: EitherTextInt -> Encoding
297thEitherTextIntToEncodingUntaggedValue = $(mkToEncoding optsUntaggedValue ''EitherTextInt)
299thEitherTextIntParseJSONUntaggedValue :: Value -> Parser EitherTextInt
300thEitherTextIntParseJSONUntaggedValue = $(mkParseJSON optsUntaggedValue ''EitherTextInt)
303gEitherTextIntToJSONUntaggedValue :: EitherTextInt -> Value
304gEitherTextIntToJSONUntaggedValue = genericToJSON optsUntaggedValue
306gEitherTextIntToEncodingUntaggedValue :: EitherTextInt -> Encoding
307gEitherTextIntToEncodingUntaggedValue = genericToEncoding optsUntaggedValue
309gEitherTextIntParseJSONUntaggedValue :: Value -> Parser EitherTextInt
310gEitherTextIntParseJSONUntaggedValue = genericParseJSON optsUntaggedValue
312--------------------------------------------------------------------------------
313-- Approx encoders/decoders
314--------------------------------------------------------------------------------
316thApproxToJSONUnwrap :: Approx String -> Value
317thApproxToJSONUnwrap = $(mkToJSON optsUnwrapUnaryRecords ''Approx)
319thApproxToEncodingUnwrap :: Approx String -> Encoding
320thApproxToEncodingUnwrap = $(mkToEncoding optsUnwrapUnaryRecords ''Approx)
322thApproxParseJSONUnwrap :: Value -> Parser (Approx String)
323thApproxParseJSONUnwrap = $(mkParseJSON optsUnwrapUnaryRecords ''Approx)
326thApproxToJSONDefault :: Approx String -> Value
327thApproxToJSONDefault = $(mkToJSON defaultOptions ''Approx)
329thApproxToEncodingDefault :: Approx String -> Encoding
330thApproxToEncodingDefault = $(mkToEncoding defaultOptions ''Approx)
332thApproxParseJSONDefault :: Value -> Parser (Approx String)
333thApproxParseJSONDefault = $(mkParseJSON defaultOptions ''Approx)
335gApproxToJSONUnwrap :: Approx String -> Value
336gApproxToJSONUnwrap = genericToJSON optsUnwrapUnaryRecords
338gApproxToEncodingUnwrap :: Approx String -> Encoding
339gApproxToEncodingUnwrap = genericToEncoding optsUnwrapUnaryRecords
341gApproxParseJSONUnwrap :: Value -> Parser (Approx String)
342gApproxParseJSONUnwrap = genericParseJSON optsUnwrapUnaryRecords
345gApproxToJSONDefault :: Approx String -> Value
346gApproxToJSONDefault = genericToJSON defaultOptions
348gApproxToEncodingDefault :: Approx String -> Encoding
349gApproxToEncodingDefault = genericToEncoding defaultOptions
351gApproxParseJSONDefault :: Value -> Parser (Approx String)
352gApproxParseJSONDefault = genericParseJSON defaultOptions
354--------------------------------------------------------------------------------
355-- GADT encoders/decoders
356--------------------------------------------------------------------------------
358thGADTToJSONUnwrap :: GADT String -> Value
359thGADTToJSONUnwrap = $(mkToJSON optsUnwrapUnaryRecords ''GADT)
361thGADTToEncodingUnwrap :: GADT String -> Encoding
362thGADTToEncodingUnwrap = $(mkToEncoding optsUnwrapUnaryRecords ''GADT)
364thGADTParseJSONUnwrap :: Value -> Parser (GADT String)
365thGADTParseJSONUnwrap = $(mkParseJSON optsUnwrapUnaryRecords ''GADT)
368thGADTToJSONDefault :: GADT String -> Value
369thGADTToJSONDefault = $(mkToJSON defaultOptions ''GADT)
371thGADTToEncodingDefault :: GADT String -> Encoding
372thGADTToEncodingDefault = $(mkToEncoding defaultOptions ''GADT)
374thGADTParseJSONDefault :: Value -> Parser (GADT String)
375thGADTParseJSONDefault = $(mkParseJSON defaultOptions ''GADT)
377--------------------------------------------------------------------------------
378-- OneConstructor encoders/decoders
379--------------------------------------------------------------------------------
381thOneConstructorToJSONDefault :: OneConstructor -> Value
382thOneConstructorToJSONDefault = $(mkToJSON defaultOptions ''OneConstructor)
384thOneConstructorToEncodingDefault :: OneConstructor -> Encoding
385thOneConstructorToEncodingDefault = $(mkToEncoding defaultOptions ''OneConstructor)
387thOneConstructorParseJSONDefault :: Value -> Parser OneConstructor
388thOneConstructorParseJSONDefault = $(mkParseJSON defaultOptions ''OneConstructor)
390thOneConstructorToJSONTagged :: OneConstructor -> Value
391thOneConstructorToJSONTagged = $(mkToJSON optsTagSingleConstructors ''OneConstructor)
393thOneConstructorToEncodingTagged :: OneConstructor -> Encoding
394thOneConstructorToEncodingTagged = $(mkToEncoding optsTagSingleConstructors ''OneConstructor)
396thOneConstructorParseJSONTagged :: Value -> Parser OneConstructor
397thOneConstructorParseJSONTagged = $(mkParseJSON optsTagSingleConstructors ''OneConstructor)
400gOneConstructorToJSONDefault :: OneConstructor -> Value
401gOneConstructorToJSONDefault = genericToJSON defaultOptions
403gOneConstructorToEncodingDefault :: OneConstructor -> Encoding
404gOneConstructorToEncodingDefault = genericToEncoding defaultOptions
406gOneConstructorParseJSONDefault :: Value -> Parser OneConstructor
407gOneConstructorParseJSONDefault = genericParseJSON defaultOptions
409gOneConstructorToJSONTagged :: OneConstructor -> Value
410gOneConstructorToJSONTagged = genericToJSON optsTagSingleConstructors
412gOneConstructorToEncodingTagged :: OneConstructor -> Encoding
413gOneConstructorToEncodingTagged = genericToEncoding optsTagSingleConstructors
415gOneConstructorParseJSONTagged :: Value -> Parser OneConstructor
416gOneConstructorParseJSONTagged = genericParseJSON optsTagSingleConstructors