1+ --
2+ -- Native Javascript maps which require the keys to be strings.
3+ -- To maximize performance, Javascript objects are not wrapped,
4+ -- and some native code is used even when it's not necessary.
5+ --
6+
7+ module Data.StrMap
8+ ( StrMap (),
9+ empty ,
10+ isEmpty ,
11+ singleton ,
12+ insert ,
13+ lookup ,
14+ toList ,
15+ fromList ,
16+ delete ,
17+ member ,
18+ alter ,
19+ update ,
20+ keys ,
21+ values ,
22+ union ,
23+ unions ,
24+ map ,
25+ isSubmap ,
26+ fold ,
27+ foldMaybe
28+ ) where
29+
30+ import qualified Prelude as P
31+
32+ import qualified Data.Array as A
33+ import Data.Maybe
34+ import Data.Function
35+ import Data.Tuple
36+ import Data.Foldable (foldl )
37+
38+ foreign import data StrMap :: * -> *
39+
40+ foreign import _foldStrMap
41+ " function _foldStrMap(m, z0, f) {\
42+ \ var z = z0;\
43+ \ for (var k in m) {\
44+ \ if (m.hasOwnProperty(k)) z = f(z)(k)(m[k]);\
45+ \ }\
46+ \ return z;\
47+ \}" :: forall v z . Fn3 (StrMap v ) z (z -> String -> v -> z ) z
48+
49+ fold :: forall a z . (z -> String -> a -> z ) -> z -> (StrMap a ) -> z
50+ fold f z m = runFn3 _foldStrMap m z f
51+
52+ foreign import _fmapStrMap
53+ " function _fmapStrMap(m0, f) {\
54+ \ var m = {};\
55+ \ for (var k in m0) {\
56+ \ if (m0.hasOwnProperty(k)) m[k] = f(m0[k]);\
57+ \ }\
58+ \ return m;\
59+ \}" :: forall a b . Fn2 (StrMap a ) (a -> b ) (StrMap b )
60+
61+ instance functorStrMap :: P.Functor StrMap where
62+ (<$>) f m = runFn2 _fmapStrMap m f
63+
64+ foreign import _foldSCStrMap
65+ " function _foldSCStrMap(m, z0, f, fromMaybe) { \
66+ \ var z = z0; \
67+ \ for (var k in m) { \
68+ \ if (m.hasOwnProperty(k)) { \
69+ \ var maybeR = f(z)(k)(m[k]); \
70+ \ var r = fromMaybe(null)(maybeR); \
71+ \ if (r === null) return z; \
72+ \ else z = r; \
73+ \ } \
74+ \ } \
75+ \ return z; \
76+ \}" :: forall a z . Fn4 (StrMap a ) z (z -> String -> a -> Maybe z ) (forall a . a -> Maybe a -> a ) z
77+
78+ foldMaybe :: forall a z . (z -> String -> a -> Maybe z ) -> z -> (StrMap a ) -> z
79+ foldMaybe f z m = runFn4 _foldSCStrMap m z f fromMaybe
80+
81+ instance eqStrMap :: (P.Eq a ) => P.Eq (StrMap a ) where
82+ (==) m1 m2 = (isSubmap m1 m2) P .&& (isSubmap m2 m1)
83+ (/=) m1 m2 = P .not (m1 P .== m2)
84+
85+ instance showStrMap :: (P.Show a ) => P.Show (StrMap a ) where
86+ show m = " fromList " P .++ P .show (toList m)
87+
88+ foreign import empty " var empty = {};" :: forall a . StrMap a
89+
90+ isSubmap :: forall a . (P.Eq a ) => StrMap a -> StrMap a -> Boolean
91+ isSubmap m1 m2 = foldMaybe f true m1 where
92+ f acc k v = if (P .not acc) then (Nothing :: Maybe Boolean )
93+ else Just P .$ acc P .&& (maybe false (\v0 -> v0 P .== v) (lookup k m2))
94+
95+ isEmpty :: forall a . StrMap a -> Boolean
96+ isEmpty m = size m P .== 0
97+
98+ foreign import size " function size(m) {\
99+ \ var s = 0;\
100+ \ for (var k in m) {\
101+ \ if (m.hasOwnProperty(k)) ++s;\
102+ \ }\
103+ \ return s;\
104+ \}" :: forall a . StrMap a -> Number
105+
106+ singleton :: forall a . String -> a -> StrMap a
107+ singleton k v = insert k v empty
108+
109+ foreign import _lookup
110+ " function _lookup(m, k, yes, no) { \
111+ \ if (m[k] !== undefined) return yes(m[k]); \
112+ \ else return no; \
113+ \}" :: forall a z . Fn4 (StrMap a ) String (a -> z ) z z
114+
115+ lookup :: forall a . String -> StrMap a -> Maybe a
116+ lookup k m = runFn4 _lookup m k Just Nothing
117+
118+ member :: forall a . String -> StrMap a -> Boolean
119+ member k m = isJust (k `lookup` m)
120+
121+ foreign import _cloneStrMap
122+ " function _cloneStrMap(m0) { \
123+ \ var m = {}; \
124+ \ for (var k in m0) {\
125+ \ if (m0.hasOwnProperty(k)) m[k] = m0[k];\
126+ \ }\
127+ \ return m;\
128+ \}" :: forall a . (StrMap a ) -> (StrMap a )
129+
130+ foreign import _unsafeInsertStrMap
131+ " function _unsafeInsertStrMap(m, k, v) { \
132+ \ m[k] = v; \
133+ \ return m; \
134+ \}" :: forall a . Fn3 (StrMap a ) String a (StrMap a )
135+
136+ insert :: forall a . String -> a -> StrMap a -> StrMap a
137+ insert k v m = runFn3 _unsafeInsertStrMap (_cloneStrMap m) k v
138+
139+ foreign import _unsafeDeleteStrMap
140+ " function _unsafeDeleteStrMap(m, k) { \
141+ \ delete m[k]; \
142+ \ return m; \
143+ \}" :: forall a . Fn2 (StrMap a ) String (StrMap a )
144+
145+ delete :: forall a . String -> StrMap a -> StrMap a
146+ delete k m = runFn2 _unsafeDeleteStrMap (_cloneStrMap m) k
147+
148+ alter :: forall a . (Maybe a -> Maybe a ) -> String -> StrMap a -> StrMap a
149+ alter f k m = case f (k `lookup` m) of
150+ Nothing -> delete k m
151+ Just v -> insert k v m
152+
153+ update :: forall a . (a -> Maybe a ) -> String -> StrMap a -> StrMap a
154+ update f k m = alter (maybe Nothing f) k m
155+
156+ toList :: forall a . StrMap a -> [Tuple String a ]
157+ toList m = fold f [] m where
158+ f acc k v = acc P .++ [Tuple k v]
159+
160+ fromList :: forall a . [Tuple String a ] -> StrMap a
161+ fromList = foldl (\m (Tuple k v) -> insert k v m) empty
162+
163+ keys :: forall a . StrMap a -> [String ]
164+ keys m = fold f [] m where
165+ f acc k v = acc P .++ [k]
166+
167+ values :: forall a . StrMap a -> [a ]
168+ values m = fold f [] m where
169+ f acc k v = acc P .++ [v]
170+
171+ union :: forall a . StrMap a -> StrMap a -> StrMap a
172+ union m1 m2 = foldl (\m (Tuple k v) -> insert k v m) m2 (toList m1)
173+
174+ unions :: forall a . [StrMap a ] -> StrMap a
175+ unions = foldl union empty
176+
177+ map :: forall a b . (a -> b ) -> StrMap a -> StrMap b
178+ map = P .(<$>)
0 commit comments