Merge pull request #96 from joshuahhh/master

Faster & simpler traverse for StrMap

Author: hdgarrood

src/Data/StrMap.purs

@@ -13,6 +13,7 @@ module Data.StrMap
   , insert
   , lookup
   , toUnfoldable
+  , toAscUnfoldable
   , fromFoldable
   , fromFoldableWith
   , delete
@@ -50,7 +51,7 @@ import Data.Maybe (Maybe(..), maybe, fromMaybe)
 import Data.Monoid (class Monoid, mempty)
 import Data.StrMap.ST as SM
 import Data.Traversable (class Traversable, traverse)
-import Data.Tuple (Tuple(..), uncurry)
+import Data.Tuple (Tuple(..), fst)
 import Data.Unfoldable (class Unfoldable)
 
 -- | `StrMap a` represents a map from `String`s to values of type `a`.
@@ -108,7 +109,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 <$> toArray ms))
+  traverse f ms = fold (\acc k v -> insert k <$> f v <*> acc) (pure empty) ms
   sequence = traverse id
 
 -- Unfortunately the above are not short-circuitable (consider using purescript-machines)
@@ -132,6 +133,13 @@ instance eqStrMap :: Eq a => Eq (StrMap a) where
 instance eq1StrMap :: Eq1 StrMap where
   eq1 = eq
 
+-- Internal use
+toAscArray :: forall v. StrMap v -> Array (Tuple String v)
+toAscArray = toAscUnfoldable
+
+instance ordStrMap :: Ord a => Ord (StrMap a) where
+  compare m1 m2 = compare (toAscArray m1) (toAscArray m2)
+
 instance showStrMap :: Show a => Show (StrMap a) where
   show m = "(fromFoldable " <> show (toArray m) <> ")"
 
@@ -215,6 +223,11 @@ foreign import _collect :: forall a b . (String -> a -> b) -> StrMap a -> Array
 toUnfoldable :: forall f a. Unfoldable f => StrMap a -> f (Tuple String a)
 toUnfoldable = A.toUnfoldable <<< _collect Tuple
 
+-- | Unfolds a map into a list of key/value pairs which is guaranteed to be
+-- | sorted by key
+toAscUnfoldable :: forall f a. Unfoldable f => StrMap a -> f (Tuple String a)
+toAscUnfoldable = A.toUnfoldable <<< A.sortWith fst <<< _collect Tuple
+
 -- Internal
 toArray :: forall a. StrMap a -> Array (Tuple String a)
 toArray = _collect Tuple

test/Test/Data/StrMap.purs

@@ -16,6 +16,7 @@ import Data.Maybe (Maybe(..))
 import Data.NonEmpty ((:|))
 import Data.StrMap as M
 import Data.Tuple (Tuple(..), fst)
+import Data.Traversable (sequence)
 
 import Partial.Unsafe (unsafePartial)
 
@@ -28,6 +29,11 @@ newtype TestStrMap v = TestStrMap (M.StrMap v)
 instance arbTestStrMap :: (Arbitrary v) => Arbitrary (TestStrMap v) where
   arbitrary = TestStrMap <<< (M.fromFoldable :: L.List (Tuple String v) -> M.StrMap v) <$> arbitrary
 
+newtype SmallArray v = SmallArray (Array v)
+
+instance arbSmallArray :: (Arbitrary v) => Arbitrary (SmallArray v) where
+  arbitrary = SmallArray <$> Gen.resize 3 arbitrary
+
 data Instruction k v = Insert k v | Delete k
 
 instance showInstruction :: (Show k, Show v) => Show (Instruction k v) where
@@ -54,6 +60,9 @@ runInstructions instrs t0 = foldl step t0 instrs
 number :: Int -> Int
 number n = n
 
+toAscArray :: forall a. M.StrMap a -> Array (Tuple String a)
+toAscArray = M.toAscUnfoldable
+
 strMapTests :: forall eff. Eff (console :: CONSOLE, random :: RANDOM, exception :: EXCEPTION | eff) Unit
 strMapTests = do
   log "Test inserting into empty tree"
@@ -167,6 +176,19 @@ strMapTests = do
     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 "sequence works (for m = Array)"
+  quickCheck \(TestStrMap mOfSmallArrays :: TestStrMap (SmallArray Int)) ->
+    let m                 = (\(SmallArray a) -> a) <$> mOfSmallArrays
+        Tuple keys values = A.unzip (toAscArray m)
+        resultViaArrays   = (M.fromFoldable <<< A.zip keys) <$> sequence values
+    in  A.sort (sequence m) === A.sort (resultViaArrays)
+
+  log "sequence works (for m = Maybe)"
+  quickCheck \(TestStrMap m :: TestStrMap (Maybe Int)) ->
+    let Tuple keys values = A.unzip (toAscArray m)
+        resultViaArrays   = (M.fromFoldable <<< A.zip keys) <$> sequence values
+    in  sequence m === resultViaArrays
+
   log "Bug #63: accidental observable mutation in foldMap"
   quickCheck \(TestStrMap m) ->
     let lhs = go m