diff --git a/src/Data/Semigroup/Foldable.purs b/src/Data/Semigroup/Foldable.purs index a7fdf36..4832532 100644 --- a/src/Data/Semigroup/Foldable.purs +++ b/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 diff --git a/src/Data/Semigroup/Foldable/Internal.purs b/src/Data/Semigroup/Foldable/Internal.purs new file mode 100644 index 0000000..2a24815 --- /dev/null +++ b/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 diff --git a/src/Data/Semigroup/FoldableWithIndex.purs b/src/Data/Semigroup/FoldableWithIndex.purs new file mode 100644 index 0000000..da14253 --- /dev/null +++ b/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 diff --git a/src/Data/Semigroup/TraversableWithIndex.purs b/src/Data/Semigroup/TraversableWithIndex.purs new file mode 100644 index 0000000..5f4b7bc --- /dev/null +++ b/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