Add Data.Foldable1 to base
Oleg Grenrus
oleg.grenrus at iki.fi
Fri Oct 18 01:12:37 UTC 2019
What is the proposed change in semigroupoids, I don't see any decisive
conclusion comment. To get this going, I suggest limiting discussion to
the Foldable1 only
and if after this proposal is accepted, extrapolate for the rest of
`semigroupoids`.
So if someone can propose a concrete list how to rename symbols in
https://oleg.fi/haddocks/foldable1/Data-Foldable1.html
<http://oleg.fi/haddocks/foldable1/Data-Foldable1.html>, I'll make a
separate branch & haddock page.
Is the wanted renaming s/1//; s/^/semi/:
- Foldable1 -> Semifoldable
- fold1 -> semifold
- foldMap1 -> semifoldMap
- foldr1 -> semifoldr
- foldr1map -> semifoldr1map
- toNonEmpty -> toNonEmpty
- ...
- head1 -> semihead
- last1 -> semilast
- minimum1 -> semiminimum
- maximum1 -> semimaximum
- intercalate1 -> semiintercalate
- foldl1M -> semifoldl
- ...
- maximum1By -> semimaximumBy
- ...
I'm fine with this.
The head1/semihead are both silly, but the suffix was there to avoid
name clash, so prefix is fine for that purpose too.
---
The synopsis of current state of proposed Data.Foldable1
module Data.Foldable1where
class Foldable t => Foldable1 t
fold1 :: (Foldable1 t, Semigroup m) => t m -> m
foldMap1 :: (Foldable1 t, Semigroup m) => (a -> m) -> t a -> m
foldMap1' :: (Foldable1 t, Semigroup m) => (a -> m) -> t a -> m
foldr1 :: Foldable1 t => (a -> a -> a) -> t a -> a
foldr1' :: Foldable1 t => (a -> a -> a) -> t a -> a
foldl1 :: Foldable1 t => (a -> a -> a) -> t a -> a
foldl1' :: Foldable1 t => (a -> a -> a) -> t a -> a
toNonEmpty :: Foldable1 t => t a -> NonEmpty a
maximum1 :: forall a. (Foldable1 t, Ord a) => t a -> a
minimum1 :: forall a. (Foldable1 t, Ord a) => t a -> a
head1 :: Foldable1 t => t a -> a
last1 :: Foldable1 t => t a -> a
foldr1map :: Foldable1 t => (a -> b) -> (b -> b -> b) -> t a -> b
foldl1'map :: Foldable1 t => (a -> b) -> (b -> b -> b) -> t a -> b
foldl1map :: Foldable1 t => (a -> b) -> (b -> b -> b) -> t a -> b
foldr1'map :: Foldable1 t => (a -> b) -> (b -> b -> b) -> t a -> b
intercalate1 :: (Foldable1 t, Semigroup m) => m -> t m -> m
foldrM1 :: (Foldable1 t, Monad m) => (a -> a -> m a) -> t a -> m a
foldlM1 :: (Foldable1 t, Monad m) => (a -> a -> m a) -> t a -> m a
maximum1By :: Foldable1 t => (a -> a -> Ordering) -> t a -> a
minimum1By :: Foldable1 t => (a -> a -> Ordering) -> t a -> a
- Oleg
On 18.10.2019 3.06, Edward Kmett wrote:
> I’m happy to take patches to move things along in semigroupoids. My
> focus has been elsewhere, I admit.
>
> -Edward
>
>> On Oct 17, 2019, at 5:03 PM, Andrew Martin
>> <andrew.thaddeus at gmail.com> wrote:
>>
>> While I want this abstraction in base, I don’t want it there yet.
>> There is an open issue on semigroupoids about renaming everything:
>> https://github.com/ekmett/semigroupoids/issues/26
>>
>> This needs to be handled before the abstraction is brought into base.
>> Also, foldr1 is awful in common situations. See
>> https://github.com/ekmett/semigroupoids/issues/77
>>
>> The problem is that refinements of this abstraction seem to have
>> stalled in semigroupoids, but these are desperately needed before the
>> abstraction is brought into base.
>>
>> Sent from my iPhone
>>
>> On Oct 17, 2019, at 10:42 AM, Oleg Grenrus <oleg.grenrus at iki.fi
>> <mailto:oleg.grenrus at iki.fi>> wrote:
>>
>>> I propose adding `Foldable1` type-class into `base1`.
>>>
>>> Add Foldable1
>>> =============
>>>
>>>
>>> Motivation
>>> ----------
>>>
>>> It's regularly asked whether `Foldable1` could be added to `base`
>>> (e.g. on reddit[^ref1], there're also GHC issue[^ref2] and old
>>> phabricator diff[^ref3])
>>> Also there's work towards non-empty maps and sets[^ref4],
>>> which would benefit from `Foldable1`.
>>>
>>> As commented on reddit, `Foldable1` could be added without any pain
>>> to the `base` as it's pure addition - no modifications needed in
>>> existing modules.
>>>
>>> [^ref1]:
>>> https://www.reddit.com/r/haskell/comments/6d0vgt/could_we_have_foldable1_and_traversable1_in_base/
>>> [^ref2]: https://gitlab.haskell.org/ghc/ghc/issues/13573
>>> [^ref3]: https://phabricator.haskell.org/D4812
>>> [^ref4]: https://github.com/haskell/containers/pull/616
>>>
>>> Change
>>> ------
>>>
>>> The change exist as merge request[^ref4] on gitlab.haskell.org
>>> <http://gitlab.haskell.org>.
>>>
>>> Importantly, this change **doesn't change** anything in other modules
>>> of `base`, except of adding a `Foldable` instance to `Data.Complex`.
>>> In particular, `foldl1` and `foldr1` in `Data.Foldable` remain
>>> partial, etc.
>>>
>>> My version of `Foldable1` class is big, so I'll comment the motivation
>>> for each member
>>>
>>> ```haskell
>>> class Foldable t => Foldable1 t where
>>> {-# MINIMAL foldMap1 | toNonEmpty | foldr1map #-}
>>>
>>> -- the defining member, like foldMap but only asking for Semigroup
>>> foldMap1 :: Semigroup m => (a -> m) -> t a -> m
>>>
>>> fold1 :: Semigroup m => t m -> m#
>>>
>>> -- strict foldMap1, cf foldMap'
>>> foldMap1' :: Semigroup m => (a -> m) -> t a -> m
>>>
>>> -- analogue of toList
>>> toNonEmpty :: t a -> NonEmpty a
>>>
>>> -- left&right, strict&non-strict folds
>>> foldr1 :: (a -> a -> a) -> t a -> a
>>> foldr1' :: (a -> a -> a) -> t a -> a
>>> foldl1 :: (a -> a -> a) -> t a -> a
>>> foldl1' :: (a -> a -> a) -> t a -> a
>>>
>>> -- these can have efficient implementation for NonEmptySet
>>> maximum1 :: forall a. Ord a => t a -> a
>>> minimum1 :: forall a. Ord a => t a -> a
>>>
>>> -- head1 have efficient implementation for NonEmpty and Tree
>>> -- last1 for symmetry
>>> head1 :: t a -> a
>>> last1 :: t a -> a
>>>
>>> -- fold variants with premap.
>>> -- Without this map, we cannot implement foldl using foldr etc.
>>> foldr1map :: (a -> b) -> (b -> b -> b) -> t a -> b
>>> foldl1'map :: (a -> b) -> (b -> b -> b) -> t a -> b
>>> foldl1map :: (a -> b) -> (b -> b -> b) -> t a -> b
>>> foldr1'map :: (a -> b) -> (b -> b -> b) -> t a -> b
>>> ```
>>>
>>> The merge request also adds instances for everything non-empty in
>>> `base`.
>>>
>>> I propose the `Data.Foldable1` as the module name.
>>> `semigroupoids`[^ref6] uses `Data.Semigroup.Foldable`,
>>> but it's confusing; and using different name could help migration.
>>>
>>> The module contains five top-level functions, which should
>>> be self-explanatory:
>>>
>>> ```haskell
>>> intercalate1 :: (Foldable1 t, Semigroup m) => m -> t m -> m
>>>
>>> foldrM1 :: (Foldable1 t, Monad m) => (a -> a -> m a) -> t a -> m a
>>> foldlM1 :: (Foldable1 t, Monad m) => (a -> a -> m a) -> t a -> m a
>>>
>>> maximum1By :: Foldable1 t => (a -> a -> Ordering) -> t a -> a
>>> minimum1By :: Foldable1 t => (a -> a -> Ordering) -> t a -> a
>>> ```
>>>
>>> This is less than in `Data.Semigroup.Foldable`[^ref9],
>>> as without `Apply` they don't make sense.
>>> For example:
>>>
>>> ```haskell
>>> -- needs Apply, not in Data.Foldable1
>>> traverse1_ :: (Foldable1 t, Apply f) => (a -> f b) -> t a -> f ()
>>> ```
>>>
>>> And if we relax `Apply` to `Applicative`, we get `traverse_`.
>>>
>>> [^ref5]: https://gitlab.haskell.org/ghc/ghc/merge_requests/1973
>>> [^ref9]:
>>> https://hackage.haskell.org/package/semigroupoids-5.3.3/docs/Data-Semigroup-Foldable-Class.html
>>>
>>> [^ref5]: https://gitlab.haskell.org/ghc/ghc/merge_requests/1973
>>>
>>> Compatibility & migration
>>> -------------------------
>>>
>>> I drafted a compatibility package `foldable1` (github[^ref6],
>>> haddocks[^ref7]),
>>> which I hope could be maintained under github.com/haskell
>>> <http://github.com/haskell> organization.
>>> I can act as a maintainer, with a hope that there won't be a lot
>>> of changes happening in `Data.Foldable1`.
>>>
>>> To my surprise, there's already a package with this name on
>>> Hackage[^ref8] by
>>> M Farkas-Dyck (cc'd). I hope they would donate the name to
>>> Haskell.org <http://Haskell.org> /
>>> CLC;
>>> the package won't have any other good use when `Data.Foldable1` is in
>>> `base`,
>>> then act as a compat package.
>>>
>>> `Data.Foldable1` contains also instances for `Lift`, `Backwards` and
>>> `Reverse`
>>> data types from `transformers`. Perfectly, the `transformers` bundled
>>> with GHC with this change would implement the instances as well.
>>> This change should propage to `transformers-compat` too.
>>>
>>> Similarly, `containers` would have an instance for `Tree` (and non-empty
>>> `Set` and `Map` when they are added).
>>>
>>> `semigroupoids` would need a bit of work, to depend on `foldable1`,
>>> yet the public changes can be kept quite minimal.
>>> I don't think that anything in reverse dependencies of `lens` will be
>>> broken by
>>> this change, if "new" `Foldable1` is re-exported from `semigroupoids`'
>>> `Data.Semigroup.Foldable`[^ref9]
>>>
>>> Other "compat" packages -- like `tagged`, `bifunctors` -- have to be
>>> dealt with
>>> case by case. For example whether they should depend on `foldable1` or
>>> other way around.
>>>
>>> [^ref6]: https://github.com/phadej/foldable1
>>> [^ref7]: https://oleg.fi/haddocks/foldable1/
>>> [^ref8]: https://hackage.haskell.org/package/foldable1
>>> [^ref9]:
>>> https://hackage.haskell.org/package/semigroupoids-5.3.3/docs/Data-Semigroup-Foldable-Class.html
>>>
>>> Unresolved questions
>>> --------------------
>>>
>>> - Should we add `Bifoldable1` too. That should be trivial.
>>> - GHC-8.10 freeze is quite soon, is targeting GHC-8.12/base-4.15 more
>>> realistic?
>>>
>>>
>>> _______________________________________________
>>> Libraries mailing list
>>> Libraries at haskell.org <mailto:Libraries at haskell.org>
>>> http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries
>> _______________________________________________
>> Libraries mailing list
>> Libraries at haskell.org
>> http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/libraries/attachments/20191018/166c196e/attachment.html>
More information about the Libraries
mailing list