git.iko.soy/typeable/aeson
on master help sign in
Tagged instance
commit7f80b9c87911e1d58680ba22e296217c006513b1 authorOleg Grenrus <oleg.grenrus@iki.fi> dateWed 25 May 2016, 10:21 (10 years ago) parente938bf3
4 files changed+59−36
compare with master
unifiedsplit
Data/Aeson/Types/Class.hs+3−1 Data/Aeson/Types/Instances.hs+12−7 benchmarks/AesonMap.hs+43−28 benchmarks/aeson-benchmarks.cabal+1
Data/Aeson/Types/Class.hs+3−1
@@ -1,4 +1,4 @@
1−{-# LANGUAGE CPP, DefaultSignatures, FlexibleContexts #-}
1+{-# LANGUAGE CPP, DefaultSignatures, FlexibleContexts, DeriveFunctor #-}
22
33-- |
44-- Module: Data.Aeson.Types.Class
@@ -265,6 +265,8 @@ data FromJSONKeyFunction a
265265 = FromJSONKeyText (Text -> a)
266266 | FromJSONKeyTextParser (Text -> Parser a)
267267 | FromJSONKeyValue (Value -> Parser a)
268+ deriving (Functor)
269+
268270
269271-- | Fail parsing due to a type mismatch, with a descriptive message.
270272--
Data/Aeson/Types/Instances.hs+12−7
@@ -1622,14 +1622,19 @@ instance ToJSONKey Text where
16221622instance FromJSONKey Text where
16231623 fromJSONKey = FromJSONKeyText id
16241624
1625+-- | TODO: where ToJSONKey instance
1626+instance FromJSONKey b => FromJSONKey (Tagged a b) where
1627+ fromJSONKey = fmap Tagged fromJSONKey
1628+ fromJSONKeyList = (fmap . fmap) Tagged fromJSONKeyList
1629+
16251630instance ToJSONKey Bool where
16261631 toJSONKey = ToJSONKeyText
16271632 ( (\x -> if x then "true" else "false")
16281633 , (\x -> Encoding $ if x then "\"true\"" else "\"false\"")
16291634 )
1630−
1635+
16311636instance ToJSONKey Int where
1632− toJSONKey = ToJSONKeyText
1637+ toJSONKey = ToJSONKeyText
16331638 ( LT.toStrict . LTB.toLazyText . LTBI.decimal
16341639 , \x -> Encoding $ B.char7 '"' <> fromEncoding (toEncoding x) <> B.char7 '"'
16351640 )
@@ -1639,8 +1644,8 @@ instance FromJSONKey Int where
16391644 -- aeson for doing this.
16401645 fromJSONKey = FromJSONKeyTextParser $ \t -> case TR.decimal t of
16411646 Left err -> fail err
1642− Right (v,t2) -> if T.null t2
1643− then return v
1647+ Right (v,t2) -> if T.null t2
1648+ then return v
16441649 else fail "Was not an integer, had extra stuff."
16451650
16461651instance (ToJSON a, ToJSON b) => ToJSONKey (a,b)
@@ -1656,9 +1661,9 @@ instance ToJSONKey Char where
16561661 toJSONKeyList = ToJSONKeyText (T.pack, toEncoding . T.pack)
16571662
16581663instance FromJSONKey Char where
1659− fromJSONKey = FromJSONKeyTextParser $ \t ->
1660− if T.length t == 1
1661− then return (T.index t 0)
1664+ fromJSONKey = FromJSONKeyTextParser $ \t ->
1665+ if T.length t == 1
1666+ then return (T.index t 0)
16621667 else typeMismatch "Expected Char but String didn't contain exactly one character" (String t)
16631668 fromJSONKeyList = FromJSONKeyText T.unpack
16641669
benchmarks/AesonMap.hs+43−28
@@ -6,6 +6,7 @@ import Data.Aeson
66-- import Data.Aeson.Types (Parser)
77import Data.Hashable
88import Data.Proxy (Proxy (..))
9+import Data.Tagged (Tagged (..))
910import qualified Data.ByteString.Lazy as LBS
1011import qualified Data.Text as T
1112import qualified Data.Map as M
@@ -17,16 +18,23 @@ value n = HM.fromList $ map f [1..n]
1718 f m = let t = T.pack (show m) in (t, t)
1819
1920-------------------------------------------------------------------------------
20−-- Text
21+-- Orphans
22+-------------------------------------------------------------------------------
23+
24+instance Hashable b => Hashable (Tagged a b) where
25+ hashWithSalt salt (Tagged a) = hashWithSalt salt a
26+
27+-------------------------------------------------------------------------------
28+-- Text
2129-------------------------------------------------------------------------------
2230
2331newtype T1 = T1 T.Text
2432 deriving (Eq, Ord)
2533
2634instance NFData T1 where
27− rnf (T1 t) = rnf t
35+ rnf (T1 t) = rnf t
2836instance Hashable T1 where
29− hashWithSalt salt (T1 t) = hashWithSalt salt t
37+ hashWithSalt salt (T1 t) = hashWithSalt salt t
3038instance FromJSON T1 where
3139 parseJSON = withText "T1" $ pure . T1
3240instance FromJSONKey T1 where
@@ -41,9 +49,9 @@ newtype T2 = T2 T.Text
4149 deriving (Eq, Ord)
4250
4351instance NFData T2 where
44− rnf (T2 t) = rnf t
52+ rnf (T2 t) = rnf t
4553instance Hashable T2 where
46− hashWithSalt salt (T2 t) = hashWithSalt salt t
54+ hashWithSalt salt (T2 t) = hashWithSalt salt t
4755instance FromJSON T2 where
4856 parseJSON = withText "T2" $ pure . T2
4957instance FromJSONKey T2 where
@@ -57,9 +65,9 @@ newtype T3 = T3 T.Text
5765 deriving (Eq, Ord)
5866
5967instance NFData T3 where
60− rnf (T3 t) = rnf t
68+ rnf (T3 t) = rnf t
6169instance Hashable T3 where
62− hashWithSalt salt (T3 t) = hashWithSalt salt t
70+ hashWithSalt salt (T3 t) = hashWithSalt salt t
6371instance FromJSON T3 where
6472 parseJSON = withText "T3" $ pure . T3
6573instance FromJSONKey T3 where
@@ -107,6 +115,9 @@ proxyT2 = Proxy
107115proxyT3 :: Proxy T3
108116proxyT3 = Proxy
109117
118+proxyTagged :: Proxy a -> Proxy (Tagged () a)
119+proxyTagged _ = Proxy
120+
110121-------------------------------------------------------------------------------
111122-- Main
112123-------------------------------------------------------------------------------
@@ -115,19 +126,23 @@ benchDecodeHM
115126 :: String
116127 -> LBS.ByteString
117128 -> Benchmark
118−benchDecodeHM name val =
129+benchDecodeHM name val =
119130 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
131+ [ bench "Text" $ nf (decodeHM proxyText) val
132+ , bench "Identity" $ nf (decodeHM proxyT1) val
133+ , bench "Coerce" $ nf (decodeHM proxyT2) val
134+ , bench "Parser" $ nf (decodeHM proxyT3) val
135+ , bench "Tagged Text" $ nf (decodeHM $ proxyTagged proxyText) val
136+ , bench "Tagged Identity" $ nf (decodeHM $ proxyTagged proxyT1) val
137+ , bench "Tagged Coerce" $ nf (decodeHM $ proxyTagged proxyT2) val
138+ , bench "Tagged Parser" $ nf (decodeHM $ proxyTagged proxyT3) val
124139 ]
125140
126141benchDecodeMap
127142 :: String
128143 -> LBS.ByteString
129144 -> Benchmark
130−benchDecodeMap name val =
145+benchDecodeMap name val =
131146 bgroup name
132147 [ bench "Text" $ nf (decodeMap proxyText) val
133148 , bench "Identity" $ nf (decodeMap proxyT1) val
@@ -137,19 +152,19 @@ benchDecodeMap name val =
137152
138153main :: IO ()
139154main = do
140− defaultMain
141− [ bgroup "encode"
142− [ bgroup "HashMap"
143− [ benchDecodeHM "10" encodedValue10
144− , benchDecodeHM "100" encodedValue100
145− , benchDecodeHM "1000" encodedValue1000
146− , benchDecodeHM "10000" encodedValue10000
147− ]
148− , bgroup "Map"
149− [ benchDecodeMap "10" encodedValue10
150− , benchDecodeMap "100" encodedValue100
151− , benchDecodeMap "1000" encodedValue1000
152− , benchDecodeMap "10000" encodedValue10000
155+ defaultMain
156+ [ bgroup "encode"
157+ [ bgroup "HashMap"
158+ [ benchDecodeHM "10" encodedValue10
159+ , benchDecodeHM "100" encodedValue100
160+ , benchDecodeHM "1000" encodedValue1000
161+ , benchDecodeHM "10000" encodedValue10000
162+ ]
163+ , bgroup "Map"
164+ [ benchDecodeMap "10" encodedValue10
165+ , benchDecodeMap "100" encodedValue100
166+ , benchDecodeMap "1000" encodedValue1000
167+ , benchDecodeMap "10000" encodedValue10000
168+ ]
169+ ]
153170 ]
154− ]
155− ]
benchmarks/aeson-benchmarks.cabal+1
@@ -177,6 +177,7 @@ executable aeson-benchmark-map
177177 containers,
178178 deepseq,
179179 hashable,
180+ tagged,
180181 text,
181182 transformers,
182183 transformers-compat,