diff --git a/src/Data/StrMap.purs b/src/Data/StrMap.purs index 78d35973..3b57a4a7 100644 --- a/src/Data/StrMap.purs +++ b/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: diff --git a/test/Test/Data/StrMap.purs b/test/Test/Data/StrMap.purs index 54cf3901..ae4ba00d 100644 --- a/test/Test/Data/StrMap.purs +++ b/test/Test/Data/StrMap.purs @@ -6,8 +6,10 @@ 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 @@ -15,8 +17,9 @@ 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