From b758c036d88fbeb7a994d0f891f6e6cdb38e86d1 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Mon, 27 Mar 2017 23:07:57 +0100 Subject: [PATCH 1/3] Add Eq1 and Ord1 instances --- src/Data/Map.purs | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/src/Data/Map.purs b/src/Data/Map.purs index 6c5bd9f1..abbbb179 100644 --- a/src/Data/Map.purs +++ b/src/Data/Map.purs @@ -35,10 +35,12 @@ module Data.Map ) where import Prelude +import Data.Eq (class Eq1) import Data.Foldable (foldl, foldMap, foldr, class Foldable) import Data.List (List(..), (:), length, nub) import Data.Maybe (Maybe(..), maybe, isJust, fromMaybe) import Data.Monoid (class Monoid) +import Data.Ord (class Ord1) import Data.Traversable (traverse, class Traversable) import Data.Tuple (Tuple(Tuple), snd) import Data.Unfoldable (class Unfoldable, unfoldr) @@ -54,9 +56,15 @@ data Map k v toAscArray :: forall k v. Map k v -> Array (Tuple k v) toAscArray = toAscUnfoldable +instance eq1Map :: Eq k => Eq1 (Map k) where + eq1 = eq + instance eqMap :: (Eq k, Eq v) => Eq (Map k v) where eq m1 m2 = toAscArray m1 == toAscArray m2 +instance ord1Map :: Ord k => Ord1 (Map k) where + compare1 = compare + instance ordMap :: (Ord k, Ord v) => Ord (Map k v) where compare m1 m2 = compare (toAscArray m1) (toAscArray m2) From 9c0cc7fcd177f770a7723c5535ab48d1cb851f53 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Mon, 27 Mar 2017 23:10:22 +0100 Subject: [PATCH 2/3] Add Eq1 instance, make array usage consistent, drop toList --- src/Data/StrMap.purs | 30 +++++++++++++++++------------- test/Test/Data/StrMap.purs | 37 +++++++++++++++++++------------------ 2 files changed, 36 insertions(+), 31 deletions(-) diff --git a/src/Data/StrMap.purs b/src/Data/StrMap.purs index 3ca1e59b..6186e273 100644 --- a/src/Data/StrMap.purs +++ b/src/Data/StrMap.purs @@ -12,7 +12,6 @@ module Data.StrMap , singleton , insert , lookup - , toList , toUnfoldable , fromFoldable , fromFoldableWith @@ -43,9 +42,10 @@ import Prelude import Control.Monad.Eff (Eff, runPure) import Control.Monad.ST as ST +import Data.Array as A +import Data.Eq (class Eq1) import Data.Foldable (class Foldable, foldl, foldr, for_) import Data.Function.Uncurried (Fn2, runFn2, Fn4, runFn4) -import Data.List as L import Data.Maybe (Maybe(..), maybe, fromMaybe) import Data.Monoid (class Monoid, mempty) import Data.StrMap.ST as SM @@ -108,7 +108,7 @@ instance foldableStrMap :: Foldable StrMap where foldMap f = foldMap (const f) instance traversableStrMap :: Traversable StrMap where - traverse f ms = foldr (\x acc -> union <$> x <*> acc) (pure empty) ((map (uncurry singleton)) <$> (traverse f <$> toList ms)) + traverse f ms = foldr (\x acc -> union <$> x <*> acc) (pure empty) ((map (uncurry singleton)) <$> (traverse f <$> toArray ms)) sequence = traverse id -- 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 -- | Test whether all key/value pairs in a `StrMap` satisfy a predicate. foreign import all :: forall a. (String -> a -> Boolean) -> StrMap a -> Boolean -instance eqStrMap :: (Eq a) => Eq (StrMap a) where +instance eqStrMap :: Eq a => Eq (StrMap a) where eq m1 m2 = (isSubmap m1 m2) && (isSubmap m2 m1) -instance showStrMap :: (Show a) => Show (StrMap a) where - show m = "fromList " <> show (toList m) +instance eq1StrMap :: Eq1 StrMap where + eq1 = eq + +instance showStrMap :: Show a => Show (StrMap a) where + show m = "(fromFoldable " <> show (toArray m) <> ")" -- | An empty map foreign import empty :: forall a. StrMap a @@ -208,19 +211,20 @@ fromFoldableWith f l = pureST (do foreign import _collect :: forall a b . (String -> a -> b) -> StrMap a -> Array b --- | Convert a map into a list of key/value pairs -toList :: forall a. StrMap a -> L.List (Tuple String a) -toList = L.fromFoldable <<< _collect Tuple - +-- | Unfolds a map into a list of key/value pairs toUnfoldable :: forall f a. Unfoldable f => StrMap a -> f (Tuple String a) -toUnfoldable = L.toUnfoldable <<< toList +toUnfoldable = A.toUnfoldable <<< _collect Tuple + +-- Internal +toArray :: forall a. StrMap a -> Array (Tuple String a) +toArray = _collect Tuple -- | Get an array of the keys in a map foreign import keys :: forall a. StrMap a -> Array String -- | Get a list of the values in a map -values :: forall a. StrMap a -> L.List a -values = L.fromFoldable <<< _collect (\_ v -> v) +values :: forall a. StrMap a -> Array a +values = _collect (\_ v -> v) -- | Compute the union of two maps, preferring the first map in the case of -- | duplicate keys. diff --git a/test/Test/Data/StrMap.purs b/test/Test/Data/StrMap.purs index be6c5709..37f7e462 100644 --- a/test/Test/Data/StrMap.purs +++ b/test/Test/Data/StrMap.purs @@ -7,12 +7,13 @@ import Control.Monad.Eff.Console (log, CONSOLE) import Control.Monad.Eff.Exception (EXCEPTION) import Control.Monad.Eff.Random (RANDOM) +import Data.Array as A import Data.Foldable (foldl) import Data.Function (on) -import Data.List (List(..), groupBy, sortBy, singleton, fromFoldable, zipWith) +import Data.List as L import Data.List.NonEmpty as NEL -import Data.NonEmpty ((:|)) import Data.Maybe (Maybe(..)) +import Data.NonEmpty ((:|)) import Data.StrMap as M import Data.Tuple (Tuple(..), fst) @@ -25,7 +26,7 @@ import Test.QuickCheck.Gen as Gen newtype TestStrMap v = TestStrMap (M.StrMap v) instance arbTestStrMap :: (Arbitrary v) => Arbitrary (TestStrMap v) where - arbitrary = TestStrMap <<< (M.fromFoldable :: List (Tuple String v) -> M.StrMap v) <$> arbitrary + arbitrary = TestStrMap <<< (M.fromFoldable :: L.List (Tuple String v) -> M.StrMap v) <$> arbitrary data Instruction k v = Insert k v | Delete k @@ -36,7 +37,7 @@ instance showInstruction :: (Show k, Show v) => Show (Instruction k v) where instance arbInstruction :: (Arbitrary v) => Arbitrary (Instruction String v) where arbitrary = do b <- arbitrary - k <- Gen.frequency $ Tuple 10.0 (pure "hasOwnProperty") :| Tuple 50.0 arbitrary `Cons` Nil + k <- Gen.frequency $ Tuple 10.0 (pure "hasOwnProperty") :| pure (Tuple 50.0 arbitrary) case b of true -> do v <- arbitrary @@ -44,7 +45,7 @@ instance arbInstruction :: (Arbitrary v) => Arbitrary (Instruction String v) whe false -> do pure (Delete k) -runInstructions :: forall v. List (Instruction String v) -> M.StrMap v -> M.StrMap v +runInstructions :: forall v. L.List (Instruction String v) -> M.StrMap v -> M.StrMap v runInstructions instrs t0 = foldl step t0 instrs where step tree (Insert k v) = M.insert k v tree @@ -101,7 +102,7 @@ strMapTests = do in M.lookup k tree == Just v ("instrs:\n " <> show instrs <> "\nk:\n " <> show k <> "\nv:\n " <> show v) log "Singleton to list" - quickCheck $ \k v -> M.toList (M.singleton k v :: M.StrMap Int) == singleton (Tuple k v) + quickCheck $ \k v -> M.toUnfoldable (M.singleton k v :: M.StrMap Int) == L.singleton (Tuple k v) log "fromFoldable [] = empty" quickCheck (M.fromFoldable [] == (M.empty :: M.StrMap Unit) @@ -125,26 +126,26 @@ strMapTests = do quickCheck (M.lookup "1" nums == Just 2 "invalid lookup - 1") quickCheck (M.lookup "2" nums == Nothing "invalid lookup - 2") - log "toList . fromFoldable = id" - quickCheck $ \arr -> let f x = M.toList (M.fromFoldable x) - in f (f arr) == f (arr :: List (Tuple String Int)) show arr + log "toUnfoldable . fromFoldable = id" + quickCheck $ \arr -> let f x = M.toUnfoldable (M.fromFoldable x) + in f (f arr) == f (arr :: L.List (Tuple String Int)) show arr - log "fromFoldable . toList = id" + log "fromFoldable . toUnfoldable = id" quickCheck $ \(TestStrMap m) -> - let f m1 = M.fromFoldable (M.toList m1) in - M.toList (f m) == M.toList (m :: M.StrMap Int) show m + let f m1 = M.fromFoldable ((M.toUnfoldable m1) :: L.List (Tuple String Int)) in + M.toUnfoldable (f m) == (M.toUnfoldable m :: L.List (Tuple String Int)) show m log "fromFoldableWith const = fromFoldable" quickCheck $ \arr -> M.fromFoldableWith const arr == - M.fromFoldable (arr :: List (Tuple String Int)) show arr + M.fromFoldable (arr :: L.List (Tuple String Int)) show arr log "fromFoldableWith (<>) = fromFoldable . collapse with (<>) . group on fst" quickCheck $ \arr -> let combine (Tuple s a) (Tuple t b) = (Tuple s $ b <> a) - foldl1 g = unsafePartial \(Cons x xs) -> foldl g x xs + foldl1 g = unsafePartial \(L.Cons x xs) -> foldl g x xs f = M.fromFoldable <<< map (foldl1 combine <<< NEL.toList) <<< - groupBy ((==) `on` fst) <<< sortBy (compare `on` fst) in - M.fromFoldableWith (<>) arr == f (arr :: List (Tuple String String)) show arr + L.groupBy ((==) `on` fst) <<< L.sortBy (compare `on` fst) in + M.fromFoldableWith (<>) arr == f (arr :: L.List (Tuple String String)) show arr log "Lookup from union" quickCheck $ \(TestStrMap m1) (TestStrMap m2) k -> @@ -157,13 +158,13 @@ strMapTests = do (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))) log "fromFoldable = zip keys values" - quickCheck $ \(TestStrMap m) -> M.toList m == zipWith Tuple (fromFoldable $ M.keys m) (M.values m :: List Int) + quickCheck $ \(TestStrMap m) -> M.toUnfoldable m == A.zipWith Tuple (M.keys m) (M.values m :: Array Int) log "mapWithKey is correct" quickCheck $ \(TestStrMap m :: TestStrMap Int) -> let f k v = k <> show v resultViaMapWithKey = m # M.mapWithKey f - resultViaLists = m # M.toList # map (\(Tuple k v) → Tuple k (f k v)) # M.fromFoldable + 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) in resultViaMapWithKey === resultViaLists log "Bug #63: accidental observable mutation in foldMap" From 73c2289335a5ca97f507a719b628d34b06c8269d Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Mon, 27 Mar 2017 23:13:35 +0100 Subject: [PATCH 3/3] Rename unsafeGet to unsafeFreeze --- src/Data/StrMap/ST/Unsafe.js | 2 +- src/Data/StrMap/ST/Unsafe.purs | 6 ++---- 2 files changed, 3 insertions(+), 5 deletions(-) diff --git a/src/Data/StrMap/ST/Unsafe.js b/src/Data/StrMap/ST/Unsafe.js index 58e388a2..83807658 100644 --- a/src/Data/StrMap/ST/Unsafe.js +++ b/src/Data/StrMap/ST/Unsafe.js @@ -1,6 +1,6 @@ "use strict"; -exports.unsafeGet = function (m) { +exports.unsafeFreeze = function (m) { return function () { return m; }; diff --git a/src/Data/StrMap/ST/Unsafe.purs b/src/Data/StrMap/ST/Unsafe.purs index 234f39f5..19c36d39 100644 --- a/src/Data/StrMap/ST/Unsafe.purs +++ b/src/Data/StrMap/ST/Unsafe.purs @@ -1,6 +1,4 @@ -module Data.StrMap.ST.Unsafe - ( unsafeGet - ) where +module Data.StrMap.ST.Unsafe where import Control.Monad.Eff (Eff) import Control.Monad.ST (ST) @@ -10,4 +8,4 @@ import Data.StrMap.ST (STStrMap) -- | Unsafely get the map out of ST without copying it -- | -- | If you later change the ST version of the map the pure value will also change. -foreign import unsafeGet :: forall a h r. STStrMap h a -> Eff (st :: ST h | r) (StrMap a) +foreign import unsafeFreeze :: forall a h r. STStrMap h a -> Eff (st :: ST h | r) (StrMap a)