Fix id_ breakage in benchmarks (#562)

Author: phadej

benchmarks/Typed/Generic.hs

@@ -7,7 +7,7 @@ import Prelude.Compat
 import "aeson" Data.Aeson hiding (Result)
 import Criterion
 import Data.ByteString.Lazy as L
-import Twitter.TH
+import Twitter.Generic
 import Typed.Common
 import qualified "aeson-benchmarks" Data.Aeson as B
 

benchmarks/aeson-benchmarks.cabal

@@ -125,7 +125,9 @@ executable aeson-benchmark-typed
   cpp-options: -DHAS_BOTH_AESON_AND_BENCHMARKS
   other-modules:
     Twitter
+    Twitter.Generic
     Twitter.Manual
+    Twitter.Options
     Twitter.TH
     Typed.Common
     Typed.Generic

examples/Twitter/Generic.hs

@@ -1,5 +1,8 @@
 -- Use GHC generics to automatically generate good instances.
+
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE PackageImports #-}
+
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Twitter.Generic
@@ -11,39 +14,64 @@ module Twitter.Generic
     ) where
 
 import Prelude ()
-import Prelude.Compat
+import Prelude.Compat ()
 
 import Twitter
+import Twitter.Options
 
 #ifndef HAS_BOTH_AESON_AND_BENCHMARKS
-import Data.Aeson (ToJSON, FromJSON)
+import Data.Aeson (ToJSON (..), FromJSON (..), genericToJSON, genericToEncoding, genericParseJSON)
 #else
-import "aeson" Data.Aeson (ToJSON, FromJSON)
+import "aeson" Data.Aeson (ToJSON (..), FromJSON (..), genericToJSON, genericToEncoding, genericParseJSON)
 import qualified "aeson-benchmarks" Data.Aeson as B
 #endif
 
-instance ToJSON Metadata
-instance FromJSON Metadata
+instance ToJSON Metadata where
+    toJSON = genericToJSON twitterOptions
+    toEncoding = genericToEncoding twitterOptions
+instance FromJSON Metadata where
+    parseJSON = genericParseJSON twitterOptions
 
-instance ToJSON Geo
-instance FromJSON Geo
+instance ToJSON Geo where
+    toJSON = genericToJSON twitterOptions
+    toEncoding = genericToEncoding twitterOptions
+instance FromJSON Geo where
+    parseJSON = genericParseJSON twitterOptions
 
-instance ToJSON Story
-instance FromJSON Story
+instance ToJSON Story where
+    toJSON = genericToJSON twitterOptions
+    toEncoding = genericToEncoding twitterOptions
+instance FromJSON Story where
+    parseJSON = genericParseJSON twitterOptions
 
-instance ToJSON Result
-instance FromJSON Result
+instance ToJSON Result where
+    toJSON = genericToJSON twitterOptions
+    toEncoding = genericToEncoding twitterOptions
+instance FromJSON Result where
+    parseJSON = genericParseJSON twitterOptions
 
 #ifdef HAS_BOTH_AESON_AND_BENCHMARKS
-instance B.ToJSON Metadata
-instance B.FromJSON Metadata
+instance B.ToJSON Metadata where
+    toJSON = B.genericToJSON btwitterOptions
+    toEncoding = B.genericToEncoding btwitterOptions
+instance B.FromJSON Metadata where
+    parseJSON = B.genericParseJSON btwitterOptions
 
-instance B.ToJSON Geo
-instance B.FromJSON Geo
+instance B.ToJSON Geo where
+    toJSON = B.genericToJSON btwitterOptions
+    toEncoding = B.genericToEncoding btwitterOptions
+instance B.FromJSON Geo where
+    parseJSON = B.genericParseJSON btwitterOptions
 
-instance B.ToJSON Story
-instance B.FromJSON Story
+instance B.ToJSON Story where
+    toJSON = B.genericToJSON btwitterOptions
+    toEncoding = B.genericToEncoding btwitterOptions
+instance B.FromJSON Story where
+    parseJSON = B.genericParseJSON btwitterOptions
 
-instance B.ToJSON Result
-instance B.FromJSON Result
+instance B.ToJSON Result where
+    toJSON = B.genericToJSON btwitterOptions
+    toEncoding = B.genericToEncoding btwitterOptions
+instance B.FromJSON Result where
+    parseJSON = B.genericParseJSON btwitterOptions
 #endif

examples/Twitter/Options.hs

@@ -0,0 +1,29 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE PackageImports #-}
+module Twitter.Options (module Twitter.Options) where
+
+#ifndef HAS_BOTH_AESON_AND_BENCHMARKS
+import Data.Aeson
+import Data.Aeson.Types
+#else
+import "aeson" Data.Aeson
+import "aeson" Data.Aeson.Types
+import qualified "aeson-benchmarks" Data.Aeson as B
+import qualified "aeson-benchmarks" Data.Aeson.Types as B
+#endif
+
+twitterOptions :: Options
+twitterOptions = defaultOptions
+    { fieldLabelModifier = \x -> case x of
+        "id_" -> "id"
+        _     -> x
+    }
+
+#ifdef HAS_BOTH_AESON_AND_BENCHMARKS
+btwitterOptions :: B.Options
+btwitterOptions = B.defaultOptions
+    { B.fieldLabelModifier = \x -> case x of
+        "id_" -> "id"
+        _     -> x
+    }
+#endif

examples/Twitter/TH.hs

@@ -16,6 +16,7 @@ module Twitter.TH
 import Prelude ()
 
 import Twitter
+import Twitter.Options
 
 #ifndef HAS_BOTH_AESON_AND_BENCHMARKS
 import Data.Aeson.TH
@@ -24,14 +25,14 @@ import "aeson" Data.Aeson.TH
 import qualified "aeson-benchmarks" Data.Aeson.TH as B
 #endif
 
-$(deriveJSON defaultOptions ''Metadata)
-$(deriveJSON defaultOptions ''Geo)
-$(deriveJSON defaultOptions ''Story)
-$(deriveJSON defaultOptions ''Result)
+$(deriveJSON twitterOptions ''Metadata)
+$(deriveJSON twitterOptions ''Geo)
+$(deriveJSON twitterOptions ''Story)
+$(deriveJSON twitterOptions ''Result)
 
 #ifdef HAS_BOTH_AESON_AND_BENCHMARKS
-$(B.deriveJSON B.defaultOptions ''Metadata)
-$(B.deriveJSON B.defaultOptions ''Geo)
-$(B.deriveJSON B.defaultOptions ''Story)
-$(B.deriveJSON B.defaultOptions ''Result)
+$(B.deriveJSON btwitterOptions ''Metadata)
+$(B.deriveJSON btwitterOptions ''Geo)
+$(B.deriveJSON btwitterOptions ''Story)
+$(B.deriveJSON btwitterOptions ''Result)
 #endif