basvandijk avatar basvandijk committed e9ff414

Improved performance of generic toJSON of records

Comments (0)

Files changed (1)


     consToJSON = unTagged (consToJSON' :: Tagged b (f a -> Value))
     {-# INLINE consToJSON #-}
-instance (GRecordToObject f) => ConsToJSON' True f where
-    consToJSON' = Tagged (Object . gRecordToObject)
+instance (GRecordToPairs f) => ConsToJSON' True f where
+    consToJSON' = Tagged (object . toList . gRecordToPairs)
     {-# INLINE consToJSON' #-}
 instance GToJSON f => ConsToJSON' False f where
-class GRecordToObject f where
-    gRecordToObject :: f a -> Object
+class GRecordToPairs f where
+    gRecordToPairs :: f a -> DList Pair
-instance (GRecordToObject a, GRecordToObject b) => GRecordToObject (a :*: b) where
-    gRecordToObject (a :*: b) = gRecordToObject a `M.union` gRecordToObject b
-    {-# INLINE gRecordToObject #-}
+instance (GRecordToPairs a, GRecordToPairs b) => GRecordToPairs (a :*: b) where
+    gRecordToPairs (a :*: b) = gRecordToPairs a `append` gRecordToPairs b
+    {-# INLINE gRecordToPairs #-}
-instance (Selector s, GToJSON a) => GRecordToObject (S1 s a) where
-    gRecordToObject m1 = M.singleton (pack (selName m1)) (gToJSON (unM1 m1))
-    {-# INLINE gRecordToObject #-}
+instance (Selector s, GToJSON a) => GRecordToPairs (S1 s a) where
+    gRecordToPairs m1 = singleton (pack (selName m1), gToJSON (unM1 m1))
+    {-# INLINE gRecordToPairs #-}
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.