@@ -1,10 +1,11 @@
1−{-# LANGUAGE BangPatterns, OverloadedStrings, FlexibleInstances, MultiParamTypeClasses, DataKinds #-}
1+{-# LANGUAGE OverloadedStrings, RankNTypes #-}
22
33import Control.DeepSeq
44import Criterion.Main
55import Data.Aeson
6−import Data.Aeson.Types (Parser)
6+-- import Data.Aeson.Types (Parser)
77import Data.Hashable
8+import Data.Proxy (Proxy (..))
89import qualified Data.ByteString.Lazy as LBS
910import qualified Data.Text as T
1011import qualified Data.Map as M
@@ -15,6 +16,10 @@ value n = HM.fromList $ map f [1..n]
1516 where
1617 f m = let t = T.pack (show m) in (t, t)
1718
19+-------------------------------------------------------------------------------
20+-- Text
21+-------------------------------------------------------------------------------
22+
1823newtype T1 = T1 T.Text
1924 deriving (Eq, Ord)
2025
@@ -22,9 +27,16 @@ instance NFData T1 where
2227 rnf (T1 t) = rnf t
2328instance Hashable T1 where
2429 hashWithSalt salt (T1 t) = hashWithSalt salt t
25−instance FromJSONKey T1 'JSONKeyIdentity where
26− fromJSONKey _ = T1
30+instance FromJSON T1 where
31+ parseJSON = withText "T1" $ pure . T1
32+instance FromJSONKey T1 where
33+ fromJSONKey = FromJSONKeyText T1
34+
35+-------------------------------------------------------------------------------
36+-- Coerce
37+-------------------------------------------------------------------------------
2738
39+-- | TODO: same as T1 for now
2840newtype T2 = T2 T.Text
2941 deriving (Eq, Ord)
3042
@@ -32,8 +44,14 @@ instance NFData T2 where
3244 rnf (T2 t) = rnf t
3345instance Hashable T2 where
3446 hashWithSalt salt (T2 t) = hashWithSalt salt t
35−instance FromJSONKey T2 'JSONKeyCoerce where
36− fromJSONKey _ = ()
47+instance FromJSON T2 where
48+ parseJSON = withText "T2" $ pure . T2
49+instance FromJSONKey T2 where
50+ fromJSONKey = FromJSONKeyText T2
51+
52+-------------------------------------------------------------------------------
53+-- TextParser
54+-------------------------------------------------------------------------------
3755
3856newtype T3 = T3 T.Text
3957 deriving (Eq, Ord)
@@ -42,8 +60,14 @@ instance NFData T3 where
4260 rnf (T3 t) = rnf t
4361instance Hashable T3 where
4462 hashWithSalt salt (T3 t) = hashWithSalt salt t
45−instance FromJSONKey T3 'JSONKeyTextParser where
46− fromJSONKey _ = return . T3
63+instance FromJSON T3 where
64+ parseJSON = withText "T3" $ pure . T3
65+instance FromJSONKey T3 where
66+ fromJSONKey = FromJSONKeyTextParser (pure . T3)
67+
68+-------------------------------------------------------------------------------
69+-- Values
70+-------------------------------------------------------------------------------
4771
4872encodedValue10 :: LBS.ByteString
4973encodedValue10 = encode $ value 10
@@ -57,59 +81,75 @@ encodedValue1000 = encode $ value 1000
5781encodedValue10000 :: LBS.ByteString
5882encodedValue10000 = encode $ value 10000
5983
84+-------------------------------------------------------------------------------
85+-- Helpers
86+-------------------------------------------------------------------------------
87+
88+decodeHM
89+ :: (FromJSONKey k, Eq k, Hashable k)
90+ => Proxy k -> LBS.ByteString -> Maybe (HM.HashMap k T.Text)
91+decodeHM _ = decode
92+
93+decodeMap
94+ :: (FromJSONKey k, Ord k)
95+ => Proxy k -> LBS.ByteString -> Maybe (M.Map k T.Text)
96+decodeMap _ = decode
97+
98+proxyText :: Proxy T.Text
99+proxyText = Proxy
100+
101+proxyT1 :: Proxy T1
102+proxyT1 = Proxy
103+
104+proxyT2 :: Proxy T2
105+proxyT2 = Proxy
106+
107+proxyT3 :: Proxy T3
108+proxyT3 = Proxy
109+
110+-------------------------------------------------------------------------------
111+-- Main
112+-------------------------------------------------------------------------------
113+
114+benchDecodeHM
115+ :: String
116+ -> LBS.ByteString
117+ -> Benchmark
118+benchDecodeHM name val =
119+ bgroup name
120+ [ bench "Text" $ nf (decodeHM proxyText) val
121+ , bench "Identity" $ nf (decodeHM proxyT1) val
122+ , bench "Coerce" $ nf (decodeHM proxyT2) val
123+ , bench "Parser" $ nf (decodeHM proxyT3) val
124+ ]
125+
126+benchDecodeMap
127+ :: String
128+ -> LBS.ByteString
129+ -> Benchmark
130+benchDecodeMap name val =
131+ bgroup name
132+ [ bench "Text" $ nf (decodeMap proxyText) val
133+ , bench "Identity" $ nf (decodeMap proxyT1) val
134+ , bench "Coerce" $ nf (decodeMap proxyT2) val
135+ , bench "Parser" $ nf (decodeMap proxyT3) val
136+ ]
137+
60138main :: IO ()
61139main = do
62140 defaultMain
63− [ bgroup "HashMap"
64− [ bgroup "10"
65− [ bench "Text" $ nf (decode :: LBS.ByteString -> Maybe (HM.HashMap T.Text T.Text)) encodedValue10
66− , bench "Identity" $ nf (decode :: LBS.ByteString -> Maybe (HM.HashMap T1 T.Text)) encodedValue10
67− , bench "Coerce" $ nf (decode :: LBS.ByteString -> Maybe (HM.HashMap T2 T.Text)) encodedValue10
68− , bench "Parser" $ nf (decode :: LBS.ByteString -> Maybe (HM.HashMap T3 T.Text)) encodedValue10
69− ]
70− , bgroup "100"
71− [ bench "Text" $ nf (decode :: LBS.ByteString -> Maybe (HM.HashMap T.Text T.Text)) encodedValue100
72− , bench "Identity" $ nf (decode :: LBS.ByteString -> Maybe (HM.HashMap T1 T.Text)) encodedValue100
73− , bench "Coerce" $ nf (decode :: LBS.ByteString -> Maybe (HM.HashMap T2 T.Text)) encodedValue100
74− , bench "Parser" $ nf (decode :: LBS.ByteString -> Maybe (HM.HashMap T3 T.Text)) encodedValue100
75− ]
76− , bgroup "1000"
77− [ bench "Text" $ nf (decode :: LBS.ByteString -> Maybe (HM.HashMap T.Text T.Text)) encodedValue1000
78− , bench "Identity" $ nf (decode :: LBS.ByteString -> Maybe (HM.HashMap T1 T.Text)) encodedValue1000
79− , bench "Coerce" $ nf (decode :: LBS.ByteString -> Maybe (HM.HashMap T2 T.Text)) encodedValue1000
80− , bench "Parser" $ nf (decode :: LBS.ByteString -> Maybe (HM.HashMap T3 T.Text)) encodedValue1000
81− ]
82− , bgroup "10000"
83− [ bench "Text" $ nf (decode :: LBS.ByteString -> Maybe (HM.HashMap T.Text T.Text)) encodedValue10000
84− , bench "Identity" $ nf (decode :: LBS.ByteString -> Maybe (HM.HashMap T1 T.Text)) encodedValue10000
85− , bench "Coerce" $ nf (decode :: LBS.ByteString -> Maybe (HM.HashMap T2 T.Text)) encodedValue10000
86− , bench "Parser" $ nf (decode :: LBS.ByteString -> Maybe (HM.HashMap T3 T.Text)) encodedValue10000
87− ]
88− ]
89− , bgroup "Map"
90− [ bgroup "10"
91− [ bench "Text" $ nf (decode :: LBS.ByteString -> Maybe (M.Map T.Text T.Text)) encodedValue10
92− , bench "Identity" $ nf (decode :: LBS.ByteString -> Maybe (M.Map T1 T.Text)) encodedValue10
93− , bench "Coerce" $ nf (decode :: LBS.ByteString -> Maybe (M.Map T2 T.Text)) encodedValue10
94− , bench "Parser" $ nf (decode :: LBS.ByteString -> Maybe (M.Map T3 T.Text)) encodedValue10
95− ]
96− , bgroup "100"
97− [ bench "Text" $ nf (decode :: LBS.ByteString -> Maybe (M.Map T.Text T.Text)) encodedValue100
98− , bench "Identity" $ nf (decode :: LBS.ByteString -> Maybe (M.Map T1 T.Text)) encodedValue100
99− , bench "Coerce" $ nf (decode :: LBS.ByteString -> Maybe (M.Map T2 T.Text)) encodedValue100
100− , bench "Parser" $ nf (decode :: LBS.ByteString -> Maybe (M.Map T3 T.Text)) encodedValue100
101− ]
102− , bgroup "1000"
103− [ bench "Text" $ nf (decode :: LBS.ByteString -> Maybe (M.Map T.Text T.Text)) encodedValue1000
104− , bench "Identity" $ nf (decode :: LBS.ByteString -> Maybe (M.Map T1 T.Text)) encodedValue1000
105− , bench "Coerce" $ nf (decode :: LBS.ByteString -> Maybe (M.Map T2 T.Text)) encodedValue1000
106− , bench "Parser" $ nf (decode :: LBS.ByteString -> Maybe (M.Map T3 T.Text)) encodedValue1000
141+ [ bgroup "encode"
142+ [ bgroup "HashMap"
143+ [ benchDecodeHM "10" encodedValue10
144+ , benchDecodeHM "100" encodedValue100
145+ , benchDecodeHM "1000" encodedValue1000
146+ , benchDecodeHM "10000" encodedValue10000
107147 ]
108− , bgroup "10000"
109− [ bench "Text" $ nf (decode :: LBS.ByteString -> Maybe (M.Map T.Text T.Text)) encodedValue10000
110− , bench "Identity" $ nf (decode :: LBS.ByteString -> Maybe (M.Map T1 T.Text)) encodedValue10000
111− , bench "Coerce" $ nf (decode :: LBS.ByteString -> Maybe (M.Map T2 T.Text)) encodedValue10000
112− , bench "Parser" $ nf (decode :: LBS.ByteString -> Maybe (M.Map T3 T.Text)) encodedValue10000
148+ , bgroup "Map"
149+ [ benchDecodeMap "10" encodedValue10
150+ , benchDecodeMap "100" encodedValue100
151+ , benchDecodeMap "1000" encodedValue1000
152+ , benchDecodeMap "10000" encodedValue10000
113153 ]
114154 ]
115155 ]