git.iko.soy/typeable/aeson
on master help sign in
Added INLINE pragmas to all generic methods. This speeds up the benchmarks
5996455Bas van Dijk
Data/Aeson/Types/Internal.hs+33
compare with master
unifiedsplit
@@ -925,22 +925,28 @@ class GToJSON f where
925
925
926instance (GToJSON a) => GToJSON (M1 i c a) where
926instance (GToJSON a) => GToJSON (M1 i c a) where
927 gToJSON = gToJSON . unM1
927 gToJSON = gToJSON . unM1
928+ {-# INLINE gToJSON #-}
928
929
929instance (ToJSON a) => GToJSON (K1 i a) where
930instance (ToJSON a) => GToJSON (K1 i a) where
930 gToJSON = toJSON . unK1
931 gToJSON = toJSON . unK1
932+ {-# INLINE gToJSON #-}
931
933
932instance GToJSON U1 where
934instance GToJSON U1 where
933 gToJSON _ = emptyArray
935 gToJSON _ = emptyArray
936+ {-# INLINE gToJSON #-}
934
937
935instance (ConsToJSON a) => GToJSON (C1 c a) where
938instance (ConsToJSON a) => GToJSON (C1 c a) where
936 gToJSON = consToJSON . unM1
939 gToJSON = consToJSON . unM1
940+ {-# INLINE gToJSON #-}
937
941
938instance (GProductToValues a, GProductToValues b) => GToJSON (a :*: b) where
942instance (GProductToValues a, GProductToValues b) => GToJSON (a :*: b) where
939 gToJSON = toJSON . toList . gProductToValues
943 gToJSON = toJSON . toList . gProductToValues
944+ {-# INLINE gToJSON #-}
940
945
941instance (GObject a, GObject b) => GToJSON (a :+: b) where
946instance (GObject a, GObject b) => GToJSON (a :+: b) where
942 gToJSON (L1 x) = Object $ gObject x
947 gToJSON (L1 x) = Object $ gObject x
943 gToJSON (R1 x) = Object $ gObject x
948 gToJSON (R1 x) = Object $ gObject x
949+ {-# INLINE gToJSON #-}
944
950
945--------------------------------------------------------------------------------
951--------------------------------------------------------------------------------
946
952
@@ -949,12 +955,15 @@ class ConsToJSON' b f where consToJSON' :: Tagged b (f a -> Value)
949
955
950instance (IsRecord f b, ConsToJSON' b f) => ConsToJSON f where
956instance (IsRecord f b, ConsToJSON' b f) => ConsToJSON f where
951 consToJSON = unTagged (consToJSON' :: Tagged b (f a -> Value))
957 consToJSON = unTagged (consToJSON' :: Tagged b (f a -> Value))
958+ {-# INLINE consToJSON #-}
952
959
953instance (GRecordToObject f) => ConsToJSON' True f where
960instance (GRecordToObject f) => ConsToJSON' True f where
954 consToJSON' = Tagged (Object . gRecordToObject)
961 consToJSON' = Tagged (Object . gRecordToObject)
962+ {-# INLINE consToJSON' #-}
955
963
956instance GToJSON f => ConsToJSON' False f where
964instance GToJSON f => ConsToJSON' False f where
957 consToJSON' = Tagged gToJSON
965 consToJSON' = Tagged gToJSON
966+ {-# INLINE consToJSON' #-}
958
967
959--------------------------------------------------------------------------------
968--------------------------------------------------------------------------------
960
969
@@ -963,9 +972,11 @@ class GRecordToObject f where
963
972
964instance (GRecordToObject a, GRecordToObject b) => GRecordToObject (a :*: b) where
973instance (GRecordToObject a, GRecordToObject b) => GRecordToObject (a :*: b) where
965 gRecordToObject (a :*: b) = gRecordToObject a `M.union` gRecordToObject b
974 gRecordToObject (a :*: b) = gRecordToObject a `M.union` gRecordToObject b
975+ {-# INLINE gRecordToObject #-}
966
976
967instance (Selector s, GToJSON a) => GRecordToObject (S1 s a) where
977instance (Selector s, GToJSON a) => GRecordToObject (S1 s a) where
968 gRecordToObject m1 = M.singleton (pack (selName m1)) (gToJSON (unM1 m1))
978 gRecordToObject m1 = M.singleton (pack (selName m1)) (gToJSON (unM1 m1))
979+ {-# INLINE gRecordToObject #-}
969
980
970--------------------------------------------------------------------------------
981--------------------------------------------------------------------------------
971
982
@@ -974,9 +985,11 @@ class GProductToValues f where
974
985
975instance (GProductToValues a, GProductToValues b) => GProductToValues (a :*: b) where
986instance (GProductToValues a, GProductToValues b) => GProductToValues (a :*: b) where
976 gProductToValues (a :*: b) = gProductToValues a `append` gProductToValues b
987 gProductToValues (a :*: b) = gProductToValues a `append` gProductToValues b
988+ {-# INLINE gProductToValues #-}
977
989
978instance (GToJSON a) => GProductToValues a where
990instance (GToJSON a) => GProductToValues a where
979 gProductToValues = singleton . gToJSON
991 gProductToValues = singleton . gToJSON
992+ {-# INLINE gProductToValues #-}
980
993
981--------------------------------------------------------------------------------
994--------------------------------------------------------------------------------
982
995
@@ -986,9 +999,11 @@ class GObject f where
986instance (GObject a, GObject b) => GObject (a :+: b) where
999instance (GObject a, GObject b) => GObject (a :+: b) where
987 gObject (L1 x) = gObject x
1000 gObject (L1 x) = gObject x
988 gObject (R1 x) = gObject x
1001 gObject (R1 x) = gObject x
1002+ {-# INLINE gObject #-}
989
1003
990instance (Constructor c, GToJSON a, ConsToJSON a) => GObject (C1 c a) where
1004instance (Constructor c, GToJSON a, ConsToJSON a) => GObject (C1 c a) where
991 gObject m1 = M.singleton (pack (conName m1)) (gToJSON m1)
1005 gObject m1 = M.singleton (pack (conName m1)) (gToJSON m1)
1006+ {-# INLINE gObject #-}
992
1007
993--------------------------------------------------------------------------------
1008--------------------------------------------------------------------------------
994-- Generic parseJSON
1009-- Generic parseJSON
@@ -998,25 +1013,31 @@ class GFromJSON f where
998
1013
999instance (GFromJSON a) => GFromJSON (M1 i c a) where
1014instance (GFromJSON a) => GFromJSON (M1 i c a) where
1000 gParseJSON = fmap M1 . gParseJSON
1015 gParseJSON = fmap M1 . gParseJSON
1016+ {-# INLINE gParseJSON #-}
1001
1017
1002instance (FromJSON a) => GFromJSON (K1 i a) where
1018instance (FromJSON a) => GFromJSON (K1 i a) where
1003 gParseJSON = fmap K1 . parseJSON
1019 gParseJSON = fmap K1 . parseJSON
1020+ {-# INLINE gParseJSON #-}
1004
1021
1005instance GFromJSON U1 where
1022instance GFromJSON U1 where
1006 gParseJSON v
1023 gParseJSON v
1007 | isEmptyArray v = pure U1
1024 | isEmptyArray v = pure U1
1008 | otherwise = typeMismatch "unit constructor (U1)" v
1025 | otherwise = typeMismatch "unit constructor (U1)" v
1026+ {-# INLINE gParseJSON #-}
1009
1027
1010instance (ConsFromJSON a) => GFromJSON (C1 c a) where
1028instance (ConsFromJSON a) => GFromJSON (C1 c a) where
1011 gParseJSON = fmap M1 . consParseJSON
1029 gParseJSON = fmap M1 . consParseJSON
1030+ {-# INLINE gParseJSON #-}
1012
1031
1013instance (GFromProduct a, GFromProduct b) => GFromJSON (a :*: b) where
1032instance (GFromProduct a, GFromProduct b) => GFromJSON (a :*: b) where
1014 gParseJSON (Array arr) = gParseProduct arr
1033 gParseJSON (Array arr) = gParseProduct arr
1015 gParseJSON v = typeMismatch "product (:*:)" v
1034 gParseJSON v = typeMismatch "product (:*:)" v
1035+ {-# INLINE gParseJSON #-}
1016
1036
1017instance (GFromSum a, GFromSum b) => GFromJSON (a :+: b) where
1037instance (GFromSum a, GFromSum b) => GFromJSON (a :+: b) where
1018 gParseJSON (Object (M.toList -> [keyVal])) = gParseSum keyVal
1038 gParseJSON (Object (M.toList -> [keyVal])) = gParseSum keyVal
1019 gParseJSON v = typeMismatch "sum (:+:)" v
1039 gParseJSON v = typeMismatch "sum (:+:)" v
1040+ {-# INLINE gParseJSON #-}
1020
1041
1021--------------------------------------------------------------------------------
1042--------------------------------------------------------------------------------
1022
1043
@@ -1025,15 +1046,18 @@ class ConsFromJSON' b f where consParseJSON' :: Tagged b (Value -> Parser (f a))
1025
1046
1026instance (IsRecord f b, ConsFromJSON' b f) => ConsFromJSON f where
1047instance (IsRecord f b, ConsFromJSON' b f) => ConsFromJSON f where
1027 consParseJSON = unTagged (consParseJSON' :: Tagged b (Value -> Parser (f a)))
1048 consParseJSON = unTagged (consParseJSON' :: Tagged b (Value -> Parser (f a)))
1049+ {-# INLINE consParseJSON #-}
1028
1050
1029instance (GFromRecord f) => ConsFromJSON' True f where
1051instance (GFromRecord f) => ConsFromJSON' True f where
1030 consParseJSON' = Tagged parseRecord
1052 consParseJSON' = Tagged parseRecord
1031 where
1053 where
1032 parseRecord (Object obj) = gParseRecord obj
1054 parseRecord (Object obj) = gParseRecord obj
1033 parseRecord v = typeMismatch "record (:*:)" v
1055 parseRecord v = typeMismatch "record (:*:)" v
1056+ {-# INLINE consParseJSON' #-}
1034
1057
1035instance (GFromJSON f) => ConsFromJSON' False f where
1058instance (GFromJSON f) => ConsFromJSON' False f where
1036 consParseJSON' = Tagged gParseJSON
1059 consParseJSON' = Tagged gParseJSON
1060+ {-# INLINE consParseJSON' #-}
1037
1061
1038--------------------------------------------------------------------------------
1062--------------------------------------------------------------------------------
1039
1063
@@ -1042,6 +1066,7 @@ class GFromRecord f where
1042
1066
1043instance (GFromRecord a, GFromRecord b) => GFromRecord (a :*: b) where
1067instance (GFromRecord a, GFromRecord b) => GFromRecord (a :*: b) where
1044 gParseRecord obj = (:*:) <$> gParseRecord obj <*> gParseRecord obj
1068 gParseRecord obj = (:*:) <$> gParseRecord obj <*> gParseRecord obj
1069+ {-# INLINE gParseRecord #-}
1045
1070
1046instance (Selector s, GFromJSON a) => GFromRecord (S1 s a) where
1071instance (Selector s, GFromJSON a) => GFromRecord (S1 s a) where
1047 gParseRecord obj = case M.lookup (T.pack key) obj of
1072 gParseRecord obj = case M.lookup (T.pack key) obj of
@@ -1049,6 +1074,7 @@ instance (Selector s, GFromJSON a) => GFromRecord (S1 s a) where
1049 Just v -> gParseJSON v
1074 Just v -> gParseJSON v
1050 where
1075 where
1051 key = selName (undefined :: t s a p)
1076 key = selName (undefined :: t s a p)
1077+ {-# INLINE gParseRecord #-}
1052
1078
1053--------------------------------------------------------------------------------
1079--------------------------------------------------------------------------------
1054
1080
@@ -1059,10 +1085,12 @@ instance (GFromProduct a, GFromProduct b) => GFromProduct (a :*: b) where
1059 gParseProduct arr = (:*:) <$> gParseProduct arrL <*> gParseProduct arrR
1085 gParseProduct arr = (:*:) <$> gParseProduct arrL <*> gParseProduct arrR
1060 where
1086 where
1061 (arrL, arrR) = V.splitAt (V.length arr `div` 2) arr
1087 (arrL, arrR) = V.splitAt (V.length arr `div` 2) arr
1088+ {-# INLINE gParseProduct #-}
1062
1089
1063instance (GFromJSON a) => GFromProduct a where
1090instance (GFromJSON a) => GFromProduct a where
1064 gParseProduct ((!? 0) -> Just v) = gParseJSON v
1091 gParseProduct ((!? 0) -> Just v) = gParseJSON v
1065 gParseProduct _ = fail "Array to small"
1092 gParseProduct _ = fail "Array to small"
1093+ {-# INLINE gParseProduct #-}
1066
1094
1067--------------------------------------------------------------------------------
1095--------------------------------------------------------------------------------
1068
1096
@@ -1071,11 +1099,13 @@ class GFromSum f where
1071
1099
1072instance (GFromSum a, GFromSum b) => GFromSum (a :+: b) where
1100instance (GFromSum a, GFromSum b) => GFromSum (a :+: b) where
1073 gParseSum keyVal = (L1 <$> gParseSum keyVal) <|> (R1 <$> gParseSum keyVal)
1101 gParseSum keyVal = (L1 <$> gParseSum keyVal) <|> (R1 <$> gParseSum keyVal)
1102+ {-# INLINE gParseSum #-}
1074
1103
1075instance (Constructor c, GFromJSON a, ConsFromJSON a) => GFromSum (C1 c a) where
1104instance (Constructor c, GFromJSON a, ConsFromJSON a) => GFromSum (C1 c a) where
1076 gParseSum (key, value)
1105 gParseSum (key, value)
1077 | key == pack (conName (undefined :: t c a p)) = gParseJSON value
1106 | key == pack (conName (undefined :: t c a p)) = gParseJSON value
1078 | otherwise = notFound $ unpack key
1107 | otherwise = notFound $ unpack key
1108+ {-# INLINE gParseSum #-}
1079
1109
1080notFound :: String -> Parser a
1110notFound :: String -> Parser a
1081notFound key = fail $ "The key \"" ++ key ++ "\" was not found"
1111notFound key = fail $ "The key \"" ++ key ++ "\" was not found"
@@ -1101,12 +1131,15 @@ type DList a = [a] -> [a]
1101
1131
1102toList :: DList a -> [a]
1132toList :: DList a -> [a]
1103toList = ($ [])
1133toList = ($ [])
1134+{-# INLINE toList #-}
1104
1135
1105singleton :: a -> DList a
1136singleton :: a -> DList a
1106singleton = (:)
1137singleton = (:)
1138+{-# INLINE singleton #-}
1107
1139
1108append :: DList a -> DList a -> DList a
1140append :: DList a -> DList a -> DList a
1109append = (.)
1141append = (.)
1142+{-# INLINE append #-}
1110
1143
1111--------------------------------------------------------------------------------
1144--------------------------------------------------------------------------------
1112#endif
1145#endif