Skip to content

Commit ef3e340

Browse files
phadejBoarders
andcommitted
Change Object to use an opaque KeyMap interface
Co-authored-by: Callan McGill <[email protected]>
1 parent 92bfca0 commit ef3e340

File tree

15 files changed

+345
-87
lines changed

15 files changed

+345
-87
lines changed

aeson.cabal

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
name: aeson
2-
version: 1.5.6.0
2+
version: 2.0.0.0
33
license: BSD3
44
license-file: LICENSE
55
category: Text, Web, JSON
@@ -68,6 +68,7 @@ library
6868
Data.Aeson.Internal
6969
Data.Aeson.Internal.Time
7070
Data.Aeson.Parser.Internal
71+
Data.Aeson.KeyMap
7172

7273
-- Deprecated modules
7374
exposed-modules:

benchmarks/aeson-benchmarks.cabal

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -76,6 +76,7 @@ library
7676
Data.Aeson.Internal
7777
Data.Aeson.Internal.Functions
7878
Data.Aeson.Internal.Time
79+
Data.Aeson.KeyMap
7980
Data.Aeson.Parser
8081
Data.Aeson.Parser.Internal
8182
Data.Aeson.Parser.Time

changelog.md

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,13 +1,16 @@
11
For the latest version of this document, please see [https://github.com/haskell/aeson/blob/master/changelog.md](https://github.com/haskell/aeson/blob/master/changelog.md).
22

3-
### 1.6.0.0
3+
### 2.0.0.0
44

55
* Remove forced `-O2` and then unneeded `fast` flag.
66
Also remove most of `INLINE` pragmas.
77
In the effect, `aeson` compiles almost twice as fast.
88

99
To get `fast` compilation effect cabal-install users may specify `optimization: False`.
1010

11+
* Make map type used by Object abstract so the underlying implementation can
12+
be modified, thanks to Callan McGill
13+
1114
### 1.5.6.0
1215
* Make `Show Value` instance print object keys in lexicographic order.
1316

src/Data/Aeson/Encoding/Builder.hs

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -42,6 +42,7 @@ import Prelude.Compat
4242

4343
import Data.Aeson.Internal.Time
4444
import Data.Aeson.Types.Internal (Value (..))
45+
import qualified Data.Aeson.KeyMap as KM
4546
import Data.ByteString.Builder as B
4647
import Data.ByteString.Builder.Prim as BP
4748
import Data.ByteString.Builder.Scientific (scientificBuilder)
@@ -54,7 +55,6 @@ import Data.Time.Calendar.Month.Compat (Month, toYearMonth)
5455
import Data.Time.Calendar.Quarter.Compat (Quarter, toYearQuarter, QuarterOfYear (..))
5556
import Data.Time.LocalTime
5657
import Data.Word (Word8)
57-
import qualified Data.HashMap.Strict as HMS
5858
import qualified Data.Text as T
5959
import qualified Data.Vector as V
6060

@@ -90,8 +90,8 @@ array v
9090
withComma a z = B.char8 ',' <> encodeToBuilder a <> z
9191

9292
-- Encode a JSON object.
93-
object :: HMS.HashMap T.Text Value -> Builder
94-
object m = case HMS.toList m of
93+
object :: KM.KeyMap Value -> Builder
94+
object m = case KM.toList m of
9595
(x:xs) -> B.char8 '{' <> one x <> foldr withComma (B.char8 '}') xs
9696
_ -> emptyObject_
9797
where

src/Data/Aeson/Internal/Functions.hs

Lines changed: 9 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -9,23 +9,24 @@
99
-- Portability: portable
1010

1111
module Data.Aeson.Internal.Functions
12-
(
13-
mapHashKeyVal
12+
( mapTextKeyVal
1413
, mapKeyVal
1514
, mapKey
1615
) where
1716

1817
import Prelude.Compat
1918

2019
import Data.Hashable (Hashable)
20+
import qualified Data.Aeson.KeyMap as KM
2121
import qualified Data.HashMap.Strict as H
2222
import qualified Data.Map as M
23+
import qualified Data.Text as T
2324

24-
-- | Transform a 'M.Map' into a 'H.HashMap' while transforming the keys.
25-
mapHashKeyVal :: (Eq k2, Hashable k2) => (k1 -> k2) -> (v1 -> v2)
26-
-> M.Map k1 v1 -> H.HashMap k2 v2
27-
mapHashKeyVal fk kv = M.foldrWithKey (\k v -> H.insert (fk k) (kv v)) H.empty
28-
{-# INLINE mapHashKeyVal #-}
25+
-- | Transform a 'M.Map' into a 'KM.KeyMap' while transforming the keys.
26+
mapTextKeyVal :: (k -> T.Text) -> (v1 -> v2)
27+
-> M.Map k v1 -> KM.KeyMap v2
28+
mapTextKeyVal fk kv = M.foldrWithKey (\k v -> KM.insert (fk k) (kv v)) KM.empty
29+
{-# INLINE mapTextKeyVal #-}
2930

3031
-- | Transform the keys and values of a 'H.HashMap'.
3132
mapKeyVal :: (Eq k2, Hashable k2) => (k1 -> k2) -> (v1 -> v2)
@@ -37,3 +38,4 @@ mapKeyVal fk kv = H.foldrWithKey (\k v -> H.insert (fk k) (kv v)) H.empty
3738
mapKey :: (Eq k2, Hashable k2) => (k1 -> k2) -> H.HashMap k1 v -> H.HashMap k2 v
3839
mapKey fk = mapKeyVal fk id
3940
{-# INLINE mapKey #-}
41+

src/Data/Aeson/KeyMap.hs

Lines changed: 230 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,230 @@
1+
{-# LANGUAGE CPP #-}
2+
{-# LANGUAGE DeriveDataTypeable #-}
3+
{-# LANGUAGE DeriveFunctor #-}
4+
{-# LANGUAGE TemplateHaskell #-}
5+
6+
-- |
7+
-- An abstract interface for maps from Textual keys to values.
8+
9+
module Data.Aeson.KeyMap (
10+
-- * Map Type
11+
KeyMap,
12+
13+
-- * Query
14+
lookup,
15+
size,
16+
member,
17+
18+
-- * Construction
19+
empty,
20+
singleton,
21+
22+
-- ** Insertion
23+
insert,
24+
25+
-- * Combine
26+
difference,
27+
28+
-- * Lists
29+
fromList,
30+
fromListWith,
31+
toList,
32+
toAscList,
33+
34+
-- * HashMaps
35+
fromHashMap,
36+
toHashMap,
37+
38+
-- * Traversal
39+
-- ** Map
40+
mapKeyVal,
41+
traverseWithKey,
42+
43+
-- * Folds
44+
foldrWithKey,
45+
46+
-- * Conversions
47+
keys,
48+
) where
49+
50+
#if 1
51+
import Control.DeepSeq (NFData(..))
52+
import Data.Data (Data)
53+
import Data.Hashable (Hashable(..))
54+
import Data.HashMap.Strict (HashMap)
55+
import Data.List (sortBy)
56+
import Data.Ord (comparing)
57+
import Data.Text (Text, unpack, pack)
58+
import Data.Typeable (Typeable)
59+
import Prelude hiding (lookup)
60+
import Control.Arrow (first)
61+
import Data.Foldable hiding (toList)
62+
import Text.Read
63+
#if __GLASGOW_HASKELL__ < 710
64+
import Data.Monoid (Monoid(mempty, mappend))
65+
import Data.Traversable (Traversable(..))
66+
import Control.Applicative (Applicative)
67+
#endif
68+
#if __GLASGOW_HASKELL__ >= 711
69+
import Data.Semigroup (Semigroup((<>)))
70+
#endif
71+
72+
import qualified Data.HashMap.Strict as H
73+
import qualified Language.Haskell.TH.Syntax as TH
74+
75+
newtype KeyMap v = KeyMap { unKeyMap :: HashMap Text v }
76+
deriving (Eq, Ord, Typeable, Data, Functor)
77+
78+
instance Read v => Read (KeyMap v) where
79+
readPrec = parens $ prec 10 $ do
80+
Ident "fromList" <- lexP
81+
xs <- readPrec
82+
return (fromList xs)
83+
84+
readListPrec = readListPrecDefault
85+
86+
instance Show v => Show (KeyMap v) where
87+
showsPrec d m = showParen (d > 10) $
88+
showString "fromList " . shows (toAscList m)
89+
90+
91+
#if __GLASGOW_HASKELL__ >= 711
92+
instance Semigroup (KeyMap v) where
93+
(KeyMap m1) <> (KeyMap m2) = KeyMap (m1 `H.union` m2)
94+
{-# INLINE (<>) #-}
95+
#endif
96+
instance Monoid (KeyMap v) where
97+
mempty = empty
98+
{-# INLINE mempty #-}
99+
#if __GLASGOW_HASKELL__ >= 711
100+
mappend = (<>)
101+
#else
102+
mappend (KeyMap m1) (KeyMap m2) = KeyMap (m1 `H.union` m2)
103+
#endif
104+
{-# INLINE mappend #-}
105+
106+
instance Hashable v => Hashable (KeyMap v) where
107+
hashWithSalt salt (KeyMap hm) = hashWithSalt salt hm
108+
109+
instance NFData v => NFData (KeyMap v) where
110+
rnf (KeyMap hm) = rnf hm
111+
112+
instance Foldable KeyMap where
113+
foldMap f (KeyMap tm) = H.foldMapWithKey (\ _k v -> f v) tm
114+
{-# INLINE foldMap #-}
115+
foldr f z (KeyMap tm) = H.foldr f z tm
116+
{-# INLINE foldr #-}
117+
foldl f z (KeyMap tm) = H.foldl f z tm
118+
{-# INLINE foldl #-}
119+
foldr' f z (KeyMap tm) = H.foldr' f z tm
120+
{-# INLINE foldr' #-}
121+
foldl' f z (KeyMap tm) = H.foldl' f z tm
122+
{-# INLINE foldl' #-}
123+
#if MIN_VERSION_base(4,8,0)
124+
null = H.null . unKeyMap
125+
{-# INLINE null #-}
126+
length = size
127+
{-# INLINE length #-}
128+
#endif
129+
130+
instance Traversable KeyMap where
131+
traverse f = traverseWithKey (const f)
132+
{-# INLINABLE traverse #-}
133+
134+
135+
instance TH.Lift v => TH.Lift (KeyMap v) where
136+
lift (KeyMap m) = [| KeyMap (H.fromList . map (first pack) $ m') |]
137+
where
138+
m' = map (first unpack) . H.toList $ m
139+
140+
#if MIN_VERSION_template_haskell(2,17,0)
141+
liftTyped = TH.unsafeCodeCoerce . TH.lift
142+
#elif MIN_VERSION_template_haskell(2,16,0)
143+
liftTyped = TH.unsafeTExpCoerce . TH.lift
144+
#endif
145+
146+
-- |
147+
-- Construct an empty map.
148+
empty :: KeyMap v
149+
empty = KeyMap H.empty
150+
151+
-- |
152+
-- Return the number of key-value mappings in this map.
153+
size :: KeyMap v -> Int
154+
size = H.size . unKeyMap
155+
156+
-- |
157+
-- Construct a map with a single element.
158+
singleton :: Text -> v -> KeyMap v
159+
singleton k v = KeyMap (H.singleton k v)
160+
161+
member :: Text -> KeyMap a -> Bool
162+
member t (KeyMap m) = H.member t m
163+
164+
-- | Return the value to which the specified key is mapped,
165+
-- or Nothing if this map contains no mapping for the key.
166+
lookup :: Text -> KeyMap v -> Maybe v
167+
lookup t tm = H.lookup t (unKeyMap tm)
168+
169+
-- | Associate the specified value with the specified key
170+
-- in this map. If this map previously contained a mapping
171+
-- for the key, the old value is replaced.
172+
insert :: Text -> v -> KeyMap v -> KeyMap v
173+
insert k v tm = KeyMap (H.insert k v (unKeyMap tm))
174+
175+
-- | Reduce this map by applying a binary operator to all
176+
-- elements, using the given starting value (typically the
177+
-- right-identity of the operator).
178+
foldrWithKey :: (Text -> v -> a -> a) -> a -> KeyMap v -> a
179+
foldrWithKey f a = H.foldrWithKey f a . unKeyMap
180+
181+
-- | Perform an Applicative action for each key-value pair
182+
-- in a 'KeyMap' and produce a 'KeyMap' of all the results.
183+
traverseWithKey :: Applicative f => (Text -> v1 -> f v2) -> KeyMap v1 -> f (KeyMap v2)
184+
traverseWithKey f = fmap KeyMap . H.traverseWithKey f . unKeyMap
185+
186+
-- | Construct a map from a list of elements. Uses the
187+
-- provided function, f, to merge duplicate entries with
188+
-- (f newVal oldVal).
189+
fromListWith :: (v -> v -> v) -> [(Text, v)] -> KeyMap v
190+
fromListWith op = KeyMap . H.fromListWith op
191+
192+
-- | Construct a map with the supplied mappings. If the
193+
-- list contains duplicate mappings, the later mappings take
194+
-- precedence.
195+
fromList :: [(Text, v)] -> KeyMap v
196+
fromList = KeyMap . H.fromList
197+
198+
-- | Return a list of this map's elements.
199+
toList :: KeyMap v -> [(Text, v)]
200+
toList = H.toList . unKeyMap
201+
202+
-- | Return a list of this map's elements in ascending order
203+
-- based of the textual key.
204+
toAscList :: KeyMap v -> [(Text, v)]
205+
toAscList = sortBy (comparing fst) . toList
206+
207+
-- | Difference of two maps. Return elements of the first
208+
-- map not existing in the second.
209+
difference :: KeyMap v -> KeyMap v' -> KeyMap v
210+
difference tm1 tm2 = KeyMap (H.difference (unKeyMap tm1) (unKeyMap tm2))
211+
212+
-- | Return a list of this map's keys.
213+
keys :: KeyMap v -> [Text]
214+
keys = H.keys . unKeyMap
215+
216+
-- | Convert a 'KeyMap' to a 'HashMap'.
217+
toHashMap :: KeyMap v -> HashMap Text v
218+
toHashMap = unKeyMap
219+
220+
-- | Convert a 'HashMap' to a 'KeyMap'.
221+
fromHashMap :: HashMap Text v -> KeyMap v
222+
fromHashMap = KeyMap
223+
224+
-- | Transform the keys and values of a 'KeyMap'.
225+
mapKeyVal :: (Text -> Text) -> (v1 -> v2)
226+
-> KeyMap v1 -> KeyMap v2
227+
mapKeyVal fk kv = foldrWithKey (\k v -> insert (fk k) (kv v)) empty
228+
{-# INLINE mapKeyVal #-}
229+
230+
#endif

0 commit comments

Comments
 (0)