Skip to content
This repository was archived by the owner on Oct 4, 2020. It is now read-only.

Commit c1a826b

Browse files
authored
Merge pull request #93 from purescript/misc-updates
Misc updates
2 parents 9d74e45 + 73c2289 commit c1a826b

File tree

5 files changed

+47
-36
lines changed

5 files changed

+47
-36
lines changed

src/Data/Map.purs

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -35,10 +35,12 @@ module Data.Map
3535
) where
3636

3737
import Prelude
38+
import Data.Eq (class Eq1)
3839
import Data.Foldable (foldl, foldMap, foldr, class Foldable)
3940
import Data.List (List(..), (:), length, nub)
4041
import Data.Maybe (Maybe(..), maybe, isJust, fromMaybe)
4142
import Data.Monoid (class Monoid)
43+
import Data.Ord (class Ord1)
4244
import Data.Traversable (traverse, class Traversable)
4345
import Data.Tuple (Tuple(Tuple), snd)
4446
import Data.Unfoldable (class Unfoldable, unfoldr)
@@ -54,9 +56,15 @@ data Map k v
5456
toAscArray :: forall k v. Map k v -> Array (Tuple k v)
5557
toAscArray = toAscUnfoldable
5658

59+
instance eq1Map :: Eq k => Eq1 (Map k) where
60+
eq1 = eq
61+
5762
instance eqMap :: (Eq k, Eq v) => Eq (Map k v) where
5863
eq m1 m2 = toAscArray m1 == toAscArray m2
5964

65+
instance ord1Map :: Ord k => Ord1 (Map k) where
66+
compare1 = compare
67+
6068
instance ordMap :: (Ord k, Ord v) => Ord (Map k v) where
6169
compare m1 m2 = compare (toAscArray m1) (toAscArray m2)
6270

src/Data/StrMap.purs

Lines changed: 17 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -12,7 +12,6 @@ module Data.StrMap
1212
, singleton
1313
, insert
1414
, lookup
15-
, toList
1615
, toUnfoldable
1716
, fromFoldable
1817
, fromFoldableWith
@@ -43,9 +42,10 @@ import Prelude
4342
import Control.Monad.Eff (Eff, runPure)
4443
import Control.Monad.ST as ST
4544

45+
import Data.Array as A
46+
import Data.Eq (class Eq1)
4647
import Data.Foldable (class Foldable, foldl, foldr, for_)
4748
import Data.Function.Uncurried (Fn2, runFn2, Fn4, runFn4)
48-
import Data.List as L
4949
import Data.Maybe (Maybe(..), maybe, fromMaybe)
5050
import Data.Monoid (class Monoid, mempty)
5151
import Data.StrMap.ST as SM
@@ -108,7 +108,7 @@ instance foldableStrMap :: Foldable StrMap where
108108
foldMap f = foldMap (const f)
109109

110110
instance traversableStrMap :: Traversable StrMap where
111-
traverse f ms = foldr (\x acc -> union <$> x <*> acc) (pure empty) ((map (uncurry singleton)) <$> (traverse f <$> toList ms))
111+
traverse f ms = foldr (\x acc -> union <$> x <*> acc) (pure empty) ((map (uncurry singleton)) <$> (traverse f <$> toArray ms))
112112
sequence = traverse id
113113

114114
-- Unfortunately the above are not short-circuitable (consider using purescript-machines)
@@ -126,11 +126,14 @@ foldMaybe f z m = runFn4 _foldSCStrMap m z f fromMaybe
126126
-- | Test whether all key/value pairs in a `StrMap` satisfy a predicate.
127127
foreign import all :: forall a. (String -> a -> Boolean) -> StrMap a -> Boolean
128128

129-
instance eqStrMap :: (Eq a) => Eq (StrMap a) where
129+
instance eqStrMap :: Eq a => Eq (StrMap a) where
130130
eq m1 m2 = (isSubmap m1 m2) && (isSubmap m2 m1)
131131

132-
instance showStrMap :: (Show a) => Show (StrMap a) where
133-
show m = "fromList " <> show (toList m)
132+
instance eq1StrMap :: Eq1 StrMap where
133+
eq1 = eq
134+
135+
instance showStrMap :: Show a => Show (StrMap a) where
136+
show m = "(fromFoldable " <> show (toArray m) <> ")"
134137

135138
-- | An empty map
136139
foreign import empty :: forall a. StrMap a
@@ -208,19 +211,20 @@ fromFoldableWith f l = pureST (do
208211

209212
foreign import _collect :: forall a b . (String -> a -> b) -> StrMap a -> Array b
210213

211-
-- | Convert a map into a list of key/value pairs
212-
toList :: forall a. StrMap a -> L.List (Tuple String a)
213-
toList = L.fromFoldable <<< _collect Tuple
214-
214+
-- | Unfolds a map into a list of key/value pairs
215215
toUnfoldable :: forall f a. Unfoldable f => StrMap a -> f (Tuple String a)
216-
toUnfoldable = L.toUnfoldable <<< toList
216+
toUnfoldable = A.toUnfoldable <<< _collect Tuple
217+
218+
-- Internal
219+
toArray :: forall a. StrMap a -> Array (Tuple String a)
220+
toArray = _collect Tuple
217221

218222
-- | Get an array of the keys in a map
219223
foreign import keys :: forall a. StrMap a -> Array String
220224

221225
-- | Get a list of the values in a map
222-
values :: forall a. StrMap a -> L.List a
223-
values = L.fromFoldable <<< _collect (\_ v -> v)
226+
values :: forall a. StrMap a -> Array a
227+
values = _collect (\_ v -> v)
224228

225229
-- | Compute the union of two maps, preferring the first map in the case of
226230
-- | duplicate keys.

src/Data/StrMap/ST/Unsafe.js

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
"use strict";
22

3-
exports.unsafeGet = function (m) {
3+
exports.unsafeFreeze = function (m) {
44
return function () {
55
return m;
66
};

src/Data/StrMap/ST/Unsafe.purs

Lines changed: 2 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,4 @@
1-
module Data.StrMap.ST.Unsafe
2-
( unsafeGet
3-
) where
1+
module Data.StrMap.ST.Unsafe where
42

53
import Control.Monad.Eff (Eff)
64
import Control.Monad.ST (ST)
@@ -10,4 +8,4 @@ import Data.StrMap.ST (STStrMap)
108
-- | Unsafely get the map out of ST without copying it
119
-- |
1210
-- | If you later change the ST version of the map the pure value will also change.
13-
foreign import unsafeGet :: forall a h r. STStrMap h a -> Eff (st :: ST h | r) (StrMap a)
11+
foreign import unsafeFreeze :: forall a h r. STStrMap h a -> Eff (st :: ST h | r) (StrMap a)

test/Test/Data/StrMap.purs

Lines changed: 19 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -7,12 +7,13 @@ import Control.Monad.Eff.Console (log, CONSOLE)
77
import Control.Monad.Eff.Exception (EXCEPTION)
88
import Control.Monad.Eff.Random (RANDOM)
99

10+
import Data.Array as A
1011
import Data.Foldable (foldl)
1112
import Data.Function (on)
12-
import Data.List (List(..), groupBy, sortBy, singleton, fromFoldable, zipWith)
13+
import Data.List as L
1314
import Data.List.NonEmpty as NEL
14-
import Data.NonEmpty ((:|))
1515
import Data.Maybe (Maybe(..))
16+
import Data.NonEmpty ((:|))
1617
import Data.StrMap as M
1718
import Data.Tuple (Tuple(..), fst)
1819

@@ -25,7 +26,7 @@ import Test.QuickCheck.Gen as Gen
2526
newtype TestStrMap v = TestStrMap (M.StrMap v)
2627

2728
instance arbTestStrMap :: (Arbitrary v) => Arbitrary (TestStrMap v) where
28-
arbitrary = TestStrMap <<< (M.fromFoldable :: List (Tuple String v) -> M.StrMap v) <$> arbitrary
29+
arbitrary = TestStrMap <<< (M.fromFoldable :: L.List (Tuple String v) -> M.StrMap v) <$> arbitrary
2930

3031
data Instruction k v = Insert k v | Delete k
3132

@@ -36,15 +37,15 @@ instance showInstruction :: (Show k, Show v) => Show (Instruction k v) where
3637
instance arbInstruction :: (Arbitrary v) => Arbitrary (Instruction String v) where
3738
arbitrary = do
3839
b <- arbitrary
39-
k <- Gen.frequency $ Tuple 10.0 (pure "hasOwnProperty") :| Tuple 50.0 arbitrary `Cons` Nil
40+
k <- Gen.frequency $ Tuple 10.0 (pure "hasOwnProperty") :| pure (Tuple 50.0 arbitrary)
4041
case b of
4142
true -> do
4243
v <- arbitrary
4344
pure (Insert k v)
4445
false -> do
4546
pure (Delete k)
4647

47-
runInstructions :: forall v. List (Instruction String v) -> M.StrMap v -> M.StrMap v
48+
runInstructions :: forall v. L.List (Instruction String v) -> M.StrMap v -> M.StrMap v
4849
runInstructions instrs t0 = foldl step t0 instrs
4950
where
5051
step tree (Insert k v) = M.insert k v tree
@@ -101,7 +102,7 @@ strMapTests = do
101102
in M.lookup k tree == Just v <?> ("instrs:\n " <> show instrs <> "\nk:\n " <> show k <> "\nv:\n " <> show v)
102103

103104
log "Singleton to list"
104-
quickCheck $ \k v -> M.toList (M.singleton k v :: M.StrMap Int) == singleton (Tuple k v)
105+
quickCheck $ \k v -> M.toUnfoldable (M.singleton k v :: M.StrMap Int) == L.singleton (Tuple k v)
105106

106107
log "fromFoldable [] = empty"
107108
quickCheck (M.fromFoldable [] == (M.empty :: M.StrMap Unit)
@@ -125,26 +126,26 @@ strMapTests = do
125126
quickCheck (M.lookup "1" nums == Just 2 <?> "invalid lookup - 1")
126127
quickCheck (M.lookup "2" nums == Nothing <?> "invalid lookup - 2")
127128

128-
log "toList . fromFoldable = id"
129-
quickCheck $ \arr -> let f x = M.toList (M.fromFoldable x)
130-
in f (f arr) == f (arr :: List (Tuple String Int)) <?> show arr
129+
log "toUnfoldable . fromFoldable = id"
130+
quickCheck $ \arr -> let f x = M.toUnfoldable (M.fromFoldable x)
131+
in f (f arr) == f (arr :: L.List (Tuple String Int)) <?> show arr
131132

132-
log "fromFoldable . toList = id"
133+
log "fromFoldable . toUnfoldable = id"
133134
quickCheck $ \(TestStrMap m) ->
134-
let f m1 = M.fromFoldable (M.toList m1) in
135-
M.toList (f m) == M.toList (m :: M.StrMap Int) <?> show m
135+
let f m1 = M.fromFoldable ((M.toUnfoldable m1) :: L.List (Tuple String Int)) in
136+
M.toUnfoldable (f m) == (M.toUnfoldable m :: L.List (Tuple String Int)) <?> show m
136137

137138
log "fromFoldableWith const = fromFoldable"
138139
quickCheck $ \arr -> M.fromFoldableWith const arr ==
139-
M.fromFoldable (arr :: List (Tuple String Int)) <?> show arr
140+
M.fromFoldable (arr :: L.List (Tuple String Int)) <?> show arr
140141

141142
log "fromFoldableWith (<>) = fromFoldable . collapse with (<>) . group on fst"
142143
quickCheck $ \arr ->
143144
let combine (Tuple s a) (Tuple t b) = (Tuple s $ b <> a)
144-
foldl1 g = unsafePartial \(Cons x xs) -> foldl g x xs
145+
foldl1 g = unsafePartial \(L.Cons x xs) -> foldl g x xs
145146
f = M.fromFoldable <<< map (foldl1 combine <<< NEL.toList) <<<
146-
groupBy ((==) `on` fst) <<< sortBy (compare `on` fst) in
147-
M.fromFoldableWith (<>) arr == f (arr :: List (Tuple String String)) <?> show arr
147+
L.groupBy ((==) `on` fst) <<< L.sortBy (compare `on` fst) in
148+
M.fromFoldableWith (<>) arr == f (arr :: L.List (Tuple String String)) <?> show arr
148149

149150
log "Lookup from union"
150151
quickCheck $ \(TestStrMap m1) (TestStrMap m2) k ->
@@ -157,13 +158,13 @@ strMapTests = do
157158
(m1 `M.union` m2) == ((m1 `M.union` m2) `M.union` (m2 :: M.StrMap Int)) <?> (show (M.size (m1 `M.union` m2)) <> " != " <> show (M.size ((m1 `M.union` m2) `M.union` m2)))
158159

159160
log "fromFoldable = zip keys values"
160-
quickCheck $ \(TestStrMap m) -> M.toList m == zipWith Tuple (fromFoldable $ M.keys m) (M.values m :: List Int)
161+
quickCheck $ \(TestStrMap m) -> M.toUnfoldable m == A.zipWith Tuple (M.keys m) (M.values m :: Array Int)
161162

162163
log "mapWithKey is correct"
163164
quickCheck $ \(TestStrMap m :: TestStrMap Int) -> let
164165
f k v = k <> show v
165166
resultViaMapWithKey = m # M.mapWithKey f
166-
resultViaLists = m # M.toList # map (\(Tuple k v) → Tuple k (f k v)) # M.fromFoldable
167+
resultViaLists = m # M.toUnfoldable # map (\(Tuple k v) → Tuple k (f k v)) # (M.fromFoldable :: forall a. L.List (Tuple String a) -> M.StrMap a)
167168
in resultViaMapWithKey === resultViaLists
168169

169170
log "Bug #63: accidental observable mutation in foldMap"

0 commit comments

Comments
 (0)