Add Data.Foldable1 to base

Oleg Grenrus oleg.grenrus at iki.fi
Thu Oct 17 17:32:32 UTC 2019


Thanks for the support and comments Dmitrii.

1. I can add usage examples, that's no brainer.
2. Yes, implementing selected members manually can help, that's the 
point of having a lot of members, and not bare foldMap1.
    - Yet I hope that is not a blocker
    - This may be motivated by GHC.Generics, but I don't see instances 
in `relude`?
    -  Non trivial manual implementations should be backed up by some 
benchmark that shows it's worth having more code (which one have test, 
that it's coherent!).
        - That said, I'll add more manual members when I have test setup 
ready. E.g. `head1 :: Compose f g a -> a`, and for `Product` (and 
Generics variants).
    - {-# INLINE #-} everywhere doesn't imply more performance.
    - The `foldable1` package is simple enough playground to add 
benchmarks, there are some already.
3. There is no prior art of disallowing instances with TypeErrors in 
`base`, so I'm wont consider it here either.
    - That's worth an own separate library proposal

- Oleg

On 17.10.2019 19.26, Dmitrii Kovanikov wrote:
> I support this change and I would love to have `Foldable1` in the 
> `base` as well. I find it so useful that we even have it in our 
> alternative prelude called `relude`:
>
> * 
> https://github.com/kowainik/relude/blob/45e112677c6e23759e4742cb695eed20a2cb964a/src/Relude/Extra/Foldable1.hs
>
> I would love to reexport this typeclass by default from `base` instead 
> of maintaining one more `Extra.*` module in `relude`. However, at this 
> point, I like the implementation in `relude` more because:
>
> 1. It has usage examples tested with `doctest`.
> 2. Implements (almost) each function manually and uses {-# INLINE #-} 
> pragmas for better performance.
> 3. In the next release, we're also going to add custom type errors of 
> `Foldable1` instances for data types like ordinary lists to improve UX.
>
> These improvements don't rely on anything `relude`-specific and can be 
> done in `base` as well.
>
> On Thu, Oct 17, 2019 at 5:43 PM 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 /
>     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
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/libraries/attachments/20191017/250a2632/attachment.html>


More information about the Libraries mailing list