git.iko.soy/typeable/aeson
on master help sign in
Improved performance of generic toJSON of products by 60%
b8bb26fBas van Dijk
Data/Aeson/Types/Generic.hs+18−5
compare with master
unifiedsplit
@@ -33,9 +33,11 @@ import Data.Text (pack, unpack)
33import Data.DList (DList, toList)
33import Data.DList (DList, toList)
34import Data.Monoid (mappend)
34import Data.Monoid (mappend)
35import GHC.Generics
35import GHC.Generics
36+import Control.Monad.ST (ST)
36import qualified Data.HashMap.Strict as H
37import qualified Data.HashMap.Strict as H
37import qualified Data.Text as T
38import qualified Data.Text as T
38import qualified Data.Vector as V
39import qualified Data.Vector as V
40+import qualified Data.Vector.Mutable as VM
39
41
40--------------------------------------------------------------------------------
42--------------------------------------------------------------------------------
41-- Generic toJSON
43-- Generic toJSON
@@ -56,8 +58,14 @@ instance (ConsToJSON a) => GToJSON (C1 c a) where
56 gToJSON = consToJSON . unM1
58 gToJSON = consToJSON . unM1
57 {-# INLINE gToJSON #-}
59 {-# INLINE gToJSON #-}
58
60
59−instance (GProductToValues a, GProductToValues b) => GToJSON (a :*: b) where
61+instance ( GProductToValues a, GProductToValues b
62+ , ProductSize a, ProductSize b) => GToJSON (a :*: b) where
63+ gToJSON p = Array $ V.create $ do
64+ mv <- VM.unsafeNew lenProduct
60− gToJSON = toJSON . toList . gProductToValues
65+ gProductToValues mv 0 lenProduct p
66+ return mv
67+ where
68+ lenProduct = unTagged2 (productSize :: Tagged2 (a :*: b) Int)
61 {-# INLINE gToJSON #-}
69 {-# INLINE gToJSON #-}
62
70
63instance (GObject a, GObject b) => GToJSON (a :+: b) where
71instance (GObject a, GObject b) => GToJSON (a :+: b) where
@@ -100,14 +108,19 @@ instance (Selector s, GToJSON a) => GRecordToPairs (S1 s a) where
100--------------------------------------------------------------------------------
108--------------------------------------------------------------------------------
101
109
102class GProductToValues f where
110class GProductToValues f where
103− gProductToValues :: f a -> DList Value
111+ gProductToValues :: VM.MVector s Value -> Int -> Int -> f a -> ST s ()
104
112
105instance (GProductToValues a, GProductToValues b) => GProductToValues (a :*: b) where
113instance (GProductToValues a, GProductToValues b) => GProductToValues (a :*: b) where
106− gProductToValues (a :*: b) = gProductToValues a `mappend` gProductToValues b
114+ gProductToValues mv ix len (a :*: b) = do gProductToValues mv ix lenL a
115+ gProductToValues mv ixR lenR b
116+ where
117+ lenL = len `shiftR` 1
118+ ixR = ix + lenL
119+ lenR = len - lenL
107 {-# INLINE gProductToValues #-}
120 {-# INLINE gProductToValues #-}
108
121
109instance (GToJSON a) => GProductToValues a where
122instance (GToJSON a) => GProductToValues a where
110− gProductToValues = pure . gToJSON
123+ gProductToValues mv ix _ = VM.unsafeWrite mv ix . gToJSON
111 {-# INLINE gProductToValues #-}
124 {-# INLINE gProductToValues #-}
112
125
113--------------------------------------------------------------------------------
126--------------------------------------------------------------------------------