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