[Proposal] Integration of helpers to operate on Newtypes in base

Keith keith.wygant at gmail.com
Wed Nov 11 18:53:13 UTC 2020


and/or a new Functor method :: (Coercible a b, Functor m) => (b -> c) -> m b -> m c, which includes the (b -> c) -> (a -> b) -> (a -> c) instance.

Sent from my phone with K-9 Mail.

On November 11, 2020 3:22:00 PM UTC, David Feuer <david.feuer at gmail.com> wrote:
>If we add (#.), we should surely also add
>
>  (.#) :: forall b c a to. Coercible a b => (b -> c) -> (a `to` b) -> (a ->
>c)
>  (.#) f = const (coerce f)
>
>I think the more-constrained version of `under` from coercible-utils is
>probably more useful than the wild one you suggest. The former works under
>a single newtype wrapper, using generics to infer what's inside.
>
>On Wed, Nov 11, 2020, 9:54 AM Alexey Kuleshevich <alexey at kuleshevi.ch>
>wrote:
>
>> Thank you for suggesting these, Hécate.
>>
>> I personally don't see much benefit in `un` and `wrap` functions, since it
>> is quite straightforward to use coerce directly:
>>
>> un @Int = coerce @_ @Int
>>
>> and wrap is the same way:
>>
>> wrap @SIze = coerce @_ @Size
>>
>> At what point do we stop creating synonyms? Adding these two functions
>> IMHO is a redundant mental overhead.
>>
>> On the other hand `#.` operator can be quite handy and I'd be totally in
>> favor of exposing it to the world but from a Data.Coerce module instead of
>> a totally new module. However I would also not call it coerced composition
>> operator, because firstly it doesn't really compose functions it just
>> coerces them and secondly it can be made more polymorphic and then it would
>> be useful with other things than just functions:
>>
>> (#.) :: forall a b c proxy. Coercible b c => proxy b c -> (a -> b) -> (a
>> -> c)
>> (#.) _proxy = coerce
>>
>> With regards to `under` I am a somewhat indifferent, but if it was in base
>> I am sure I'd use it. Naming is a bit odd, but I am not the one to bikeshed.
>>
>> Sincerely,
>> Alexey.
>>
>> ‐‐‐‐‐‐‐ Original Message ‐‐‐‐‐‐‐
>> On Tuesday, November 10, 2020 4:23 PM, Hécate <hecate at glitchbra.in> wrote:
>>
>>
>> Hello, CLC and haskell-libraries,
>>
>> I am opening a proposal process to consider the integration of several
>> helper functions in `base`, operating on Newtypes, and all based on
>> `coerce`.
>>
>> My motivations are that we ought to provide a minimum set of tools in
>> order to work effectively with one of our most beloved and ubiquitous
>> language features.
>>
>> Now, these functions that I am about to present to you all do not come out
>> of nowhere. They have been integrated to Kowainik's alternative prelude
>> "Relude", and seem
>> to have found their use amongst their users, me included.
>> Their documentation can be found here =>
>> https://hackage.haskell.org/package/relude-0.7.0.0/docs/Relude-Extra-Newtype.html
>> but I am reproducing them below for convenience:
>>
>> ---
>> un :: forall a n. Coercible a n => n -> a
>>
>> Unwraps value from newtype.
>>
>> ```
>> >>> newtype Size = Size Int deriving Show
>> >>> un @Int (Size 5)
>> 5
>> >>> un (Size 5) == length ['a', 'x', 'b']
>> False
>> ```
>>
>> ---
>> wrap :: forall n a. Coercible a n => a -> n
>>
>> Wraps value to newtype. Behaves exactly as 'un' but has more meaningful
>> name in case you need to convert some value to newtype.
>>
>> ```
>> >>> newtype Flag = Flag Bool deriving (Show, Eq)
>> >>> wrap False == Flag True
>> False
>> ```
>>
>>
>>
>> ---
>> under :: forall n a. Coercible a n => (n -> n) -> a -> a
>>
>> Applies function to the content of newtype. This function is not supposed
>> to be used on newtypes that are created with the help of smart constructors.
>>
>> ```
>> >>> newtype Foo = Foo Bool deriving Show
>> >>> under not (Foo True)
>> Foo False
>> >>> newtype Bar = Bar String deriving Show
>> >>> under (filter (== 'a')) (Bar "abacaba")
>> Bar "aaaa"
>> ```
>>
>> As well as the coerced composition operator:
>>
>> (#.) :: Coercible b c => (b -> c) -> (a -> b) -> (a -> c)
>> (#.) _f = coerce
>> {-# INLINE (#.) #-}
>>
>> Which currently lives in
>> https://hackage.haskell.org/package/base-4.14.0.0/docs/src/Data.Functor.Utils.html#%23
>> but is not exported.
>>
>>
>> Regarding the location of these functions, I either see them living in
>> their own "Data.Newtype", or they could join Data.Coerce.
>> I would personally create a new module as to avoid "polluting" Data.Coerce
>> with non-class functions, but this is my personal preference.
>>
>>
>> Thank you for reading.
>>
>>
>> --
>> Hécate ✨
>> 🐦: @TechnoEmpress
>> IRC: Uniaika
>> WWW: https://glitchbra.in
>> RUN: BSD
>>
>>
>> _______________________________________________
>> 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/20201111/85d92ea7/attachment.html>


More information about the Libraries mailing list