Merge pull request #93 from purescript/misc-updates

Misc updates

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)
 

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.

src/Data/StrMap/ST/Unsafe.js

@@ -1,6 +1,6 @@
 "use strict";
 
-exports.unsafeGet = function (m) {
+exports.unsafeFreeze = function (m) {
   return function () {
     return m;
   };

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)

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,15 +37,15 @@ 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
         pure (Insert k v)
       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"