on master help sign in
Added INLINE pragmas to all generic methods. This speeds up the benchmarks
commit5996455179f461241a9a4a2c16d221930f98fb2e authorBas van Dijk <v.dijk.bas@gmail.com> dateSat 29 Oct 2011, 20:59 (15 years ago) parent778255a
1 file changed+33
Data/Aeson/Types/Internal.hs+33
Data/Aeson/Types/Internal.hs+33
@@ -925,22 +925,28 @@ class GToJSON f where
925925
926926instance (GToJSON a) => GToJSON (M1 i c a) where
927927 gToJSON = gToJSON . unM1
928+ {-# INLINE gToJSON #-}
928929
929930instance (ToJSON a) => GToJSON (K1 i a) where
930931 gToJSON = toJSON . unK1
932+ {-# INLINE gToJSON #-}
931933
932934instance GToJSON U1 where
933935 gToJSON _ = emptyArray
936+ {-# INLINE gToJSON #-}
934937
935938instance (ConsToJSON a) => GToJSON (C1 c a) where
936939 gToJSON = consToJSON . unM1
940+ {-# INLINE gToJSON #-}
937941
938942instance (GProductToValues a, GProductToValues b) => GToJSON (a :*: b) where
939943 gToJSON = toJSON . toList . gProductToValues
944+ {-# INLINE gToJSON #-}
940945
941946instance (GObject a, GObject b) => GToJSON (a :+: b) where
942947 gToJSON (L1 x) = Object $ gObject x
943948 gToJSON (R1 x) = Object $ gObject x
949+ {-# INLINE gToJSON #-}
944950
945951--------------------------------------------------------------------------------
946952
@@ -949,12 +955,15 @@ class ConsToJSON' b f where consToJSON' :: Tagged b (f a -> Value)
949955
950956instance (IsRecord f b, ConsToJSON' b f) => ConsToJSON f where
951957 consToJSON = unTagged (consToJSON' :: Tagged b (f a -> Value))
958+ {-# INLINE consToJSON #-}
952959
953960instance (GRecordToObject f) => ConsToJSON' True f where
954961 consToJSON' = Tagged (Object . gRecordToObject)
962+ {-# INLINE consToJSON' #-}
955963
956964instance GToJSON f => ConsToJSON' False f where
957965 consToJSON' = Tagged gToJSON
966+ {-# INLINE consToJSON' #-}
958967
959968--------------------------------------------------------------------------------
960969
@@ -963,9 +972,11 @@ class GRecordToObject f where
963972
964973instance (GRecordToObject a, GRecordToObject b) => GRecordToObject (a :*: b) where
965974 gRecordToObject (a :*: b) = gRecordToObject a `M.union` gRecordToObject b
975+ {-# INLINE gRecordToObject #-}
966976
967977instance (Selector s, GToJSON a) => GRecordToObject (S1 s a) where
968978 gRecordToObject m1 = M.singleton (pack (selName m1)) (gToJSON (unM1 m1))
979+ {-# INLINE gRecordToObject #-}
969980
970981--------------------------------------------------------------------------------
971982
@@ -974,9 +985,11 @@ class GProductToValues f where
974985
975986instance (GProductToValues a, GProductToValues b) => GProductToValues (a :*: b) where
976987 gProductToValues (a :*: b) = gProductToValues a `append` gProductToValues b
988+ {-# INLINE gProductToValues #-}
977989
978990instance (GToJSON a) => GProductToValues a where
979991 gProductToValues = singleton . gToJSON
992+ {-# INLINE gProductToValues #-}
980993
981994--------------------------------------------------------------------------------
982995
@@ -986,9 +999,11 @@ class GObject f where
986999instance (GObject a, GObject b) => GObject (a :+: b) where
9871000 gObject (L1 x) = gObject x
9881001 gObject (R1 x) = gObject x
1002+ {-# INLINE gObject #-}
9891003
9901004instance (Constructor c, GToJSON a, ConsToJSON a) => GObject (C1 c a) where
9911005 gObject m1 = M.singleton (pack (conName m1)) (gToJSON m1)
1006+ {-# INLINE gObject #-}
9921007
9931008--------------------------------------------------------------------------------
9941009-- Generic parseJSON
@@ -998,25 +1013,31 @@ class GFromJSON f where
9981013
9991014instance (GFromJSON a) => GFromJSON (M1 i c a) where
10001015 gParseJSON = fmap M1 . gParseJSON
1016+ {-# INLINE gParseJSON #-}
10011017
10021018instance (FromJSON a) => GFromJSON (K1 i a) where
10031019 gParseJSON = fmap K1 . parseJSON
1020+ {-# INLINE gParseJSON #-}
10041021
10051022instance GFromJSON U1 where
10061023 gParseJSON v
10071024 | isEmptyArray v = pure U1
10081025 | otherwise = typeMismatch "unit constructor (U1)" v
1026+ {-# INLINE gParseJSON #-}
10091027
10101028instance (ConsFromJSON a) => GFromJSON (C1 c a) where
10111029 gParseJSON = fmap M1 . consParseJSON
1030+ {-# INLINE gParseJSON #-}
10121031
10131032instance (GFromProduct a, GFromProduct b) => GFromJSON (a :*: b) where
10141033 gParseJSON (Array arr) = gParseProduct arr
10151034 gParseJSON v = typeMismatch "product (:*:)" v
1035+ {-# INLINE gParseJSON #-}
10161036
10171037instance (GFromSum a, GFromSum b) => GFromJSON (a :+: b) where
10181038 gParseJSON (Object (M.toList -> [keyVal])) = gParseSum keyVal
10191039 gParseJSON v = typeMismatch "sum (:+:)" v
1040+ {-# INLINE gParseJSON #-}
10201041
10211042--------------------------------------------------------------------------------
10221043
@@ -1025,15 +1046,18 @@ class ConsFromJSON' b f where consParseJSON' :: Tagged b (Value -> Parser (f a))
10251046
10261047instance (IsRecord f b, ConsFromJSON' b f) => ConsFromJSON f where
10271048 consParseJSON = unTagged (consParseJSON' :: Tagged b (Value -> Parser (f a)))
1049+ {-# INLINE consParseJSON #-}
10281050
10291051instance (GFromRecord f) => ConsFromJSON' True f where
10301052 consParseJSON' = Tagged parseRecord
10311053 where
10321054 parseRecord (Object obj) = gParseRecord obj
10331055 parseRecord v = typeMismatch "record (:*:)" v
1056+ {-# INLINE consParseJSON' #-}
10341057
10351058instance (GFromJSON f) => ConsFromJSON' False f where
10361059 consParseJSON' = Tagged gParseJSON
1060+ {-# INLINE consParseJSON' #-}
10371061
10381062--------------------------------------------------------------------------------
10391063
@@ -1042,6 +1066,7 @@ class GFromRecord f where
10421066
10431067instance (GFromRecord a, GFromRecord b) => GFromRecord (a :*: b) where
10441068 gParseRecord obj = (:*:) <$> gParseRecord obj <*> gParseRecord obj
1069+ {-# INLINE gParseRecord #-}
10451070
10461071instance (Selector s, GFromJSON a) => GFromRecord (S1 s a) where
10471072 gParseRecord obj = case M.lookup (T.pack key) obj of
@@ -1049,6 +1074,7 @@ instance (Selector s, GFromJSON a) => GFromRecord (S1 s a) where
10491074 Just v -> gParseJSON v
10501075 where
10511076 key = selName (undefined :: t s a p)
1077+ {-# INLINE gParseRecord #-}
10521078
10531079--------------------------------------------------------------------------------
10541080
@@ -1059,10 +1085,12 @@ instance (GFromProduct a, GFromProduct b) => GFromProduct (a :*: b) where
10591085 gParseProduct arr = (:*:) <$> gParseProduct arrL <*> gParseProduct arrR
10601086 where
10611087 (arrL, arrR) = V.splitAt (V.length arr `div` 2) arr
1088+ {-# INLINE gParseProduct #-}
10621089
10631090instance (GFromJSON a) => GFromProduct a where
10641091 gParseProduct ((!? 0) -> Just v) = gParseJSON v
10651092 gParseProduct _ = fail "Array to small"
1093+ {-# INLINE gParseProduct #-}
10661094
10671095--------------------------------------------------------------------------------
10681096
@@ -1071,11 +1099,13 @@ class GFromSum f where
10711099
10721100instance (GFromSum a, GFromSum b) => GFromSum (a :+: b) where
10731101 gParseSum keyVal = (L1 <$> gParseSum keyVal) <|> (R1 <$> gParseSum keyVal)
1102+ {-# INLINE gParseSum #-}
10741103
10751104instance (Constructor c, GFromJSON a, ConsFromJSON a) => GFromSum (C1 c a) where
10761105 gParseSum (key, value)
10771106 | key == pack (conName (undefined :: t c a p)) = gParseJSON value
10781107 | otherwise = notFound $ unpack key
1108+ {-# INLINE gParseSum #-}
10791109
10801110notFound :: String -> Parser a
10811111notFound key = fail $ "The key \"" ++ key ++ "\" was not found"
@@ -1101,12 +1131,15 @@ type DList a = [a] -> [a]
11011131
11021132toList :: DList a -> [a]
11031133toList = ($ [])
1134+{-# INLINE toList #-}
11041135
11051136singleton :: a -> DList a
11061137singleton = (:)
1138+{-# INLINE singleton #-}
11071139
11081140append :: DList a -> DList a -> DList a
11091141append = (.)
1142+{-# INLINE append #-}
11101143
11111144--------------------------------------------------------------------------------
11121145#endif