Merge pull request #116 from Rufflewind/master

Add *WithIndex instances for StrMap

Author: hdgarrood

src/Data/StrMap.purs

@@ -50,12 +50,15 @@ 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.FoldableWithIndex (class FoldableWithIndex)
 import Data.Function.Uncurried (Fn2, runFn2, Fn4, runFn4)
+import Data.FunctorWithIndex (class FunctorWithIndex)
 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(..), fst)
+import Data.TraversableWithIndex (class TraversableWithIndex, traverseWithIndex)
+import Data.Tuple (Tuple(..), fst, uncurry)
 import Data.Unfoldable (class Unfoldable)
 
 -- | `StrMap a` represents a map from `String`s to values of type `a`.
@@ -91,6 +94,9 @@ foreign import _fmapStrMap :: forall a b. Fn2 (StrMap a) (a -> b) (StrMap b)
 instance functorStrMap :: Functor StrMap where
   map f m = runFn2 _fmapStrMap m f
 
+instance functorWithIndexStrMap :: FunctorWithIndex String StrMap where
+  mapWithIndex = mapWithKey
+
 foreign import _foldM :: forall a m z. (m -> (z -> m) -> m) -> (z -> String -> a -> m) -> m -> StrMap a -> m
 
 -- | Fold the keys and values of a map
@@ -112,10 +118,19 @@ instance foldableStrMap :: Foldable StrMap where
   foldr f z m = foldr f z (values m)
   foldMap f = foldMap (const f)
 
+instance foldableWithIndexStrMap :: FoldableWithIndex String StrMap where
+  foldlWithIndex f = fold (flip f)
+  foldrWithIndex f z m = foldr (uncurry f) z (toArrayWithKey Tuple m)
+  foldMapWithIndex = foldMap
+
 instance traversableStrMap :: Traversable StrMap where
-  traverse f ms = fold (\acc k v -> insert k <$> f v <*> acc) (pure empty) ms
+  traverse = traverseWithIndex <<< const
   sequence = traverse id
 
+instance traversableWithIndexStrMap :: TraversableWithIndex String StrMap where
+  traverseWithIndex f ms =
+    fold (\acc k v -> flip (insert k) <$> acc <*> f k v) (pure empty) ms
+
 -- Unfortunately the above are not short-circuitable (consider using purescript-machines)
 -- so we need special cases:
 

test/Test/Data/StrMap.purs

@@ -6,17 +6,20 @@ import Control.Monad.Eff (Eff)
 import Control.Monad.Eff.Console (log, CONSOLE)
 import Control.Monad.Eff.Exception (EXCEPTION)
 import Control.Monad.Eff.Random (RANDOM)
+import Control.Monad.Writer (runWriter, tell)
 import Data.Array as A
-import Data.Foldable (foldl)
+import Data.Foldable (foldl, foldr)
+import Data.FoldableWithIndex (foldlWithIndex, foldrWithIndex, foldMapWithIndex)
 import Data.Function (on)
 import Data.List as L
 import Data.List.NonEmpty as NEL
 import Data.Maybe (Maybe(..))
 import Data.NonEmpty ((:|))
 import Data.StrMap as M
 import Data.StrMap.Gen (genStrMap)
-import Data.Traversable (sequence)
-import Data.Tuple (Tuple(..), fst, uncurry)
+import Data.Traversable (sequence, traverse)
+import Data.TraversableWithIndex (traverseWithIndex)
+import Data.Tuple (Tuple(..), fst, snd, uncurry)
 import Partial.Unsafe (unsafePartial)
 import Test.QuickCheck ((<?>), quickCheck, quickCheck', (===))
 import Test.QuickCheck.Arbitrary (class Arbitrary, arbitrary)
@@ -198,6 +201,34 @@ 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 "foldl = foldlWithIndex <<< const"
+  quickCheck \(TestStrMap m :: TestStrMap String) ->
+    let f z v = z <> "," <> v
+    in foldl f "" m === foldlWithIndex (const f) "" m
+
+  log "foldr = foldrWithIndex <<< const"
+  quickCheck \(TestStrMap m :: TestStrMap String) ->
+    let f v z = v <> "," <> z
+    in foldr f "" m === foldrWithIndex (const f) "" m
+
+  log "foldlWithIndex = foldrWithIndex with flipped operation"
+  quickCheck \(TestStrMap m :: TestStrMap String) ->
+    let f k z v = z <> "," <> k <> ":" <> v
+        g k v z = k <> ":" <> v <> "," <> z
+    in foldlWithIndex f "" m <> "," === "," <> foldrWithIndex g "" m
+
+  log "foldMapWithIndex f ~ traverseWithIndex (\\k v -> tell (f k v))"
+  quickCheck \(TestStrMap m :: TestStrMap Int) ->
+    let f k v = "(" <> "k" <> "," <> show v <> ")"
+        resultA = foldMapWithIndex f m
+        resultB = snd (runWriter (traverseWithIndex (\k v -> tell (f k v)) m))
+    in resultA === resultB
+
+  log "traverse = traverseWithIndex <<< const (for m = Writer)"
+  quickCheck \(TestStrMap m :: TestStrMap String) ->
+    runWriter (traverse tell m) ===
+    runWriter (traverseWithIndex (const tell) m)
+
   log "sequence works (for m = Array)"
   quickCheck \(TestStrMap mOfSmallArrays :: TestStrMap (SmallArray Int)) ->
     let m                 = (\(SmallArray a) -> a) <$> mOfSmallArrays