@@ -33,9 +33,11 @@ import Data.Text (pack, unpack)
3333import Data.DList (DList, toList)
3434import Data.Monoid (mappend)
3535import GHC.Generics
36+import Control.Monad.ST (ST)
3637import qualified Data.HashMap.Strict as H
3738import qualified Data.Text as T
3839import qualified Data.Vector as V
40+import qualified Data.Vector.Mutable as VM
3941
4042--------------------------------------------------------------------------------
4143-- Generic toJSON
@@ -56,8 +58,14 @@ instance (ConsToJSON a) => GToJSON (C1 c a) where
5658 gToJSON = consToJSON . unM1
5759 {-# INLINE gToJSON #-}
5860
59−instance (GProductToValues a, GProductToValues b) => GToJSON (a :*: b) where
60− gToJSON = toJSON . toList . gProductToValues
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
65+ gProductToValues mv 0 lenProduct p
66+ return mv
67+ where
68+ lenProduct = unTagged2 (productSize :: Tagged2 (a :*: b) Int)
6169 {-# INLINE gToJSON #-}
6270
6371instance (GObject a, GObject b) => GToJSON (a :+: b) where
@@ -100,14 +108,19 @@ instance (Selector s, GToJSON a) => GRecordToPairs (S1 s a) where
100108--------------------------------------------------------------------------------
101109
102110class GProductToValues f where
103− gProductToValues :: f a -> DList Value
111+ gProductToValues :: VM.MVector s Value -> Int -> Int -> f a -> ST s ()
104112
105113instance (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
107120 {-# INLINE gProductToValues #-}
108121
109122instance (GToJSON a) => GProductToValues a where
110− gProductToValues = pure . gToJSON
123+ gProductToValues mv ix _ = VM.unsafeWrite mv ix . gToJSON
111124 {-# INLINE gProductToValues #-}
112125
113126--------------------------------------------------------------------------------