feat: add Data.Semigroup.FoldableWithIndex and Data.Semigroup.TraversableWithIndex

src/Data/Semigroup/Foldable.purs

@@ -28,6 +28,7 @@ import Data.Monoid.Multiplicative (Multiplicative(..))
 import Data.Newtype (ala, alaF)
 import Data.Ord.Max (Max(..))
 import Data.Ord.Min (Min(..))
+import Data.Semigroup.Foldable.Internal (Act(..), JoinWith(..), getAct, joinee)
 import Data.Tuple (Tuple(..))
 
 -- | `Foldable1` represents data structures with a minimum of one element that can be _folded_.
@@ -103,15 +104,6 @@ instance foldableIdentity :: Foldable1 Identity where
 fold1 :: forall t m. Foldable1 t => Semigroup m => t m -> m
 fold1 = foldMap1 identity
 
-newtype Act :: forall k. (k -> Type) -> k -> Type
-newtype Act f a = Act (f a)
-
-getAct :: forall f a. Act f a -> f a
-getAct (Act f) = f
-
-instance semigroupAct :: Apply f => Semigroup (Act f a) where
-  append (Act a) (Act b) = Act (a *> b)
-
 -- | Traverse a data structure, performing some effects encoded by an
 -- | `Apply` instance at each value, ignoring the final result.
 traverse1_ :: forall t f a b. Foldable1 t => Apply f => (a -> f b) -> t a -> f Unit
@@ -141,15 +133,6 @@ minimum = ala Min foldMap1
 minimumBy :: forall f a. Foldable1 f => (a -> a -> Ordering) -> f a -> a
 minimumBy cmp = foldl1 \x y -> if cmp x y == LT then x else y
 
--- | Internal. Used by intercalation functions.
-newtype JoinWith a = JoinWith (a -> a)
-
-joinee :: forall a. JoinWith a -> a -> a
-joinee (JoinWith x) = x
-
-instance semigroupJoinWith :: Semigroup a => Semigroup (JoinWith a) where
-  append (JoinWith a) (JoinWith b) = JoinWith $ \j -> a j <> j <> b j
-
 -- | Fold a data structure using a `Semigroup` instance,
 -- | combining adjacent elements using the specified separator.
 intercalate :: forall f m. Foldable1 f => Semigroup m => m -> f m -> m

src/Data/Semigroup/Foldable/Internal.purs

@@ -0,0 +1,21 @@
+module Data.Semigroup.Foldable.Internal where
+
+import Prelude
+
+newtype Act :: forall k. (k -> Type) -> k -> Type
+newtype Act f a = Act (f a)
+
+getAct :: forall f a. Act f a -> f a
+getAct (Act f) = f
+
+instance semigroupAct :: Apply f => Semigroup (Act f a) where
+  append (Act a) (Act b) = Act (a *> b)
+
+-- | Internal. Used by intercalation functions.
+newtype JoinWith a = JoinWith (a -> a)
+
+joinee :: forall a. JoinWith a -> a -> a
+joinee (JoinWith x) = x
+
+instance semigroupJoinWith :: Semigroup a => Semigroup (JoinWith a) where
+  append (JoinWith a) (JoinWith b) = JoinWith $ \j -> a j <> j <> b j

src/Data/Semigroup/FoldableWithIndex.purs

@@ -0,0 +1,167 @@
+module Data.Semigroup.FoldableWithIndex
+( class FoldableWithIndex1
+, foldMapWithIndex1
+, foldWithIndex1
+, foldrWithIndex1
+, foldlWithIndex1
+, traverseWithIndex1_
+, forWithIndex1_
+, sequenceWithIndex1_
+-- , foldrWithIndex1Default
+-- , foldlWithIndex1Default
+, foldMapWithIndex1DefaultR
+, foldMapWithIndex1DefaultL
+, intercalateWithIndex
+, intercalateMapWithIndex
+, maximumByWithIndex
+, minimumByWithIndex
+) where
+
+import Prelude
+
+import Data.FoldableWithIndex (class FoldableWithIndex)
+import Data.FunctorWithIndex (class FunctorWithIndex, mapWithIndex)
+import Data.Identity (Identity(..))
+import Data.Monoid.Dual (Dual(..))
+import Data.Monoid.Multiplicative (Multiplicative(..))
+import Data.Semigroup.Foldable (class Foldable1)
+import Data.Semigroup.Foldable.Internal (Act(..), getAct)
+import Data.Tuple (Tuple(..))
+
+-- | `FoldableWithIndex1` represents non-empty data structures with indices that can be _folded_.
+-- |
+-- | - `foldrWithIndex1` folds a structure from the right with access to indices
+-- | - `foldlWithIndex1` folds a structure from the left with access to indices
+-- | - `foldMapWithIndex1` folds a structure by accumulating values in a `Semigroup` with access to indices
+-- |
+-- | This is the indexed version of `Foldable1`, for structures with at least one element.
+-- |
+-- | Default implementations are provided by the following functions:
+-- |
+-- | - `foldrWithIndex1Default`
+-- | - `foldlWithIndex1Default`
+-- | - `foldMapWithIndex1DefaultR`
+-- | - `foldMapWithIndex1DefaultL`
+-- |
+-- | Note: some combinations of the default implementations are unsafe to
+-- | use together - causing a non-terminating mutually recursive cycle.
+-- | These combinations are documented per function.
+class (FoldableWithIndex i t, Foldable1 t) <= FoldableWithIndex1 i t | t -> i where
+  foldrWithIndex1 :: forall a. (i -> a -> a -> a) -> t a -> a
+  foldlWithIndex1 :: forall a. (i -> a -> a -> a) -> t a -> a
+  foldMapWithIndex1 :: forall a m. Semigroup m => (i -> a -> m) -> t a -> m
+
+-- | A default implementation of `foldrWithIndex1` using `foldMapWithIndex1`.
+-- |
+-- | Note: when defining a `FoldableWithIndex1` instance, this function is unsafe to use
+-- | in combination with `foldMapWithIndex1DefaultR`.
+-- foldrWithIndex1Default :: forall t i a. FoldableWithIndex1 i t => (i -> a -> a -> a) -> t a -> a
+-- foldrWithIndex1Default f = flip runFoldRightWithIndex1 f <<< foldMapWithIndex1 (curry mkFoldRightWithIndex1)
+
+-- | A default implementation of `foldlWithIndex1` using `foldMapWithIndex1`.
+-- |
+-- | Note: when defining a `FoldableWithIndex1` instance, this function is unsafe to use
+-- | in combination with `foldMapWithIndex1DefaultL`.
+-- foldlWithIndex1Default :: forall t i a. FoldableWithIndex1 i t => (i -> a -> a -> a) -> t a -> a
+-- foldlWithIndex1Default f = runFoldRightWithIndex1 <<< alaF Dual foldMapWithIndex1 (curry mkFoldRightWithIndex1) <<< flip <<< f
+
+-- | A default implementation of `foldMapWithIndex1` using `foldrWithIndex1`.
+-- |
+-- | Note: when defining a `FoldableWithIndex1` instance, this function is unsafe to use
+-- | in combination with `foldrWithIndex1Default`.
+foldMapWithIndex1DefaultR :: forall t i m a. FoldableWithIndex1 i t => FunctorWithIndex i t => Semigroup m => (i -> a -> m) -> t a -> m
+foldMapWithIndex1DefaultR f t = foldrWithIndex1 (\_i m1 m2 -> m1 <> m2) (mapWithIndex f t :: t m)
+
+-- | A default implementation of `foldMapWithIndex1` using `foldlWithIndex1`.
+-- |
+-- | Note: when defining a `FoldableWithIndex1` instance, this function is unsafe to use
+-- | in combination with `foldlWithIndex1Default`.
+foldMapWithIndex1DefaultL :: forall t i m a. FoldableWithIndex1 i t => FunctorWithIndex i t => Semigroup m => (i -> a -> m) -> t a -> m
+foldMapWithIndex1DefaultL f t = foldlWithIndex1 (\_i m1 m2 -> m1 <> m2) (mapWithIndex f t)
+
+instance foldableWithIndex1Dual :: FoldableWithIndex1 Unit Dual where
+  foldrWithIndex1 _ (Dual x) = x
+  foldlWithIndex1 _ (Dual x) = x
+  foldMapWithIndex1 f (Dual x) = f unit x
+
+instance foldableWithIndex1Multiplicative :: FoldableWithIndex1 Unit Multiplicative where
+  foldrWithIndex1 _ (Multiplicative x) = x
+  foldlWithIndex1 _ (Multiplicative x) = x
+  foldMapWithIndex1 f (Multiplicative x) = f unit x
+
+instance foldableWithIndex1Tuple :: FoldableWithIndex1 Unit (Tuple a) where
+  foldMapWithIndex1 f (Tuple _ x) = f unit x
+  foldrWithIndex1 _ (Tuple _ x) = x
+  foldlWithIndex1 _ (Tuple _ x) = x
+
+instance foldableWithIndex1Identity :: FoldableWithIndex1 Unit Identity where
+  foldMapWithIndex1 f (Identity x) = f unit x
+  foldlWithIndex1 _ (Identity x) = x
+  foldrWithIndex1 _ (Identity x) = x
+
+-- | Fold a data structure with access to indices, accumulating values in some `Semigroup`.
+foldWithIndex1 :: forall t i m. FoldableWithIndex1 i t => Semigroup m => t m -> m
+foldWithIndex1 = foldMapWithIndex1 (const identity)
+
+-- | Traverse a data structure with access to indices, performing some effects encoded by an
+-- | `Apply` instance at each value, ignoring the final result.
+traverseWithIndex1_ :: forall t i f a b. FoldableWithIndex1 i t => Apply f => (i -> a -> f b) -> t a -> f Unit
+traverseWithIndex1_ f t = unit <$ getAct (foldMapWithIndex1 (\i -> Act <<< f i) t)
+
+-- | A version of `traverseWithIndex1_` with its arguments flipped.
+-- |
+-- | This can be useful when running an action written using do notation
+-- | for every element in a data structure with access to indices:
+forWithIndex1_ :: forall t i f a b. FoldableWithIndex1 i t => Apply f => t a -> (i -> a -> f b) -> f Unit
+forWithIndex1_ = flip traverseWithIndex1_
+
+-- | Perform all of the effects in some data structure in the order
+-- | given by the `FoldableWithIndex1` instance, ignoring the final result.
+sequenceWithIndex1_ :: forall t i f a. FoldableWithIndex1 i t => Apply f => t (f a) -> f Unit
+sequenceWithIndex1_ = traverseWithIndex1_ (const identity)
+
+-- | Find the maximum element of a structure with access to indices, according to a given comparison
+-- | function. The comparison function receives the indices and elements.
+maximumByWithIndex :: forall f i a. FoldableWithIndex1 i f => (i -> a -> a -> Ordering) -> f a -> a
+maximumByWithIndex cmp = foldlWithIndex1 \i x y -> if cmp i x y == GT then x else y
+
+-- | Find the minimum element of a structure with access to indices, according to a given comparison
+-- | function. The comparison function receives the indices and elements.
+minimumByWithIndex :: forall f i a. FoldableWithIndex1 i f => (i -> a -> a -> Ordering) -> f a -> a
+minimumByWithIndex cmp = foldlWithIndex1 \i x y -> if cmp i x y == LT then x else y
+
+-- | Internal. Used by intercalation functions with indices.
+newtype JoinWithIndex i a = JoinWithIndex (i -> a -> a)
+
+joineeWithIndex :: forall i a. JoinWithIndex i a -> i -> a -> a
+joineeWithIndex (JoinWithIndex x) = x
+
+instance semigroupJoinWithIndex :: Semigroup a => Semigroup (JoinWithIndex i a) where
+  append (JoinWithIndex a) (JoinWithIndex b) = JoinWithIndex $ \i j -> a i j <> j <> b i j
+
+-- | Fold a data structure using a `Semigroup` instance with access to indices,
+-- | combining adjacent elements using the specified separator.
+intercalateWithIndex :: forall f i m. FoldableWithIndex1 i f => Semigroup m => m -> f m -> m
+intercalateWithIndex = flip intercalateMapWithIndex (const identity)
+
+-- | Fold a data structure, accumulating values in some `Semigroup` with access to indices,
+-- | combining adjacent elements using the specified separator.
+intercalateMapWithIndex
+  :: forall f i m a
+  . FoldableWithIndex1 i f
+  => Semigroup m
+  => m -> (i -> a -> m) -> f a -> m
+intercalateMapWithIndex j f foldable =
+  joineeWithIndex (foldMapWithIndex1 (\i -> JoinWithIndex <<< const <<< const <<< f i) foldable) unit j
+
+-- | Internal. Used by foldrWithIndex1Default and foldlWithIndex1Default.
+data FoldRightWithIndex1 i a = FoldRightWithIndex1 (a -> (i -> a -> a -> a) -> a) a
+
+-- instance foldRightWithIndex1Semigroup :: Semigroup (FoldRightWithIndex1 i a) where
+--   append (FoldRightWithIndex1 lf lr) (FoldRightWithIndex1 rf rr) = FoldRightWithIndex1 (\a f -> lf (f lr (rf a f)) f) rr -- FIXME: An infinite type was inferred for an expression
+
+mkFoldRightWithIndex1 :: forall i a. Tuple i a -> FoldRightWithIndex1 i a
+mkFoldRightWithIndex1 (Tuple _ a) = FoldRightWithIndex1 const a
+
+runFoldRightWithIndex1 :: forall i a. FoldRightWithIndex1 i a -> (i -> a -> a -> a) -> a
+runFoldRightWithIndex1 (FoldRightWithIndex1 f a) = f a

src/Data/Semigroup/TraversableWithIndex.purs

@@ -0,0 +1,110 @@
+module Data.Semigroup.TraversableWithIndex where
+
+import Prelude
+
+import Data.FunctorWithIndex (mapWithIndex)
+import Data.Identity (Identity(..))
+import Data.Monoid.Dual (Dual(..))
+import Data.Monoid.Multiplicative (Multiplicative(..))
+import Data.Semigroup.FoldableWithIndex (class FoldableWithIndex1)
+import Data.Semigroup.Traversable (class Traversable1)
+import Data.TraversableWithIndex (class TraversableWithIndex)
+import Data.Tuple (Tuple(..))
+
+-- | `TraversableWithIndex1` represents non-empty data structures with indices that can be _traversed_,
+-- | accumulating results and effects in some `Apply` functor.
+-- |
+-- | - `traverseWithIndex1` runs an action for every element in a data structure
+-- |   with access to indices, and accumulates the results.
+-- | - `sequenceWithIndex1` runs the actions _contained_ in a data structure,
+-- |   and accumulates the results.
+-- |
+-- | This is the indexed version of `Traversable1`, for structures with at least one element.
+-- |
+-- | The `traverseWithIndex1` and `sequenceWithIndex1` functions should be compatible in the
+-- | following sense:
+-- |
+-- | - `traverseWithIndex1 f xs = sequenceWithIndex1 (mapWithIndex f xs)`
+-- | - `sequenceWithIndex1 = traverseWithIndex1 (const identity)`
+-- |
+-- | `TraversableWithIndex1` instances should also be compatible with the corresponding
+-- | `FoldableWithIndex1` instances, in the following sense:
+-- |
+-- | - `foldMapWithIndex1 f = runConst <<< traverseWithIndex1 (\i -> Const <<< f i)`
+-- |
+-- | And with the corresponding `Traversable1` instances:
+-- |
+-- | - `traverse1 f = traverseWithIndex1 (const f)`
+-- |
+-- | Default implementations are provided by the following functions:
+-- |
+-- | - `traverseWithIndex1Default`
+-- | - `sequenceWithIndex1Default`
+class (FoldableWithIndex1 i t, TraversableWithIndex i t, Traversable1 t) <= TraversableWithIndex1 i t | t -> i where
+  traverseWithIndex1 :: forall a b f. Apply f => (i -> a -> f b) -> t a -> f (t b)
+  sequenceWithIndex1 :: forall b f. Apply f => t (f b) -> f (t b)
+
+instance traversableWithIndex1Dual :: TraversableWithIndex1 Unit Dual where
+  traverseWithIndex1 f (Dual x) = Dual <$> f unit x
+  sequenceWithIndex1 = sequenceWithIndex1Default
+
+instance traversableWithIndex1Multiplicative :: TraversableWithIndex1 Unit Multiplicative where
+  traverseWithIndex1 f (Multiplicative x) = Multiplicative <$> f unit x
+  sequenceWithIndex1 = sequenceWithIndex1Default
+
+instance traversableWithIndex1Tuple :: TraversableWithIndex1 Unit (Tuple a) where
+  traverseWithIndex1 f (Tuple x y) = Tuple x <$> f unit y
+  sequenceWithIndex1 (Tuple x y) = Tuple x <$> y
+
+instance traversableWithIndex1Identity :: TraversableWithIndex1 Unit Identity where
+  traverseWithIndex1 f (Identity x) = Identity <$> f unit x
+  sequenceWithIndex1 (Identity x) = Identity <$> x
+
+-- | A default implementation of `traverseWithIndex1` using `sequenceWithIndex1` and `mapWithIndex`.
+traverseWithIndex1Default
+  :: forall t i a b m
+   . TraversableWithIndex1 i t
+  => Apply m
+  => (i -> a -> m b)
+  -> t a
+  -> m (t b)
+traverseWithIndex1Default f ta = sequenceWithIndex1 (mapWithIndex f ta)
+
+-- | A default implementation of `sequenceWithIndex1` using `traverseWithIndex1`.
+sequenceWithIndex1Default
+  :: forall t i a m
+   . TraversableWithIndex1 i t
+  => Apply m
+  => t (m a)
+  -> m (t a)
+sequenceWithIndex1Default = traverseWithIndex1 (const identity)
+
+-- | A version of `traverseWithIndex1` with its arguments flipped.
+-- |
+-- | This can be useful when running an action written using do notation
+-- | for every element in a data structure with access to indices:
+forWithIndex1
+  :: forall i a b m t
+   . Apply m
+  => TraversableWithIndex1 i t
+  => t a
+  -> (i -> a -> m b)
+  -> m (t b)
+forWithIndex1 = flip traverseWithIndex1
+
+-- | A default implementation of `traverse1` in terms of `traverseWithIndex1`
+traverse1Default
+  :: forall i t a b m
+   . TraversableWithIndex1 i t
+  => Apply m
+  => (a -> m b) -> t a -> m (t b)
+traverse1Default f = traverseWithIndex1 (const f)
+
+-- | A default implementation of `traverseWithIndex` in terms of `traverseWithIndex1`
+-- | This works because `TraversableWithIndex1` extends `TraversableWithIndex`
+traverseWithIndexDefault
+  :: forall i t a b m
+   . TraversableWithIndex1 i t
+  => Applicative m
+  => (i -> a -> m b) -> t a -> m (t b)
+traverseWithIndexDefault f = traverseWithIndex1 f