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

Dmitrii Kovanikov kovanikov at gmail.com
Wed Nov 11 13:48:22 UTC 2020


Hi Hécate and David,

I'm in support of this proposal. And the module name "Data.Newtype" sounds
good to me 👍

I specifically like the "un" function because it helps to reduce
unnecessary boilerplate. If you have a newtype, it's convenient to specify
an unwrapping function, e.g.

newtype Size = Size
    { unSize :: Int
    }

But then, it becomes awkward in two scenarios:

1. When newtypes are long, e.g. "PasswordHash".
2. When you rename newtypes, you also need to rename the unwrapping
function. While renaming the constructor makes total sense to me, because
you want to be explicit in what particular newtype you wrap your values,
renaming the unwrapping function looks to me like maintaining the
unnecessary boilerplate.

Type inference is a valid concern, but those functions are opt-in, and if
people are worried about type inference, they can use type applications or
good old record fields. Also, the order of type variables for the
implementations from "Relude" is optimized for usage with
"TypeApplications", so it's quite convenient to wrap and unwrap newtypes.

Best regards,
Dmitrii

On Wed, 11 Nov 2020 at 10:01, Hécate <hecate at glitchbra.in> wrote:

> Do you think that they will produce unwanted inference even with
> -XTypeApplications?
> Le 11/11/2020 à 08:42, David Feuer a écrit :
>
> For the most part, I oppose adding these to base. I'm most sympathetic to
> adding (.#) and (#.), originally from the profunctors package, as they seem
> to pop up quite a lot. For the rest, inference can be a real problem.
> coercible-utils goes to quite a lot of trouble to make these functions
> reasonably usable, but I don't think we want that sort of machinery in
> `base`.
>
> On Tue, Nov 10, 2020, 8:23 AM 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
>>
> --
> 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/74385ee2/attachment.html>


More information about the Libraries mailing list