GHC support for the new "record" package

Neil Mitchell ndmitchell at gmail.com
Sat Jan 24 07:45:57 UTC 2015


Hi All,

I fixed a missing "x" in one of the instances. I like the proposal,
mostly because it has nothing to do with records, leaving people to
experiment with records in libraries.

I'm not keen on the use of Template Haskell to define lenses, and the
fact that all base libraries are going to need custom makeLens
definitions set apart from their definitions, plus IV is rather
"wired" into record selectors, which can't be undone later. I think we
can fix some of that by desugaring record definitions to:

data T = MkT {x :: Int}

instance FieldSelector "T" T Int where
     fieldSelector (MkT x) = x

Then someone can, in a library, define:

instance FieldSelector x r a => IV x (r -> a) where
     iv = fieldSelector

Now that records don't mention IV, we are free to provide lots of
different instances, each capturing some properties of each field,
without committing to any one style of lens at this point. Therefore,
we could have record desugaring also produce:

instance FieldSetter "T" T Int where
    fieldSet v (T _) = T v

And also:

instance FieldSTAB "T" T Int where
    fieldSTAB = ... the stab lens ...

(As we find new interesting types of operations over a field, with
different levels of polymorphism etc, we can keep adding new ones
without breaking compatibility, and most users won't care. Prototyping
new ones in Template Haskell is still probably a good idea.) Now
someone can define, in a record library:

instance (FieldSelector x r a, FieldSetter x r a) => IV x (Lens r a) where
    iv = makeLens fieldSelector fieldSet

Or, for people who want #x to be a STAB lens directly (without a Lens
type wrapper), they can omit the IV x (r -> a) instance, and only have
#x have instances producing the STAB lens.

The one downside of this plan is orphan instances, which means if you
are writing a library and use one type of IV declaration (the selector
one), then anyone else building on your library won't be able to use a
different type of IV (the stab one). One potential way to fix that is
to parameterise IV, so you can say (warning, even more half-baked
thoughts ahead):

{-# LANGUAGE ImplicitValues=MyType #-}

Where MyType is a type I've defined in one of my imports, and then
desugar #x to:

iv @ "x" @ MyType @ alpha

And extend IV with an extra type parameter. Now all the Lens library
IV instances can include LensType, and people can mix and match
different record schemes in different modules.

Separately, the pattern: data T = ...; $(makeLens 'T) crops up a lot,
and is gently ugly. I wonder if there should be an extension that
let's you write: data T = ... deriving ('makeLens), or even just
deriving (Lens) which desugars to the same thing?

Thanks, Neil


On Sat, Jan 24, 2015 at 1:04 AM, Johan Tibell <johan.tibell at gmail.com> wrote:
> I really like this proposal (except I would bike shed about the syntax for
> record selector to be dot, like in the majority of languages.)
>
> On Fri, Jan 23, 2015 at 3:41 PM, Simon Peyton Jones <simonpj at microsoft.com>
> wrote:
>>
>> | I just
>> | noticed that it effectively gives us a syntax for identifier-like Symbol
>> | singletons, which could be useful in completely different contexts
>>
>> Indeed so.  I have written a major increment to
>>
>> https://ghc.haskell.org/trac/ghc/wiki/Records/OverloadedRecordFields/Redesign
>> which people reading this thread may find interesting.  Look for "Plan B".
>>
>> For the first time I think I can see a nice, simple, elegant, orthogonal
>> story.
>>
>> Simon
>> _______________________________________________
>> ghc-devs mailing list
>> ghc-devs at haskell.org
>> http://www.haskell.org/mailman/listinfo/ghc-devs
>
>
>
> _______________________________________________
> ghc-devs mailing list
> ghc-devs at haskell.org
> http://www.haskell.org/mailman/listinfo/ghc-devs
>


More information about the ghc-devs mailing list