git.iko.soy/typeable/aeson
on master help sign in
Add tests for Option fields
commit45228532d20f7b2c5407c1bcae5f72507516aa12 authorlyxia <lysxia@gmail.com> dateWed 30 Aug 2017, 20:32 (9 years ago) parentf4174c6
6 files changed+61−9
compare with master
unifiedsplit
Data/Aeson/TH.hs+1−1 tests/Encoders.hs+27 tests/Instances.hs+4−8 tests/Options.hs+6 tests/Properties.hs+17 tests/Types.hs+6
Data/Aeson/TH.hs+1−1
@@ -85,7 +85,6 @@ $('deriveJSON' 'defaultOptions' ''(,,,))
8585@
8686
8787-}
88−
8988module Data.Aeson.TH
9089 (
9190 -- * Encoding configuration
@@ -160,6 +159,7 @@ import qualified Data.Text as T (Text, pack, unpack)
160159import qualified Data.Vector as V (unsafeIndex, null, length, create, fromList)
161160import qualified Data.Vector.Mutable as VM (unsafeNew, unsafeWrite)
162161
162+{-# ANN module "Hlint: ignore Reduce duplication" #-}
163163
164164--------------------------------------------------------------------------------
165165-- Convenience
tests/Encoders.hs+27
@@ -235,6 +235,33 @@ gSomeTypeToJSONOmitNothingFields = genericToJSON optsOmitNothingFields
235235gSomeTypeToEncodingOmitNothingFields :: SomeType Int -> Encoding
236236gSomeTypeToEncodingOmitNothingFields = genericToEncoding optsOmitNothingFields
237237
238+
239+--------------------------------------------------------------------------------
240+-- Option fields
241+--------------------------------------------------------------------------------
242+
243+thOptionFieldToJSON :: OptionField -> Value
244+thOptionFieldToJSON = $(mkToJSON optsOptionField 'OptionField)
245+
246+thOptionFieldToEncoding :: OptionField -> Encoding
247+thOptionFieldToEncoding = $(mkToEncoding optsOptionField 'OptionField)
248+
249+thOptionFieldParseJSON :: Value -> Parser OptionField
250+thOptionFieldParseJSON = $(mkParseJSON optsOptionField 'OptionField)
251+
252+gOptionFieldToJSON :: OptionField -> Value
253+gOptionFieldToJSON = genericToJSON optsOptionField
254+
255+gOptionFieldToEncoding :: OptionField -> Encoding
256+gOptionFieldToEncoding = genericToEncoding optsOptionField
257+
258+gOptionFieldParseJSON :: Value -> Parser OptionField
259+gOptionFieldParseJSON = genericParseJSON optsOptionField
260+
261+thMaybeFieldToJSON :: MaybeField -> Value
262+thMaybeFieldToJSON = $(mkToJSON optsOptionField 'MaybeField)
263+
264+
238265--------------------------------------------------------------------------------
239266-- IncoherentInstancesNeeded
240267--------------------------------------------------------------------------------
tests/Instances.hs+4−8
@@ -28,8 +28,6 @@ import Test.QuickCheck.Instances ()
2828import Data.Hashable.Time ()
2929#endif
3030
31−{-# ANN module ("HLint: ignore Use fewer imports"::String) #-}
32−
3331-- "System" types.
3432
3533instance Arbitrary DotNetTime where
@@ -157,17 +155,15 @@ instance Arbitrary EitherTextInt where
157155instance Arbitrary (GADT String) where
158156 arbitrary = GADT <$> arbitrary
159157
158+instance Arbitrary OptionField where
159+ arbitrary = OptionField <$> arbitrary
160+
161+
160162instance ApproxEq Char where
161163 (=~) = (==)
162164
163165instance (ApproxEq a) => ApproxEq [a] where
164166 a =~ b = length a == length b && all (uncurry (=~)) (zip a b)
165167
166−-- Version tags are deprecated, so we avoid using them in the Arbitrary
167−-- instance. However, the recommended constructor 'makeVersion' is not
168−-- exported by "Data.Version" until base-4.8.0.0. For previous versions,
169−-- a definition is given below.
170−
171−
172168instance Arbitrary a => Arbitrary (DList.DList a) where
173169 arbitrary = DList.fromList <$> arbitrary
tests/Options.hs+6
@@ -48,3 +48,9 @@ optsTagSingleConstructors = optsDefault
4848 { tagSingleConstructors = True
4949 , allNullaryToStringTag = False
5050 }
51+
52+optsOptionField :: Options
53+optsOptionField = optsDefault
54+ { fieldLabelModifier = const "field"
55+ , omitNothingFields = True
56+ }
tests/Properties.hs+17
@@ -25,6 +25,7 @@ import Data.List.NonEmpty (NonEmpty)
2525import Data.Map (Map)
2626import Data.Proxy (Proxy)
2727import Data.Ratio (Ratio)
28+import Data.Semigroup (Option(..))
2829import Data.Sequence (Seq)
2930import Data.Tagged (Tagged)
3031import Data.Time (Day, DiffTime, LocalTime, NominalDiffTime, TimeOfDay, UTCTime, ZonedTime)
@@ -376,6 +377,11 @@ tests = testGroup "properties" [
376377 , testProperty "Tagged" (toParseJSON gOneConstructorParseJSONTagged gOneConstructorToJSONTagged)
377378 ]
378379 ]
380+ , testGroup "OptionField" [
381+ testProperty "like Maybe" $
382+ \x -> gOptionFieldToJSON (OptionField (Option x)) === thMaybeFieldToJSON (MaybeField x)
383+ , testProperty "roundTrip" (toParseJSON gOptionFieldParseJSON gOptionFieldToJSON)
384+ ]
379385 ]
380386 , testGroup "toEncoding" [
381387 testProperty "NullaryString" $
@@ -429,6 +435,9 @@ tests = testGroup "properties" [
429435 gOneConstructorToJSONDefault `sameAs` gOneConstructorToEncodingDefault
430436 , testProperty "OneConstructorTagged" $
431437 gOneConstructorToJSONTagged `sameAs` gOneConstructorToEncodingTagged
438+
439+ , testProperty "OptionField" $
440+ gOptionFieldToJSON `sameAs` gOptionFieldToEncoding
432441 ]
433442 ]
434443 , testGroup "template-haskell" [
@@ -489,6 +498,11 @@ tests = testGroup "properties" [
489498 , testProperty "Tagged" (toParseJSON thOneConstructorParseJSONTagged thOneConstructorToJSONTagged)
490499 ]
491500 ]
501+ , testGroup "OptionField" [
502+ testProperty "like Maybe" $
503+ \x -> thOptionFieldToJSON (OptionField (Option x)) === thMaybeFieldToJSON (MaybeField x)
504+ , testProperty "roundTrip" (toParseJSON thOptionFieldParseJSON thOptionFieldToJSON)
505+ ]
492506 ]
493507 , testGroup "toEncoding" [
494508 testProperty "NullaryString" $
@@ -533,6 +547,9 @@ tests = testGroup "properties" [
533547 thOneConstructorToJSONDefault `sameAs` thOneConstructorToEncodingDefault
534548 , testProperty "OneConstructorTagged" $
535549 thOneConstructorToJSONTagged `sameAs` thOneConstructorToEncodingTagged
550+
551+ , testProperty "OptionField" $
552+ thOptionFieldToJSON `sameAs` thOptionFieldToEncoding
536553 ]
537554 ]
538555 ]
tests/Types.hs+6
@@ -17,6 +17,7 @@ import Data.Data
1717import Data.Functor.Compose (Compose (..))
1818import Data.Functor.Identity (Identity (..))
1919import Data.Hashable (Hashable (..))
20+import Data.Semigroup (Option)
2021import Data.Text
2122import Data.Time (Day (..), fromGregorian)
2223import GHC.Generics
@@ -104,6 +105,10 @@ deriving instance Data (GADT String)
104105deriving instance Eq (GADT a)
105106deriving instance Show (GADT a)
106107
108+newtype MaybeField = MaybeField { maybeField :: Maybe Int }
109+newtype OptionField = OptionField { optionField :: Option Int }
110+ deriving (Eq, Show)
111+
107112deriving instance Generic Foo
108113deriving instance Generic UFoo
109114deriving instance Generic OneConstructor
@@ -116,6 +121,7 @@ deriving instance Generic (SomeType a)
116121#if __GLASGOW_HASKELL__ >= 706
117122deriving instance Generic1 SomeType
118123#endif
124+deriving instance Generic OptionField
119125deriving instance Generic EitherTextInt
120126
121127failure :: Show a => String -> String -> a -> Property