git.iko.soy/typeable/aeson
on 1.4.4.0 help sign in
typeable/aeson/tests/Encoders.hs
439 lines 18 kB history raw
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE GADTs #-}
3{-# LANGUAGE NoImplicitPrelude #-}
4{-# LANGUAGE TemplateHaskell #-}
6module Encoders (module Encoders) where
8import Prelude.Compat
9import Data.Text (Text)
11import Data.Aeson.TH
12import Data.Aeson.Types
13import Options
14import Types
16--------------------------------------------------------------------------------
17-- Nullary encoders/decoders
18--------------------------------------------------------------------------------
20thNullaryToJSONString :: Nullary -> Value
21thNullaryToJSONString = $(mkToJSON defaultOptions ''Nullary)
23thNullaryToEncodingString :: Nullary -> Encoding
24thNullaryToEncodingString = $(mkToEncoding defaultOptions ''Nullary)
26thNullaryParseJSONString :: Value -> Parser Nullary
27thNullaryParseJSONString = $(mkParseJSON defaultOptions ''Nullary)
30thNullaryToJSON2ElemArray :: Nullary -> Value
31thNullaryToJSON2ElemArray = $(mkToJSON opts2ElemArray ''Nullary)
33thNullaryToEncoding2ElemArray :: Nullary -> Encoding
34thNullaryToEncoding2ElemArray = $(mkToEncoding opts2ElemArray ''Nullary)
36thNullaryParseJSON2ElemArray :: Value -> Parser Nullary
37thNullaryParseJSON2ElemArray = $(mkParseJSON opts2ElemArray ''Nullary)
40thNullaryToJSONTaggedObject :: Nullary -> Value
41thNullaryToJSONTaggedObject = $(mkToJSON optsTaggedObject ''Nullary)
43thNullaryToEncodingTaggedObject :: Nullary -> Encoding
44thNullaryToEncodingTaggedObject = $(mkToEncoding optsTaggedObject ''Nullary)
46thNullaryParseJSONTaggedObject :: Value -> Parser Nullary
47thNullaryParseJSONTaggedObject = $(mkParseJSON optsTaggedObject ''Nullary)
50thNullaryToJSONObjectWithSingleField :: Nullary -> Value
51thNullaryToJSONObjectWithSingleField =
52 $(mkToJSON optsObjectWithSingleField ''Nullary)
54thNullaryToEncodingObjectWithSingleField :: Nullary -> Encoding
55thNullaryToEncodingObjectWithSingleField =
56 $(mkToEncoding optsObjectWithSingleField ''Nullary)
58thNullaryParseJSONObjectWithSingleField :: Value -> Parser Nullary
59thNullaryParseJSONObjectWithSingleField = $(mkParseJSON optsObjectWithSingleField ''Nullary)
61gNullaryToJSONString :: Nullary -> Value
62gNullaryToJSONString = genericToJSON defaultOptions
64gNullaryToEncodingString :: Nullary -> Encoding
65gNullaryToEncodingString = genericToEncoding defaultOptions
67gNullaryParseJSONString :: Value -> Parser Nullary
68gNullaryParseJSONString = genericParseJSON defaultOptions
71gNullaryToJSON2ElemArray :: Nullary -> Value
72gNullaryToJSON2ElemArray = genericToJSON opts2ElemArray
74gNullaryToEncoding2ElemArray :: Nullary -> Encoding
75gNullaryToEncoding2ElemArray = genericToEncoding opts2ElemArray
77gNullaryParseJSON2ElemArray :: Value -> Parser Nullary
78gNullaryParseJSON2ElemArray = genericParseJSON opts2ElemArray
81gNullaryToJSONTaggedObject :: Nullary -> Value
82gNullaryToJSONTaggedObject = genericToJSON optsTaggedObject
84gNullaryToEncodingTaggedObject :: Nullary -> Encoding
85gNullaryToEncodingTaggedObject = genericToEncoding optsTaggedObject
87gNullaryParseJSONTaggedObject :: Value -> Parser Nullary
88gNullaryParseJSONTaggedObject = genericParseJSON optsTaggedObject
91gNullaryToJSONObjectWithSingleField :: Nullary -> Value
92gNullaryToJSONObjectWithSingleField = genericToJSON optsObjectWithSingleField
94gNullaryToEncodingObjectWithSingleField :: Nullary -> Encoding
95gNullaryToEncodingObjectWithSingleField = genericToEncoding optsObjectWithSingleField
97gNullaryParseJSONObjectWithSingleField :: Value -> Parser Nullary
98gNullaryParseJSONObjectWithSingleField = genericParseJSON optsObjectWithSingleField
100keyOptions :: JSONKeyOptions
101keyOptions = defaultJSONKeyOptions { keyModifier = ('k' :) }
103gNullaryToJSONKey :: Nullary -> Either String Text
104gNullaryToJSONKey x = case genericToJSONKey keyOptions of
105 ToJSONKeyText p _ -> Right (p x)
106 _ -> Left "Should be a ToJSONKeyText"
108gNullaryFromJSONKey :: Text -> Parser Nullary
109gNullaryFromJSONKey t = case genericFromJSONKey keyOptions of
110 FromJSONKeyTextParser p -> p t
111 _ -> fail "Not a TextParser"
113--------------------------------------------------------------------------------
114-- SomeType encoders/decoders
115--------------------------------------------------------------------------------
117-- Unary types
118type LiftToJSON f a =
119 (a -> Value) -> ([a] -> Value) -> f a -> Value
120type LiftToEncoding f a =
121 (a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding
122type LiftParseJSON f a =
123 (Value -> Parser a) -> (Value -> Parser [a]) -> Value -> Parser (f a)
125thSomeTypeToJSON2ElemArray :: SomeType Int -> Value
126thSomeTypeToJSON2ElemArray = $(mkToJSON opts2ElemArray ''SomeType)
128thSomeTypeToEncoding2ElemArray :: SomeType Int -> Encoding
129thSomeTypeToEncoding2ElemArray = $(mkToEncoding opts2ElemArray ''SomeType)
131thSomeTypeLiftToJSON2ElemArray :: LiftToJSON SomeType a
132thSomeTypeLiftToJSON2ElemArray = $(mkLiftToJSON opts2ElemArray ''SomeType)
134thSomeTypeLiftToEncoding2ElemArray :: LiftToEncoding SomeType a
135thSomeTypeLiftToEncoding2ElemArray = $(mkLiftToEncoding opts2ElemArray ''SomeType)
137thSomeTypeParseJSON2ElemArray :: Value -> Parser (SomeType Int)
138thSomeTypeParseJSON2ElemArray = $(mkParseJSON opts2ElemArray ''SomeType)
140thSomeTypeLiftParseJSON2ElemArray :: LiftParseJSON SomeType a
141thSomeTypeLiftParseJSON2ElemArray = $(mkLiftParseJSON opts2ElemArray ''SomeType)
144thSomeTypeToJSONTaggedObject :: SomeType Int -> Value
145thSomeTypeToJSONTaggedObject = $(mkToJSON optsTaggedObject ''SomeType)
147thSomeTypeToEncodingTaggedObject :: SomeType Int -> Encoding
148thSomeTypeToEncodingTaggedObject = $(mkToEncoding optsTaggedObject ''SomeType)
150thSomeTypeLiftToJSONTaggedObject :: LiftToJSON SomeType a
151thSomeTypeLiftToJSONTaggedObject = $(mkLiftToJSON optsTaggedObject ''SomeType)
153thSomeTypeLiftToEncodingTaggedObject :: LiftToEncoding SomeType a
154thSomeTypeLiftToEncodingTaggedObject = $(mkLiftToEncoding optsTaggedObject ''SomeType)
156thSomeTypeParseJSONTaggedObject :: Value -> Parser (SomeType Int)
157thSomeTypeParseJSONTaggedObject = $(mkParseJSON optsTaggedObject ''SomeType)
159thSomeTypeLiftParseJSONTaggedObject :: LiftParseJSON SomeType a
160thSomeTypeLiftParseJSONTaggedObject = $(mkLiftParseJSON optsTaggedObject ''SomeType)
163thSomeTypeToJSONObjectWithSingleField :: SomeType Int -> Value
164thSomeTypeToJSONObjectWithSingleField = $(mkToJSON optsObjectWithSingleField ''SomeType)
166thSomeTypeToEncodingObjectWithSingleField :: SomeType Int -> Encoding
167thSomeTypeToEncodingObjectWithSingleField = $(mkToEncoding optsObjectWithSingleField ''SomeType)
169thSomeTypeLiftToJSONObjectWithSingleField :: LiftToJSON SomeType a
170thSomeTypeLiftToJSONObjectWithSingleField = $(mkLiftToJSON optsObjectWithSingleField ''SomeType)
172thSomeTypeLiftToEncodingObjectWithSingleField :: LiftToEncoding SomeType a
173thSomeTypeLiftToEncodingObjectWithSingleField = $(mkLiftToEncoding optsObjectWithSingleField ''SomeType)
175thSomeTypeParseJSONObjectWithSingleField :: Value -> Parser (SomeType Int)
176thSomeTypeParseJSONObjectWithSingleField = $(mkParseJSON optsObjectWithSingleField ''SomeType)
178thSomeTypeLiftParseJSONObjectWithSingleField :: LiftParseJSON SomeType a
179thSomeTypeLiftParseJSONObjectWithSingleField = $(mkLiftParseJSON optsObjectWithSingleField ''SomeType)
182gSomeTypeToJSON2ElemArray :: SomeType Int -> Value
183gSomeTypeToJSON2ElemArray = genericToJSON opts2ElemArray
185gSomeTypeToEncoding2ElemArray :: SomeType Int -> Encoding
186gSomeTypeToEncoding2ElemArray = genericToEncoding opts2ElemArray
188gSomeTypeParseJSON2ElemArray :: Value -> Parser (SomeType Int)
189gSomeTypeParseJSON2ElemArray = genericParseJSON opts2ElemArray
191#if __GLASGOW_HASKELL__ >= 706
192gSomeTypeLiftToEncoding2ElemArray :: LiftToEncoding SomeType a
193gSomeTypeLiftToEncoding2ElemArray = genericLiftToEncoding opts2ElemArray
195gSomeTypeLiftToJSON2ElemArray :: LiftToJSON SomeType a
196gSomeTypeLiftToJSON2ElemArray = genericLiftToJSON opts2ElemArray
198gSomeTypeLiftParseJSON2ElemArray :: LiftParseJSON SomeType a
199gSomeTypeLiftParseJSON2ElemArray = genericLiftParseJSON opts2ElemArray
200#endif
203gSomeTypeToJSONTaggedObject :: SomeType Int -> Value
204gSomeTypeToJSONTaggedObject = genericToJSON optsTaggedObject
206gSomeTypeToEncodingTaggedObject :: SomeType Int -> Encoding
207gSomeTypeToEncodingTaggedObject = genericToEncoding optsTaggedObject
209gSomeTypeParseJSONTaggedObject :: Value -> Parser (SomeType Int)
210gSomeTypeParseJSONTaggedObject = genericParseJSON optsTaggedObject
212#if __GLASGOW_HASKELL__ >= 706
213gSomeTypeLiftToEncodingTaggedObject :: LiftToEncoding SomeType a
214gSomeTypeLiftToEncodingTaggedObject = genericLiftToEncoding optsTaggedObject
216gSomeTypeLiftToJSONTaggedObject :: LiftToJSON SomeType a
217gSomeTypeLiftToJSONTaggedObject = genericLiftToJSON optsTaggedObject
219gSomeTypeLiftParseJSONTaggedObject :: LiftParseJSON SomeType a
220gSomeTypeLiftParseJSONTaggedObject = genericLiftParseJSON optsTaggedObject
221#endif
224gSomeTypeToJSONObjectWithSingleField :: SomeType Int -> Value
225gSomeTypeToJSONObjectWithSingleField = genericToJSON optsObjectWithSingleField
227gSomeTypeToEncodingObjectWithSingleField :: SomeType Int -> Encoding
228gSomeTypeToEncodingObjectWithSingleField = genericToEncoding optsObjectWithSingleField
230gSomeTypeParseJSONObjectWithSingleField :: Value -> Parser (SomeType Int)
231gSomeTypeParseJSONObjectWithSingleField = genericParseJSON optsObjectWithSingleField
233#if __GLASGOW_HASKELL__ >= 706
234gSomeTypeLiftToEncodingObjectWithSingleField :: LiftToEncoding SomeType a
235gSomeTypeLiftToEncodingObjectWithSingleField = genericLiftToEncoding optsObjectWithSingleField
237gSomeTypeLiftToJSONObjectWithSingleField :: LiftToJSON SomeType a
238gSomeTypeLiftToJSONObjectWithSingleField = genericLiftToJSON optsObjectWithSingleField
240gSomeTypeLiftParseJSONObjectWithSingleField :: LiftParseJSON SomeType a
241gSomeTypeLiftParseJSONObjectWithSingleField = genericLiftParseJSON optsObjectWithSingleField
242#endif
245gSomeTypeToJSONOmitNothingFields :: SomeType Int -> Value
246gSomeTypeToJSONOmitNothingFields = genericToJSON optsOmitNothingFields
248gSomeTypeToEncodingOmitNothingFields :: SomeType Int -> Encoding
249gSomeTypeToEncodingOmitNothingFields = genericToEncoding optsOmitNothingFields
252--------------------------------------------------------------------------------
253-- Option fields
254--------------------------------------------------------------------------------
256thOptionFieldToJSON :: OptionField -> Value
257thOptionFieldToJSON = $(mkToJSON optsOptionField 'OptionField)
259thOptionFieldToEncoding :: OptionField -> Encoding
260thOptionFieldToEncoding = $(mkToEncoding optsOptionField 'OptionField)
262thOptionFieldParseJSON :: Value -> Parser OptionField
263thOptionFieldParseJSON = $(mkParseJSON optsOptionField 'OptionField)
265gOptionFieldToJSON :: OptionField -> Value
266gOptionFieldToJSON = genericToJSON optsOptionField
268gOptionFieldToEncoding :: OptionField -> Encoding
269gOptionFieldToEncoding = genericToEncoding optsOptionField
271gOptionFieldParseJSON :: Value -> Parser OptionField
272gOptionFieldParseJSON = genericParseJSON optsOptionField
274thMaybeFieldToJSON :: MaybeField -> Value
275thMaybeFieldToJSON = $(mkToJSON optsOptionField 'MaybeField)
278--------------------------------------------------------------------------------
279-- IncoherentInstancesNeeded
280--------------------------------------------------------------------------------
282-- | This test demonstrates the need for IncoherentInstances. See the definition
283-- of 'IncoherentInstancesNeeded' for a discussion of the issue.
284--
285-- NOTE 1: We only need to compile this test. We do not need to run it.
286--
287-- NOTE 2: We actually only use the INCOHERENT pragma on specific instances
288-- instead of the IncoherentInstances language extension. Therefore, this is
289-- only supported on GHC versions >= 7.10.
290#if __GLASGOW_HASKELL__ >= 710
291incoherentInstancesNeededParseJSONString :: FromJSON a => Value -> Parser (IncoherentInstancesNeeded a)
292incoherentInstancesNeededParseJSONString = case () of
293 _ | True -> $(mkParseJSON defaultOptions ''IncoherentInstancesNeeded)
294 | False -> genericParseJSON defaultOptions
296incoherentInstancesNeededToJSON :: ToJSON a => IncoherentInstancesNeeded a -> Value
297incoherentInstancesNeededToJSON = case () of
298 _ | True -> $(mkToJSON defaultOptions ''IncoherentInstancesNeeded)
299 | False -> genericToJSON defaultOptions
300#endif
302-------------------------------------------------------------------------------
303-- EitherTextInt encoders/decodes
304-------------------------------------------------------------------------------
306thEitherTextIntToJSONUntaggedValue :: EitherTextInt -> Value
307thEitherTextIntToJSONUntaggedValue = $(mkToJSON optsUntaggedValue ''EitherTextInt)
309thEitherTextIntToEncodingUntaggedValue :: EitherTextInt -> Encoding
310thEitherTextIntToEncodingUntaggedValue = $(mkToEncoding optsUntaggedValue ''EitherTextInt)
312thEitherTextIntParseJSONUntaggedValue :: Value -> Parser EitherTextInt
313thEitherTextIntParseJSONUntaggedValue = $(mkParseJSON optsUntaggedValue ''EitherTextInt)
316gEitherTextIntToJSONUntaggedValue :: EitherTextInt -> Value
317gEitherTextIntToJSONUntaggedValue = genericToJSON optsUntaggedValue
319gEitherTextIntToEncodingUntaggedValue :: EitherTextInt -> Encoding
320gEitherTextIntToEncodingUntaggedValue = genericToEncoding optsUntaggedValue
322gEitherTextIntParseJSONUntaggedValue :: Value -> Parser EitherTextInt
323gEitherTextIntParseJSONUntaggedValue = genericParseJSON optsUntaggedValue
325--------------------------------------------------------------------------------
326-- Approx encoders/decoders
327--------------------------------------------------------------------------------
329thApproxToJSONUnwrap :: Approx String -> Value
330thApproxToJSONUnwrap = $(mkToJSON optsUnwrapUnaryRecords ''Approx)
332thApproxToEncodingUnwrap :: Approx String -> Encoding
333thApproxToEncodingUnwrap = $(mkToEncoding optsUnwrapUnaryRecords ''Approx)
335thApproxParseJSONUnwrap :: Value -> Parser (Approx String)
336thApproxParseJSONUnwrap = $(mkParseJSON optsUnwrapUnaryRecords ''Approx)
339thApproxToJSONDefault :: Approx String -> Value
340thApproxToJSONDefault = $(mkToJSON defaultOptions ''Approx)
342thApproxToEncodingDefault :: Approx String -> Encoding
343thApproxToEncodingDefault = $(mkToEncoding defaultOptions ''Approx)
345thApproxParseJSONDefault :: Value -> Parser (Approx String)
346thApproxParseJSONDefault = $(mkParseJSON defaultOptions ''Approx)
348gApproxToJSONUnwrap :: Approx String -> Value
349gApproxToJSONUnwrap = genericToJSON optsUnwrapUnaryRecords
351gApproxToEncodingUnwrap :: Approx String -> Encoding
352gApproxToEncodingUnwrap = genericToEncoding optsUnwrapUnaryRecords
354gApproxParseJSONUnwrap :: Value -> Parser (Approx String)
355gApproxParseJSONUnwrap = genericParseJSON optsUnwrapUnaryRecords
358gApproxToJSONDefault :: Approx String -> Value
359gApproxToJSONDefault = genericToJSON defaultOptions
361gApproxToEncodingDefault :: Approx String -> Encoding
362gApproxToEncodingDefault = genericToEncoding defaultOptions
364gApproxParseJSONDefault :: Value -> Parser (Approx String)
365gApproxParseJSONDefault = genericParseJSON defaultOptions
367--------------------------------------------------------------------------------
368-- GADT encoders/decoders
369--------------------------------------------------------------------------------
371thGADTToJSONUnwrap :: GADT String -> Value
372thGADTToJSONUnwrap = $(mkToJSON optsUnwrapUnaryRecords ''GADT)
374thGADTToEncodingUnwrap :: GADT String -> Encoding
375thGADTToEncodingUnwrap = $(mkToEncoding optsUnwrapUnaryRecords ''GADT)
377thGADTParseJSONUnwrap :: Value -> Parser (GADT String)
378thGADTParseJSONUnwrap = $(mkParseJSON optsUnwrapUnaryRecords ''GADT)
381thGADTToJSONDefault :: GADT String -> Value
382thGADTToJSONDefault = $(mkToJSON defaultOptions ''GADT)
384thGADTToEncodingDefault :: GADT String -> Encoding
385thGADTToEncodingDefault = $(mkToEncoding defaultOptions ''GADT)
387thGADTParseJSONDefault :: Value -> Parser (GADT String)
388thGADTParseJSONDefault = $(mkParseJSON defaultOptions ''GADT)
390--------------------------------------------------------------------------------
391-- OneConstructor encoders/decoders
392--------------------------------------------------------------------------------
394thOneConstructorToJSONDefault :: OneConstructor -> Value
395thOneConstructorToJSONDefault = $(mkToJSON defaultOptions ''OneConstructor)
397thOneConstructorToEncodingDefault :: OneConstructor -> Encoding
398thOneConstructorToEncodingDefault = $(mkToEncoding defaultOptions ''OneConstructor)
400thOneConstructorParseJSONDefault :: Value -> Parser OneConstructor
401thOneConstructorParseJSONDefault = $(mkParseJSON defaultOptions ''OneConstructor)
403thOneConstructorToJSONTagged :: OneConstructor -> Value
404thOneConstructorToJSONTagged = $(mkToJSON optsTagSingleConstructors ''OneConstructor)
406thOneConstructorToEncodingTagged :: OneConstructor -> Encoding
407thOneConstructorToEncodingTagged = $(mkToEncoding optsTagSingleConstructors ''OneConstructor)
409thOneConstructorParseJSONTagged :: Value -> Parser OneConstructor
410thOneConstructorParseJSONTagged = $(mkParseJSON optsTagSingleConstructors ''OneConstructor)
413gOneConstructorToJSONDefault :: OneConstructor -> Value
414gOneConstructorToJSONDefault = genericToJSON defaultOptions
416gOneConstructorToEncodingDefault :: OneConstructor -> Encoding
417gOneConstructorToEncodingDefault = genericToEncoding defaultOptions
419gOneConstructorParseJSONDefault :: Value -> Parser OneConstructor
420gOneConstructorParseJSONDefault = genericParseJSON defaultOptions
422gOneConstructorToJSONTagged :: OneConstructor -> Value
423gOneConstructorToJSONTagged = genericToJSON optsTagSingleConstructors
425gOneConstructorToEncodingTagged :: OneConstructor -> Encoding
426gOneConstructorToEncodingTagged = genericToEncoding optsTagSingleConstructors
428gOneConstructorParseJSONTagged :: Value -> Parser OneConstructor
429gOneConstructorParseJSONTagged = genericParseJSON optsTagSingleConstructors
431--------------------------------------------------------------------------------
432-- Product2 encoders/decoders
433--------------------------------------------------------------------------------
435thProduct2ParseJSON :: Value -> Parser (Product2 Int Bool)
436thProduct2ParseJSON = $(mkParseJSON defaultOptions ''Product2)
438gProduct2ParseJSON :: Value -> Parser (Product2 Int Bool)
439gProduct2ParseJSON = genericParseJSON defaultOptions