Skip to content

Commit c7108b1

Browse files
srghmasrghma
committed
feat: add Data.Semigroup.FoldableWithIndex and Data.Semigroup.TraversableWithIndex
1 parent 66907f2 commit c7108b1

File tree

4 files changed

+298
-18
lines changed

4 files changed

+298
-18
lines changed

‎src/Data/Semigroup/Foldable.purs‎

Lines changed: 0 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -103,15 +103,6 @@ instance foldableIdentity :: Foldable1 Identity where
103103
fold1 :: forall t m. Foldable1 t => Semigroup m => t m -> m
104104
fold1 = foldMap1 identity
105105

106-
newtype Act :: forall k. (k -> Type) -> k -> Type
107-
newtype Act f a = Act (f a)
108-
109-
getAct :: forall f a. Act f a -> f a
110-
getAct (Act f) = f
111-
112-
instance semigroupAct :: Apply f => Semigroup (Act f a) where
113-
append (Act a) (Act b) = Act (a *> b)
114-
115106
-- | Traverse a data structure, performing some effects encoded by an
116107
-- | `Apply` instance at each value, ignoring the final result.
117108
traverse1_ :: forall t f a b. Foldable1 t => Apply f => (a -> f b) -> t a -> f Unit
@@ -141,15 +132,6 @@ minimum = ala Min foldMap1
141132
minimumBy :: forall f a. Foldable1 f => (a -> a -> Ordering) -> f a -> a
142133
minimumBy cmp = foldl1 \x y -> if cmp x y == LT then x else y
143134

144-
-- | Internal. Used by intercalation functions.
145-
newtype JoinWith a = JoinWith (a -> a)
146-
147-
joinee :: forall a. JoinWith a -> a -> a
148-
joinee (JoinWith x) = x
149-
150-
instance semigroupJoinWith :: Semigroup a => Semigroup (JoinWith a) where
151-
append (JoinWith a) (JoinWith b) = JoinWith $ \j -> a j <> j <> b j
152-
153135
-- | Fold a data structure using a `Semigroup` instance,
154136
-- | combining adjacent elements using the specified separator.
155137
intercalate :: forall f m. Foldable1 f => Semigroup m => m -> f m -> m

‎src/Data/Semigroup/Foldable/Internal.purs‎

Lines changed: 21 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,21 @@
1+
module Data.Semigroup.Foldable.Internal where
2+
3+
import Prelude
4+
5+
newtype Act :: forall k. (k -> Type) -> k -> Type
6+
newtype Act f a = Act (f a)
7+
8+
getAct :: forall f a. Act f a -> f a
9+
getAct (Act f) = f
10+
11+
instance semigroupAct :: Apply f => Semigroup (Act f a) where
12+
append (Act a) (Act b) = Act (a *> b)
13+
14+
-- | Internal. Used by intercalation functions.
15+
newtype JoinWith a = JoinWith (a -> a)
16+
17+
joinee :: forall a. JoinWith a -> a -> a
18+
joinee (JoinWith x) = x
19+
20+
instance semigroupJoinWith :: Semigroup a => Semigroup (JoinWith a) where
21+
append (JoinWith a) (JoinWith b) = JoinWith $ \j -> a j <> j <> b j

‎src/Data/Semigroup/FoldableWithIndex.purs‎

Lines changed: 167 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,167 @@
1+
module Data.Semigroup.FoldableWithIndex
2+
( class FoldableWithIndex1
3+
, foldMapWithIndex1
4+
, foldWithIndex1
5+
, foldrWithIndex1
6+
, foldlWithIndex1
7+
, traverseWithIndex1_
8+
, forWithIndex1_
9+
, sequenceWithIndex1_
10+
-- , foldrWithIndex1Default
11+
-- , foldlWithIndex1Default
12+
, foldMapWithIndex1DefaultR
13+
, foldMapWithIndex1DefaultL
14+
, intercalateWithIndex
15+
, intercalateMapWithIndex
16+
, maximumByWithIndex
17+
, minimumByWithIndex
18+
) where
19+
20+
import Prelude
21+
22+
import Data.FoldableWithIndex (class FoldableWithIndex)
23+
import Data.FunctorWithIndex (class FunctorWithIndex, mapWithIndex)
24+
import Data.Identity (Identity(..))
25+
import Data.Monoid.Dual (Dual(..))
26+
import Data.Monoid.Multiplicative (Multiplicative(..))
27+
import Data.Semigroup.Foldable (class Foldable1)
28+
import Data.Semigroup.Foldable.Internal (Act(..), getAct)
29+
import Data.Tuple (Tuple(..))
30+
31+
-- | `FoldableWithIndex1` represents non-empty data structures with indices that can be _folded_.
32+
-- |
33+
-- | - `foldrWithIndex1` folds a structure from the right with access to indices
34+
-- | - `foldlWithIndex1` folds a structure from the left with access to indices
35+
-- | - `foldMapWithIndex1` folds a structure by accumulating values in a `Semigroup` with access to indices
36+
-- |
37+
-- | This is the indexed version of `Foldable1`, for structures with at least one element.
38+
-- |
39+
-- | Default implementations are provided by the following functions:
40+
-- |
41+
-- | - `foldrWithIndex1Default`
42+
-- | - `foldlWithIndex1Default`
43+
-- | - `foldMapWithIndex1DefaultR`
44+
-- | - `foldMapWithIndex1DefaultL`
45+
-- |
46+
-- | Note: some combinations of the default implementations are unsafe to
47+
-- | use together - causing a non-terminating mutually recursive cycle.
48+
-- | These combinations are documented per function.
49+
class (FoldableWithIndex i t, Foldable1 t) <= FoldableWithIndex1 i t | t -> i where
50+
foldrWithIndex1 :: forall a. (i -> a -> a -> a) -> t a -> a
51+
foldlWithIndex1 :: forall a. (i -> a -> a -> a) -> t a -> a
52+
foldMapWithIndex1 :: forall a m. Semigroup m => (i -> a -> m) -> t a -> m
53+
54+
-- | A default implementation of `foldrWithIndex1` using `foldMapWithIndex1`.
55+
-- |
56+
-- | Note: when defining a `FoldableWithIndex1` instance, this function is unsafe to use
57+
-- | in combination with `foldMapWithIndex1DefaultR`.
58+
-- foldrWithIndex1Default :: forall t i a. FoldableWithIndex1 i t => (i -> a -> a -> a) -> t a -> a
59+
-- foldrWithIndex1Default f = flip runFoldRightWithIndex1 f <<< foldMapWithIndex1 (curry mkFoldRightWithIndex1)
60+
61+
-- | A default implementation of `foldlWithIndex1` using `foldMapWithIndex1`.
62+
-- |
63+
-- | Note: when defining a `FoldableWithIndex1` instance, this function is unsafe to use
64+
-- | in combination with `foldMapWithIndex1DefaultL`.
65+
-- foldlWithIndex1Default :: forall t i a. FoldableWithIndex1 i t => (i -> a -> a -> a) -> t a -> a
66+
-- foldlWithIndex1Default f = runFoldRightWithIndex1 <<< alaF Dual foldMapWithIndex1 (curry mkFoldRightWithIndex1) <<< flip <<< f
67+
68+
-- | A default implementation of `foldMapWithIndex1` using `foldrWithIndex1`.
69+
-- |
70+
-- | Note: when defining a `FoldableWithIndex1` instance, this function is unsafe to use
71+
-- | in combination with `foldrWithIndex1Default`.
72+
foldMapWithIndex1DefaultR :: forall t i m a. FoldableWithIndex1 i t => FunctorWithIndex i t => Semigroup m => (i -> a -> m) -> t a -> m
73+
foldMapWithIndex1DefaultR f t = foldrWithIndex1 (\_i m1 m2 -> m1 <> m2) (mapWithIndex f t :: t m)
74+
75+
-- | A default implementation of `foldMapWithIndex1` using `foldlWithIndex1`.
76+
-- |
77+
-- | Note: when defining a `FoldableWithIndex1` instance, this function is unsafe to use
78+
-- | in combination with `foldlWithIndex1Default`.
79+
foldMapWithIndex1DefaultL :: forall t i m a. FoldableWithIndex1 i t => FunctorWithIndex i t => Semigroup m => (i -> a -> m) -> t a -> m
80+
foldMapWithIndex1DefaultL f t = foldlWithIndex1 (\_i m1 m2 -> m1 <> m2) (mapWithIndex f t)
81+
82+
instance foldableWithIndex1Dual :: FoldableWithIndex1 Unit Dual where
83+
foldrWithIndex1 _ (Dual x) = x
84+
foldlWithIndex1 _ (Dual x) = x
85+
foldMapWithIndex1 f (Dual x) = f unit x
86+
87+
instance foldableWithIndex1Multiplicative :: FoldableWithIndex1 Unit Multiplicative where
88+
foldrWithIndex1 _ (Multiplicative x) = x
89+
foldlWithIndex1 _ (Multiplicative x) = x
90+
foldMapWithIndex1 f (Multiplicative x) = f unit x
91+
92+
instance foldableWithIndex1Tuple :: FoldableWithIndex1 Unit (Tuple a) where
93+
foldMapWithIndex1 f (Tuple _ x) = f unit x
94+
foldrWithIndex1 _ (Tuple _ x) = x
95+
foldlWithIndex1 _ (Tuple _ x) = x
96+
97+
instance foldableWithIndex1Identity :: FoldableWithIndex1 Unit Identity where
98+
foldMapWithIndex1 f (Identity x) = f unit x
99+
foldlWithIndex1 _ (Identity x) = x
100+
foldrWithIndex1 _ (Identity x) = x
101+
102+
-- | Fold a data structure with access to indices, accumulating values in some `Semigroup`.
103+
foldWithIndex1 :: forall t i m. FoldableWithIndex1 i t => Semigroup m => t m -> m
104+
foldWithIndex1 = foldMapWithIndex1 (const identity)
105+
106+
-- | Traverse a data structure with access to indices, performing some effects encoded by an
107+
-- | `Apply` instance at each value, ignoring the final result.
108+
traverseWithIndex1_ :: forall t i f a b. FoldableWithIndex1 i t => Apply f => (i -> a -> f b) -> t a -> f Unit
109+
traverseWithIndex1_ f t = unit <$ getAct (foldMapWithIndex1 (\i -> Act <<< f i) t)
110+
111+
-- | A version of `traverseWithIndex1_` with its arguments flipped.
112+
-- |
113+
-- | This can be useful when running an action written using do notation
114+
-- | for every element in a data structure with access to indices:
115+
forWithIndex1_ :: forall t i f a b. FoldableWithIndex1 i t => Apply f => t a -> (i -> a -> f b) -> f Unit
116+
forWithIndex1_ = flip traverseWithIndex1_
117+
118+
-- | Perform all of the effects in some data structure in the order
119+
-- | given by the `FoldableWithIndex1` instance, ignoring the final result.
120+
sequenceWithIndex1_ :: forall t i f a. FoldableWithIndex1 i t => Apply f => t (f a) -> f Unit
121+
sequenceWithIndex1_ = traverseWithIndex1_ (const identity)
122+
123+
-- | Find the maximum element of a structure with access to indices, according to a given comparison
124+
-- | function. The comparison function receives the indices and elements.
125+
maximumByWithIndex :: forall f i a. FoldableWithIndex1 i f => (i -> a -> a -> Ordering) -> f a -> a
126+
maximumByWithIndex cmp = foldlWithIndex1 \i x y -> if cmp i x y == GT then x else y
127+
128+
-- | Find the minimum element of a structure with access to indices, according to a given comparison
129+
-- | function. The comparison function receives the indices and elements.
130+
minimumByWithIndex :: forall f i a. FoldableWithIndex1 i f => (i -> a -> a -> Ordering) -> f a -> a
131+
minimumByWithIndex cmp = foldlWithIndex1 \i x y -> if cmp i x y == LT then x else y
132+
133+
-- | Internal. Used by intercalation functions with indices.
134+
newtype JoinWithIndex i a = JoinWithIndex (i -> a -> a)
135+
136+
joineeWithIndex :: forall i a. JoinWithIndex i a -> i -> a -> a
137+
joineeWithIndex (JoinWithIndex x) = x
138+
139+
instance semigroupJoinWithIndex :: Semigroup a => Semigroup (JoinWithIndex i a) where
140+
append (JoinWithIndex a) (JoinWithIndex b) = JoinWithIndex $ \i j -> a i j <> j <> b i j
141+
142+
-- | Fold a data structure using a `Semigroup` instance with access to indices,
143+
-- | combining adjacent elements using the specified separator.
144+
intercalateWithIndex :: forall f i m. FoldableWithIndex1 i f => Semigroup m => m -> f m -> m
145+
intercalateWithIndex = flip intercalateMapWithIndex (const identity)
146+
147+
-- | Fold a data structure, accumulating values in some `Semigroup` with access to indices,
148+
-- | combining adjacent elements using the specified separator.
149+
intercalateMapWithIndex
150+
:: forall f i m a
151+
. FoldableWithIndex1 i f
152+
=> Semigroup m
153+
=> m -> (i -> a -> m) -> f a -> m
154+
intercalateMapWithIndex j f foldable =
155+
joineeWithIndex (foldMapWithIndex1 (\i -> JoinWithIndex <<< const <<< const <<< f i) foldable) unit j
156+
157+
-- | Internal. Used by foldrWithIndex1Default and foldlWithIndex1Default.
158+
data FoldRightWithIndex1 i a = FoldRightWithIndex1 (a -> (i -> a -> a -> a) -> a) a
159+
160+
-- instance foldRightWithIndex1Semigroup :: Semigroup (FoldRightWithIndex1 i a) where
161+
-- 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
162+
163+
mkFoldRightWithIndex1 :: forall i a. Tuple i a -> FoldRightWithIndex1 i a
164+
mkFoldRightWithIndex1 (Tuple _ a) = FoldRightWithIndex1 const a
165+
166+
runFoldRightWithIndex1 :: forall i a. FoldRightWithIndex1 i a -> (i -> a -> a -> a) -> a
167+
runFoldRightWithIndex1 (FoldRightWithIndex1 f a) = f a

‎src/Data/Semigroup/TraversableWithIndex.purs‎

Lines changed: 110 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,110 @@
1+
module Data.Semigroup.TraversableWithIndex where
2+
3+
import Prelude
4+
5+
import Data.FunctorWithIndex (mapWithIndex)
6+
import Data.Identity (Identity(..))
7+
import Data.Monoid.Dual (Dual(..))
8+
import Data.Monoid.Multiplicative (Multiplicative(..))
9+
import Data.Semigroup.FoldableWithIndex (class FoldableWithIndex1)
10+
import Data.Semigroup.Traversable (class Traversable1)
11+
import Data.TraversableWithIndex (class TraversableWithIndex)
12+
import Data.Tuple (Tuple(..))
13+
14+
-- | `TraversableWithIndex1` represents non-empty data structures with indices that can be _traversed_,
15+
-- | accumulating results and effects in some `Apply` functor.
16+
-- |
17+
-- | - `traverseWithIndex1` runs an action for every element in a data structure
18+
-- | with access to indices, and accumulates the results.
19+
-- | - `sequenceWithIndex1` runs the actions _contained_ in a data structure,
20+
-- | and accumulates the results.
21+
-- |
22+
-- | This is the indexed version of `Traversable1`, for structures with at least one element.
23+
-- |
24+
-- | The `traverseWithIndex1` and `sequenceWithIndex1` functions should be compatible in the
25+
-- | following sense:
26+
-- |
27+
-- | - `traverseWithIndex1 f xs = sequenceWithIndex1 (mapWithIndex f xs)`
28+
-- | - `sequenceWithIndex1 = traverseWithIndex1 (const identity)`
29+
-- |
30+
-- | `TraversableWithIndex1` instances should also be compatible with the corresponding
31+
-- | `FoldableWithIndex1` instances, in the following sense:
32+
-- |
33+
-- | - `foldMapWithIndex1 f = runConst <<< traverseWithIndex1 (\i -> Const <<< f i)`
34+
-- |
35+
-- | And with the corresponding `Traversable1` instances:
36+
-- |
37+
-- | - `traverse1 f = traverseWithIndex1 (const f)`
38+
-- |
39+
-- | Default implementations are provided by the following functions:
40+
-- |
41+
-- | - `traverseWithIndex1Default`
42+
-- | - `sequenceWithIndex1Default`
43+
class (FoldableWithIndex1 i t, TraversableWithIndex i t, Traversable1 t) <= TraversableWithIndex1 i t | t -> i where
44+
traverseWithIndex1 :: forall a b f. Apply f => (i -> a -> f b) -> t a -> f (t b)
45+
sequenceWithIndex1 :: forall b f. Apply f => t (f b) -> f (t b)
46+
47+
instance traversableWithIndex1Dual :: TraversableWithIndex1 Unit Dual where
48+
traverseWithIndex1 f (Dual x) = Dual <$> f unit x
49+
sequenceWithIndex1 = sequenceWithIndex1Default
50+
51+
instance traversableWithIndex1Multiplicative :: TraversableWithIndex1 Unit Multiplicative where
52+
traverseWithIndex1 f (Multiplicative x) = Multiplicative <$> f unit x
53+
sequenceWithIndex1 = sequenceWithIndex1Default
54+
55+
instance traversableWithIndex1Tuple :: TraversableWithIndex1 Unit (Tuple a) where
56+
traverseWithIndex1 f (Tuple x y) = Tuple x <$> f unit y
57+
sequenceWithIndex1 (Tuple x y) = Tuple x <$> y
58+
59+
instance traversableWithIndex1Identity :: TraversableWithIndex1 Unit Identity where
60+
traverseWithIndex1 f (Identity x) = Identity <$> f unit x
61+
sequenceWithIndex1 (Identity x) = Identity <$> x
62+
63+
-- | A default implementation of `traverseWithIndex1` using `sequenceWithIndex1` and `mapWithIndex`.
64+
traverseWithIndex1Default
65+
:: forall t i a b m
66+
. TraversableWithIndex1 i t
67+
=> Apply m
68+
=> (i -> a -> m b)
69+
-> t a
70+
-> m (t b)
71+
traverseWithIndex1Default f ta = sequenceWithIndex1 (mapWithIndex f ta)
72+
73+
-- | A default implementation of `sequenceWithIndex1` using `traverseWithIndex1`.
74+
sequenceWithIndex1Default
75+
:: forall t i a m
76+
. TraversableWithIndex1 i t
77+
=> Apply m
78+
=> t (m a)
79+
-> m (t a)
80+
sequenceWithIndex1Default = traverseWithIndex1 (const identity)
81+
82+
-- | A version of `traverseWithIndex1` with its arguments flipped.
83+
-- |
84+
-- | This can be useful when running an action written using do notation
85+
-- | for every element in a data structure with access to indices:
86+
forWithIndex1
87+
:: forall i a b m t
88+
. Apply m
89+
=> TraversableWithIndex1 i t
90+
=> t a
91+
-> (i -> a -> m b)
92+
-> m (t b)
93+
forWithIndex1 = flip traverseWithIndex1
94+
95+
-- | A default implementation of `traverse1` in terms of `traverseWithIndex1`
96+
traverse1Default
97+
:: forall i t a b m
98+
. TraversableWithIndex1 i t
99+
=> Apply m
100+
=> (a -> m b) -> t a -> m (t b)
101+
traverse1Default f = traverseWithIndex1 (const f)
102+
103+
-- | A default implementation of `traverseWithIndex` in terms of `traverseWithIndex1`
104+
-- | This works because `TraversableWithIndex1` extends `TraversableWithIndex`
105+
traverseWithIndexDefault
106+
:: forall i t a b m
107+
. TraversableWithIndex1 i t
108+
=> Applicative m
109+
=> (i -> a -> m b) -> t a -> m (t b)
110+
traverseWithIndexDefault f = traverseWithIndex1 f

0 commit comments

Comments
 (0)