From a4ebe6aed7b2849d14d0f236b5d783896baf2fdc Mon Sep 17 00:00:00 2001
From: Gary Burgess <gary.burgess@gmail.com>
Date: Thu, 30 Nov 2017 12:30:28 +0000
Subject: [PATCH] Add Functor/Foldable/TraversableWithIndex for Map (#126)

* Add Functor/Foldable/TraversableWithIndex for Map

* Don't use unicode
---
 bower.json        |  2 +-
 src/Data/Map.purs | 33 +++++++++++++++++++++++++++++++++
 2 files changed, 34 insertions(+), 1 deletion(-)

diff --git a/bower.json b/bower.json
index 9138d9d4..bbcda159 100644
--- a/bower.json
+++ b/bower.json
@@ -26,7 +26,7 @@
     "purescript-lists": "^4.0.0",
     "purescript-st": "^3.0.0",
     "purescript-gen": "^1.1.0",
-    "purescript-foldable-traversable": "^3.4.0"
+    "purescript-foldable-traversable": "^3.6.1"
   },
   "devDependencies": {
     "purescript-quickcheck": "^4.0.0",
diff --git a/src/Data/Map.purs b/src/Data/Map.purs
index 69cec393..e764370b 100644
--- a/src/Data/Map.purs
+++ b/src/Data/Map.purs
@@ -41,14 +41,18 @@ module Data.Map
   ) where
 
 import Prelude
+
 import Data.Eq (class Eq1)
 import Data.Foldable (foldl, foldMap, foldr, class Foldable)
+import Data.FoldableWithIndex (class FoldableWithIndex)
+import Data.FunctorWithIndex (class FunctorWithIndex, mapWithIndex)
 import Data.List (List(..), (:), length, nub)
 import Data.List.Lazy as LL
 import Data.Maybe (Maybe(..), maybe, isJust, fromMaybe)
 import Data.Monoid (class Monoid, mempty)
 import Data.Ord (class Ord1)
 import Data.Traversable (traverse, class Traversable)
+import Data.TraversableWithIndex (class TraversableWithIndex, traverseWithIndex)
 import Data.Tuple (Tuple(Tuple), snd, uncurry)
 import Data.Unfoldable (class Unfoldable, unfoldr)
 import Partial.Unsafe (unsafePartial)
@@ -89,11 +93,24 @@ instance functorMap :: Functor (Map k) where
   map f (Two left k v right) = Two (map f left) k (f v) (map f right)
   map f (Three left k1 v1 mid k2 v2 right) = Three (map f left) k1 (f v1) (map f mid) k2 (f v2) (map f right)
 
+instance functorWithIndexMap :: FunctorWithIndex k (Map k) where
+  mapWithIndex _ Leaf = Leaf
+  mapWithIndex f (Two left k v right) = Two (mapWithIndex f left) k (f k v) (mapWithIndex f right)
+  mapWithIndex f (Three left k1 v1 mid k2 v2 right) = Three (mapWithIndex f left) k1 (f k1 v1) (mapWithIndex f mid) k2 (f k2 v2) (mapWithIndex f right)
+
 instance foldableMap :: Foldable (Map k) where
   foldl   f z m = foldl   f z (values m)
   foldr   f z m = foldr   f z (values m)
   foldMap f   m = foldMap f   (values m)
 
+instance foldableWithIndexMap :: FoldableWithIndex k (Map k) where
+  foldlWithIndex f z m = foldl (uncurry <<< (flip f)) z $ asList $ toUnfoldable m
+  foldrWithIndex f z m = foldr (uncurry f) z $ asList $ toUnfoldable m
+  foldMapWithIndex f m = foldMap (uncurry f) $ asList $ toUnfoldable m
+
+asList :: forall k v. List (Tuple k v) -> List (Tuple k v)
+asList = id
+
 instance traversableMap :: Traversable (Map k) where
   traverse f Leaf = pure Leaf
   traverse f (Two left k v right) =
@@ -111,6 +128,22 @@ instance traversableMap :: Traversable (Map k) where
           <*> traverse f right
   sequence = traverse id
 
+instance traversableWithIndexMap :: TraversableWithIndex k (Map k) where
+  traverseWithIndex f Leaf = pure Leaf
+  traverseWithIndex f (Two left k v right) =
+    Two <$> traverseWithIndex f left
+        <*> pure k
+        <*> f k v
+        <*> traverseWithIndex f right
+  traverseWithIndex f (Three left k1 v1 mid k2 v2 right) =
+    Three <$> traverseWithIndex f left
+          <*> pure k1
+          <*> f k1 v1
+          <*> traverseWithIndex f mid
+          <*> pure k2
+          <*> f k2 v2
+          <*> traverseWithIndex f right
+
 -- | Render a `Map` as a `String`
 showTree :: forall k v. Show k => Show v => Map k v -> String
 showTree Leaf = "Leaf"