Proposal? foldAlt :: (Foldable t, Alternative f) => t a -> f a

David Feuer david.feuer at gmail.com
Wed Nov 29 21:07:05 UTC 2017


I neither support nor oppose this in principle, but I definitely would
only support
it with a more clever implementation. The one above relies on arity analysis or
inlining to avoid building a lousy closure representing (Alt . pure).
foldMapAlt is really
nothing more than foldMap applied to a particular Monoid dictionary:

  foldMapAlt :: forall t f a b. (Foldable t, Alternative f) => (a -> f
b) -> t a -> f b
  foldMapAlt = coerce (foldMap :: (a -> Alt f b) -> t a -> Alt f b)

  foldAlt :: (Foldable t, Alternative f) => t a -> f a
  foldAlt = foldMapAlt pure

David Feuer

On Wed, Nov 29, 2017 at 7:01 AM, Andrew Martin
<andrew.thaddeus at gmail.com> wrote:
> +1 from me. We probably also want foldMapAlt:
>
>     foldMapAlt :: (Foldable t, Alternative f) => (a -> f b) -> t a -> f b
>
> On Tue, Nov 28, 2017 at 11:12 PM, Fumiaki Kinoshita <fumiexcel at gmail.com>
> wrote:
>>
>> We found this quite useful, but we are not 100% about the name and
>> documentation.
>>
>> -- | Try—in the 'Alternative' sense—to return all the values in a
>> 'Foldable'
>> -- container.
>> --
>> -- @
>> -- foldAlt ≡ 'listToMaybe' :: [a] -> 'Maybe' a
>> -- foldAlt ≡ 'maybeToList' :: 'Maybe' a -> [a]
>> -- foldAlt ≡ 'MaybeT' . 'return' :: ('Monad' m) => 'Maybe' a -> 'MaybeT' m
>> a
>> -- foldAlt ≡ 'Pipes.ListT' . 'Pipes.each' :: ('Monad' m) => [a] ->
>> 'Pipes.ListT' m a
>> -- foldAlt ≡ id :: 'Maybe' a -> 'Maybe' a
>> -- @
>> foldAlt :: (Foldable t, Alternative f) => t a -> f a
>> foldAlt = getAlt . foldMap (Alt . pure)
>> {-# INLINE foldAlt #-}
>>
>> I propose adding this to either `Data.Foldable` or `Control.Applicative`.
>> Any thoughts?
>>
>> _______________________________________________
>> Libraries mailing list
>> Libraries at haskell.org
>> http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries
>>
>
>
>
> --
> -Andrew Thaddeus Martin
>
> _______________________________________________
> Libraries mailing list
> Libraries at haskell.org
> http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries
>


More information about the Libraries mailing list