Re: Magic classes for Overloaded Record Fields, overlaps, FunDeps

2016-05-15 Thread AntC
> Simon Peyton Jones  microsoft.com> writes:
> 

Hi Simon, I don't think there's an 'issue' in the sense fundeps 
can achieve something that type-families can't (or v.v.).
It's more about elegance and ergonomics of the code to achieve it.
(I'll try to avoid a question of judgment shading into a matter of taste ;-)

> |  > I have been vacillating between type families and fundeps for the ORF
> |  > classes. I hadn't fully appreciated this point about overlap, but I
> |  > think it is a reason to prefer fundeps, which is the direction in
> |  > which I'm leaning. I'd be grateful for feedback on this issue though!
> ...
> 
> |  The difficulty remains that as soon as you want overlaps in such a way
> |  that takes you to FunDeps, it's very difficult to 'mix modes' with type
> |  families.
> 
> Can one give a standalone explanation of the fundep/type-family/overlap
> issue here? 
> Or is it explained on a wiki page?
> 

Neither is it specifically about the Overloaded Record Fields design,
nor anonymous records -- it's just that you need a meaty application
like those to demonstrate the subtleties.

I've taken some time to review what's explained where.
I think most of it has come up before, scattered various places.
I see 4 inter-related pieces.
I'll volunteer to write these up, if somebody would like to tell me where.

1. ORF has chosen the `Has` class to be implemented using FunDeps,
rather than type families.
The motivation (for 'option 1') is documented on the wiki,
pointing to the original design (with which you were involved). 
https://ghc.haskell.org/trac/ghc/wiki/Records/OverloadedRecordFields/Design

Choosing FunDeps is right if we move on to anonymous records,
which are bound to face some egregious overlaps, so...

2. Adam's point (and example) about overlap of instances wrt 
anonymous records, has been 'in the wind' before -- e.g. comment here
https://typesandkinds.wordpress.com/2013/04/29/coincident-overlap-in-type-
families/#comment-152
 Detecting the unwanted ambiguity of instance satisfaction
 is discussed in the HList paper's `Lacks` constraint.

3. There's a clumsiness in type families faced with such examples.
Really you want to put an equation in a closed type family
to 'trap' or guard against the ambiguity.
But in effect say "treat this as an error, not a proper instance".
So the Instance Chain work (for example) has a 'fails' outcome.

4. When you've decided to implement some piece using FunDeps,
It works OK to delegate some of the type-level calculations to
(possibly closed) type families, per Adam's response to my q on this thread.
But v.v. if you have some piece using type families,
and then want to delegate to FunDeps because of nasty overlaps;
that tends to get awkward.
It's better than it was with the first releases of type families.


AntC


___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://mail.haskell.org/cgi-bin/mailman/listinfo/glasgow-haskell-users


Re: Magic classes for Overloaded Record Fields, overlaps, FunDeps

2016-04-27 Thread AntC
>
> The labelled "birthday = ..." approach seems
> tantalisingly close to data constructors:
>( Name "Fred", Birthday $ Date 28 4 2016 )
>
> Which takes us (perhaps) to HLIst-style
> Type-Indexed Products.
> How could they fit with ORF?
> Perhaps introduce an implicit label spelled same as the Data Constructor?

Errk! That should be Type Constructor.
(I'm expecting these would be newtypes
with the Data Constructor punning on the Type.)

Thinking on ...

Having been unkind about the higher-kinded stuff,
[I withdraw and apologise.]
I wonder if we could use it?
Does this have any likelihood of working?

import Data.Kind
class IskLabel k (x :: k) a where fromkLabel :: Proxy# x -> a
instance IskLabel Symbol x (r -> a) where ...
 -- indexing by label
instance IskLabel (Type -> Type) t (r -> a) where ...
 -- indexing by Type Constructor

> Except starting lower case,
> otherwise the #name prefix will throw a wobbly.

??Is that actually true?
H98 field labels must be lower case,
so all the examples are.
But Symbol can be upper??


AntC

___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://mail.haskell.org/cgi-bin/mailman/listinfo/glasgow-haskell-users


Re: Magic classes for Overloaded Record Fields, overlaps, FunDeps

2016-04-27 Thread AntC
> Adam Gundry  well-typed.com> writes:
> ...
> 
> P.S. If you have any thoughts on the interaction between ORF and
> encodings of anonymous records, I'd be interested to hear them.

Are you sure you want to open up that question? ;-)
Nikita's record library has certainly given food for thought.

Before we start into anonymous records,
I think we should figure out the path that gets to
extensible records, truncatable records, mergable records,
joinable records, ...
So I'm worried about comments from Nikita
that extensibility is beyond what's possible under that approach.

In considering that, I'm not sure that "anonymous records" are very much
like H98 field-labelled data types.
(Which is to say H98 records are not very much like records ;-)
Trouble is, H98 records have gobbled up so much of the available syntax.

Let's frame the requirement instead as 'labelled tuples'.
Then I'm looking greedily at round-bracket syntax:

( name = "Fred", birthday = (day = 28, month = 4, year = 2016) )

I don't know how much Nikita was limited by what's possible
with src-xtns, so I won't bikeshed more about syntax.

Can we use the same ORF mechanisms under the covers
for both labelled tuples and records?
Certainly it would be nice to support intra-conversion routines:

labelledDT = fromLabels ( name = ... )
labelledTuple = toLabels labelledDT

I rather think I don't care about the implementation of access
-- that is, whether lenses and which style of lens --
providing it just works. (And doesn't give impenetrable
error messages. That's a bit of a worry with all this higher-kinded
engineering going on in GHC 8.0.
Will ORF's 'Magic Type Classes' have bit-rotted
by the time you get to release them?
Do we call that R.Eisenberg uncertainty? ;-)

Now if you have a label "birthday",
you probably want the field to hold a Date,
not just some arbitrary type 'a'.
And that's what I find unergonomic about the 
label-as-Symbol approach.
(For Nikita's records you give a type for the field alongside the label
 in the record signature.
 But why the need to state the obvious,
 and repeat it for every record that uses "birthday"?)

The labelled "birthday = ..." approach seems
tantalisingly close to data constructors:
( Name "Fred", Birthday $ Date 28 4 2016 )

Which takes us (perhaps) to HLIst-style
Type-Indexed Products.
How could they fit with ORF?
Perhaps introduce an implicit label spelled same as the Data Constructor?
Except starting lower case,
otherwise the #name prefix will throw a wobbly.

What gave me a queasy feeling looking at Nikita's Records
is the alternating labels and data type.
  ::  Record2 "name" String "birthday" Date

I'd rather see explicit pairing of label and data.

newtype Label (l :: Symbol) a = Label a
rec :: Record2 (Label "name" String, Label "birthday" Date)

The newtype should mean zero runtime cost.

I can see a couple of reasons behind Nikita's approach
that might have been getting in the way of that.

Sequencing the labels into alphabetic order.
(Which is probably to implement the second reason.)
Now certainly we want the label position to be arbitrary
in anonymous records. But that's just a bit of representation hiding.
Resequencing them alphabetically means they show
in a probably unmeaningful format.
It also might be getting in the way of extensibility. 
To compare two records with the same labels,
does need the fields in the same seq.
We could do that with:

labelledTuple `asLabelSeqOf`canonicalLabels

The second reason would be to check for duplicate labels.
Hmm is that essential? YMMV
As far as I can see, duplicate labels within a tuple
are only problematic when you want to get/set
a field by that label.
Your example [1] isn't upset by:
  z4 = getField (proxy# :: Proxy# "bar") (Record3 True False "ok"
   :: Record3 "foo" Bool "foo" Bool "bar" String)

Again if it is a requirement,
it's easy enough to build a smart constructor wrapper
that validates for duplicate labels, á la HList.


Did that answer (any of) your question?

AntC

> 
> [1] https://gist.github.com/adamgundry/7292df8cef62fd6750885be3f5f892e7
> 
___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://mail.haskell.org/cgi-bin/mailman/listinfo/glasgow-haskell-users


RE: Magic classes for Overloaded Record Fields, overlaps, FunDeps

2016-04-27 Thread Simon Peyton Jones
|  > I have been vacillating between type families and fundeps for the ORF
|  > classes. I hadn't fully appreciated this point about overlap, but I
|  > think it is a reason to prefer fundeps, which is the direction in
|  > which I'm leaning. I'd be grateful for feedback on this issue though!
...

|  The difficulty remains that as soon as you want overlaps in such a way
|  that takes you to FunDeps, it's very difficult to 'mix modes' with type
|  families.

Can one give a standalone explanation of the fundep/type-family/overlap issue 
here? Or is it explained on a wiki page?

Simon

___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://mail.haskell.org/cgi-bin/mailman/listinfo/glasgow-haskell-users


Re: Magic classes for Overloaded Record Fields, overlaps, FunDeps

2016-04-26 Thread AntC
> > On 26/04/16 09:20, AntC wrote:
> > There's an intriguing comment here wrt anonymous records: ...
> 
> I'm afraid the sentence on the wiki page is slightly misleading, ...
>  with the change to functional dependencies,
> the overlapping instances solution works rather nicely, 
> in that it works if the field labels are distinct
> and reports an error if not [1]. 

Thanks Adam, we're very much thinking along the same lines.

Yes that's exactly where I am at.
I too like the error message re overlapping instances.

Contrast that for an HList style solution,
you get instance match on the leftmost/outermost appearance
of the label. So to detect duplicates you need a `Lacks`
superclass constraint on the HList's tail.
And to get `Lacks` to work,
you need to create an instance;
for which you then need an impossible-to-fulfill
superclass constraint.
Even with the best of documentation,
you get a dense error message,
quite possibly pointing to the wrong place.

So unlike HLists, Nikita's Records are 'flat'
(same as if you used plain tuples)
and the instance matcher can look at all elements at the same time.

Furthermore (closed) type families suffer a similar difficulty.
The instance equations are ordered, so will pick the leftmost
(or rightmost) appearance without complaint.
To detect ambiguous getFields you need first a guard equation
   HasField n1 (Record2 n1 v1 n1 v2) = error: overlap

For a two-tuple that's OK.
For more than two you need guard equations
for all of the ambiguous perms and combs.
For a 24-tuple that's horrendous.
For tuple extension or joining your head explodes.

Even if we could automate generating the ambig instances somehow,
it just feels wrong to get an instance/equation match
when what you want is an error.

> 
> I have been vacillating between type families and fundeps for the ORF
> classes. I hadn't fully appreciated this point about overlap, but I
> think it is a reason to prefer fundeps, which is the direction in which
> I'm leaning. I'd be grateful for feedback on this issue though!
> 

Yes, this seems a 'featurette' of Overlaps/FunDeps
compared to closed type families.
Should I regard it as a 'happy accident'
 that might stop working some day?
It does seem a pretty fundamental requirement for Overlaps
-- providing of course IncoherentInstances is never switched on
in some distant module.

> 
> In general, to avoid overlapping instances, one trick is to introduce a
> closed type family that discriminates between the parameters, 
> along with an auxiliary class whose instances match
>  on the result of the type family. ...

Thanks. Yes I'm aware of that approach from HList.
It works a little more nicely with type families.

The difficulty remains that as soon as you want overlaps
in such a way that takes you to FunDeps,
it's very difficult to 'mix modes' with type families.


AntC

> 
> [1] https://gist.github.com/adamgundry/7292df8cef62fd6750885be3f5f892e7
> 




___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://mail.haskell.org/cgi-bin/mailman/listinfo/glasgow-haskell-users


Re: Overloaded record fields

2013-07-18 Thread harry
+1 for the -XDotPostfixApply proposal



--
View this message in context: 
http://haskell.1045720.n5.nabble.com/Overloaded-record-fields-tp5731998p5733121.html
Sent from the Haskell - Glasgow-haskell-users mailing list archive at 
Nabble.com.

___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Overloaded record fields

2013-07-01 Thread Barney Hilken
(sorry, accidentally failed to send this to the list)

All this extra syntax, whether it's ., #, or {} seems very heavy for a problem 
described as very rare.
Why not simply use a declaration

field name

whose effect is to declare 

name :: r {name ::t} = r - t
name = getFld

unless name is already in scope as a field name, in which case the declaration 
does nothing?
Then we could continue to use standard functional notation for projection, and 
still deal with the
case of unused projections.

Barney.


___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Overloaded record fields

2013-07-01 Thread Adam Gundry
Hi all,

I have amended the plan [1] as a result of the ongoing discussion,
including leaving the syntax alone for the time being, so record
projections are written prefix.

Regarding Barney's suggestion of field declarations:

On 01/07/13 10:50, Barney Hilken wrote:
 All this extra syntax, whether it's ., #, or {} seems very heavy for a 
 problem described as very rare.
 Why not simply use a declaration
 
   field name
 
 whose effect is to declare 
 
   name :: r {name ::t} = r - t
   name = getFld
 
 unless name is already in scope as a field name, in which case the 
 declaration does nothing?

This makes sense. I guess the question is whether a new declaration form
is justified. The implementation is slightly more subtle than you
suggest, because we don't know whether `name` will be brought into scope
as a field later, in which case the definition would clash with the
actual field. It should be equivalent to defining

data Unused { name :: () }
data Unused2 { name :: () }

(twice so that there is always ambiguity about a use of `name`).

Adam

[1]
http://hackage.haskell.org/trac/ghc/wiki/Records/OverloadedRecordFields/Plan



___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Overloaded record fields

2013-06-30 Thread Carter Schonwald
  | Subject: Re: Overloaded record fields
  |
  | 
  |  ... the orthogonality is also an important benefit.
  |   It could allow people like Edward and others who dislike ...
  |   to still use ...
  | 
  |
  | Folks, I'm keenly aware that GSoC has a limited timespan; and that
 there
  | has already been much heat generated on the records debate.
  |
  | Perhaps we could concentrate on giving Adam a 'plan of attack', and
 help
  | resolving any difficulties he runs into. I suggest:
  |
  | 1. We postpone trying to use postfix dot:
  |It's controversial.
  |The syntax looks weird whichever way you cut it.
  |It's sugar, whereas we'd rather get going on functionality.
  |(This does mean I'm suggesting 'parking' Adam's/Simon's syntax,
 too.)
  |
  | 2. Implement class Has with method getFld, as per Plan.
  |
  | 3. Implement the Record field constraints new syntax, per Plan.
  |
  | 4. Implicitly generate Has instances for record decls, per Plan.
  |Including generating for imported records,
  |even if they weren't declared with the extension.
  |(Option (2) on-the-fly.)
  |
  | 5. Implement Record update, per Plan.
  |
  | 6. Support an extension to suppress generating field selector
 functions.
  |This frees the namespace.
  |(This is -XNoMonoRecordFields in the Plan,
  | but Simon M said he didn't like the 'Mono' in that name.)
  |Then lenses could do stuff (via TH?) with the name.
  |
  |[Those who've followed so far, will notice that
  | I've not yet offered a way to select fields.
  | Except with explicit getFld method.
  | So this 'extension' is actually 'do nothing'.]
  |
  | 7. Implement -XPolyRecordFields, not quite per Plan.
  |This generates a poly-record field selector function:
  |
  |x :: r {x :: t} = r - t-- Has r x t = ...
  |x = getFld
  |
  | And means that H98 syntax still works:
  |
  |x e -- we must know e's type to pick which instance
  |
  | But note that it must generate only one definition
  | for the whole module, even if x is declared in multiple data types.
  | (Or in both a declared and an imported.)
  |
  | But not per the Plan:
  | Do _not_ export the generated field selector functions.
  | (If an importing module wants field selectors,
  |  it must set the extension, and generate them for imported data
  | types.
  |  Otherwise we risk name clash on the import.
  |  This effectively blocks H98-style modules
  |  from using the 'new' record selectors, I fear.)
  | Or perhaps I mean that the importing module could choose
  | whether to bring in the field selector function??
  | Or perhaps we export/import-control the selector function
  | separately to the record and field name???
  |
  | Taking 6. and 7. together means that for the same record decl:
  | * one importing module could access it as a lens
  | * another could use field selector functions
  |
  | 8. (If GSoC hasn't expired yet!)
  |Implement -XDotPostfixFuncApply as an orthogonal extension ;-).
  |
  | AntC
  |
  |
  |
  |
  | ___
  | Glasgow-haskell-users mailing list
  | Glasgow-haskell-users@haskell.org
  | http://www.haskell.org/mailman/listinfo/glasgow-haskell-users
  ___
  Glasgow-haskell-users mailing list
  Glasgow-haskell-users@haskell.org
  http://www.haskell.org/mailman/listinfo/glasgow-haskell-users

 ___
 Glasgow-haskell-users mailing list
 Glasgow-haskell-users@haskell.org
 http://www.haskell.org/mailman/listinfo/glasgow-haskell-users

___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Overloaded record fields

2013-06-30 Thread AntC
 Malcolm Wallace malcolm.wallace at me.com writes:
 
 I believe Simon's point is that, if dot is special, we can infer 
the Has type above, even if the compiler is
 not currently aware of any actual record types that contain a foo 
field. ...
 
 (For the record, I deeply dislike making dot special, ...

Simon, Malcolm, here's a solution (at risk of more bikeshedding on syntax).

e { foo }

  * The braces say 'here comes a record'.
  * Also say 'expect funny business with names'.
  * The absence of `=` says this is getFld, not update.
  * This is not currently valid syntax [**], so we don't break code.
  * It's postfix. (And only a couple more chars than infix dot.)
  * So perhaps an IDE can see the opening brace and prompt for fields?
(Perhaps some IDE's do this already for record update?)
  * If we need to disambiguate the record type:

e :: T Int { foo }   -- as the Plan suggests for record update

Development would fit into the 'sequence of attack' as 5b., with record 
update syntax.

[**] ghc 7.6.1 rejects the syntax, and suggests you need NamedFieldPuns.
 But if you set that, you get a weird type error,
 which suggests ghc is de-sugaring to { foo = foo }.
 We'd have to fix that.

The syntax is valid in a pattern (with NamedFieldPuns).
Indeed the proposed syntax echoes pattern match:

e .$ (\ (MkFoo { foo }) - foo )   -- (.$) = flip ($)

We'd better insist NamedFieldPuns is on to allow the proposal.
Otherwise the syntax would have to be:

e { foo = foo } -- ambiguous with update

In fact the proposal is an enhancement to NamedFieldPuns,
'repurposed' for OverloadedRecordFields.

Possible future development:

e { foo, bar, baz }  -- produces a tuple ( _, _, _ )
 -- with fields in order given
 -- _not_ 'canonical' order in the data type

  * By coincidence, that syntax is per one of the dialects for
relational algebra projection over a tuple.

  * Possibly useful for overloaded comprehensions?:

[ x { foo, bar, baz } | x - xs ]

[ { foo, bar } | { foo, bar, baz } - xs, baz = 27 ]


AntC


___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


RE: Overloaded record fields

2013-06-28 Thread Simon Peyton-Jones
| Folks, I'm keenly aware that GSoC has a limited timespan; and that there
| has already been much heat generated on the records debate.

I am also keenly aware of this.  I think the plan Ant outlines below makes 
sense; I'll work on it with Adam.

I have, however, realised why I liked the dot idea.  Consider

f r b = r.foo  b

With dot-notation baked in (non-orthogonally), f would get the type

f :: (r { foo::Bool }) = r - Bool - Bool

With the orthogonal proposal, f is equivalent to
f r b = foo r  b

Now it depends. 

* If there is at least one record in scope with a field foo 
  and no other foo's, then you get the above type

* If there are no records in scope with field foo
  and no other foo's, the program is rejected

* If there are no records in scope with field foo
  but there is a function foo, then the usual thing happens.

This raises the funny possibility that you might have to define a local type
data Unused = U { foo :: Int }
simply so that there *is* at least on foo field in scope.

I wanted to jot this point down, but I think it's a lesser evil than falling 
into the dot-notation swamp.  After all, it must be vanishingly rare to write a 
function manipulating foo fields when there are no such records around. It's 
just a point to note (NB Adam: design document).

Simon

| -Original Message-
| From: glasgow-haskell-users-boun...@haskell.org [mailto:glasgow-haskell-
| users-boun...@haskell.org] On Behalf Of AntC
| Sent: 27 June 2013 13:37
| To: glasgow-haskell-users@haskell.org
| Subject: Re: Overloaded record fields
| 
| 
|  ... the orthogonality is also an important benefit.
|   It could allow people like Edward and others who dislike ...
|   to still use ...
| 
| 
| Folks, I'm keenly aware that GSoC has a limited timespan; and that there
| has already been much heat generated on the records debate.
| 
| Perhaps we could concentrate on giving Adam a 'plan of attack', and help
| resolving any difficulties he runs into. I suggest:
| 
| 1. We postpone trying to use postfix dot:
|It's controversial.
|The syntax looks weird whichever way you cut it.
|It's sugar, whereas we'd rather get going on functionality.
|(This does mean I'm suggesting 'parking' Adam's/Simon's syntax, too.)
| 
| 2. Implement class Has with method getFld, as per Plan.
| 
| 3. Implement the Record field constraints new syntax, per Plan.
| 
| 4. Implicitly generate Has instances for record decls, per Plan.
|Including generating for imported records,
|even if they weren't declared with the extension.
|(Option (2) on-the-fly.)
| 
| 5. Implement Record update, per Plan.
| 
| 6. Support an extension to suppress generating field selector functions.
|This frees the namespace.
|(This is -XNoMonoRecordFields in the Plan,
| but Simon M said he didn't like the 'Mono' in that name.)
|Then lenses could do stuff (via TH?) with the name.
| 
|[Those who've followed so far, will notice that
| I've not yet offered a way to select fields.
| Except with explicit getFld method.
| So this 'extension' is actually 'do nothing'.]
| 
| 7. Implement -XPolyRecordFields, not quite per Plan.
|This generates a poly-record field selector function:
| 
|x :: r {x :: t} = r - t-- Has r x t = ...
|x = getFld
| 
| And means that H98 syntax still works:
| 
|x e -- we must know e's type to pick which instance
| 
| But note that it must generate only one definition
| for the whole module, even if x is declared in multiple data types.
| (Or in both a declared and an imported.)
| 
| But not per the Plan:
| Do _not_ export the generated field selector functions.
| (If an importing module wants field selectors,
|  it must set the extension, and generate them for imported data
| types.
|  Otherwise we risk name clash on the import.
|  This effectively blocks H98-style modules
|  from using the 'new' record selectors, I fear.)
| Or perhaps I mean that the importing module could choose
| whether to bring in the field selector function??
| Or perhaps we export/import-control the selector function
| separately to the record and field name???
| 
| Taking 6. and 7. together means that for the same record decl:
| * one importing module could access it as a lens
| * another could use field selector functions
| 
| 8. (If GSoC hasn't expired yet!)
|Implement ‑XDotPostfixFuncApply as an orthogonal extension ;-).
| 
| AntC
| 
| 
| 
| 
| ___
| Glasgow-haskell-users mailing list
| Glasgow-haskell-users@haskell.org
| http://www.haskell.org/mailman/listinfo/glasgow-haskell-users
___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Overloaded record fields

2013-06-28 Thread Daniel Trstenjak

Hi Evan,

 1 - Add an option to add a 'deriving (Lens)' to record declarations.
 That makes the record declare lenses instead of functions.

Well, no, that's exactly the kind of magic programming language hackery,
that Haskell shouldn't be part of.

Deriving should only add something, but not change the behaviour of the 
underived case.

I'm really for convenience, but it shouldn't be added willy-nilly,
because in the long term this creates more harm.


Greetings,
Daniel

___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Overloaded record fields

2013-06-28 Thread AntC
 Simon Peyton-Jones simonpj at microsoft.com writes:
 
 I have, however, realised why I liked the dot idea.  Consider
 
   f r b = r.foo  b
 

Thanks Simon, I'm a little puzzled what your worry is.

 With dot-notation baked in (non-orthogonally), f would get the type

   f :: (r { foo::Bool }) = r - Bool - Bool
 
 With the orthogonal proposal, f is equivalent to
   f r b = foo r  b
 
 Now it depends. 
 
 * If there is at least one record in scope with a field foo 
   and no other foo's, then you get the above type
 

I don't think the compiler has to go hunting for 'records in scope'.
There is one of two situations in force:

Step 6. -XNoMonoRecordFields  
Then function foo is not defined.
(Or at least not by the record fields mechanism.)
This is exactly so that the program can define
its own access method (perhaps lenses,
 perhaps a function foo with a different type,
 the namespace is free for experiments).

Step 7. -XPolyRecordFields
Then function foo is defined with the same type
as would be for (.foo) in the baked-in approach. IOW

f r b = (.foo) r  b -- baked-in
f r b = foo r  b-- non-baked-in, as you put

foo = getFld :: (r { foo :: Bool } ) = r - Bool

So the type you give would be inferred for function f.

At the use site for f (say applied to record type Bar).
We need:

instance (t ~ Bool) = Has Bar foo t where ...

So generate that on-the-fly.


If the program declares a separate function foo,
then we have 'vanilla' name clash, just like double-declaring any name.
(Just like a H98 record with field foo, then declaring a function foo.)


Or is the potential difficulty something like this:

+ function f is defined as above in a module with -XPolyRecordFields.
+ function f is exported/imported.
+ the importing module also uses -XPolyRecordFields.
+ now in the importing module we try to apply f to a record.
  (say type Baz, not having field foo)
+ the compiler sees the (r { foo :: Bool }) constraint from f.

The compiler tries to generate on-the-fly:

instance (t ~ Bool) = Has Baz foo t where
getFld (MkBaz { foo = foo }) = foo  -- no such field

But this could happen within a single module.
At this point, we need Adam to issue a really clear error message.


Or perhaps the importing module uses H98 records.
And it applies f to a record type Baz.
And there is a field foo type Bool in data type Baz.
Then there's a function:

foo :: Baz - Bool   -- H98 field selector

Now we _could_ generate an instance `Has Baz foo t`.
And it wouldn't clash with Mono field selector foo.

But the extension is switched off. So we'll get:

No instance `Has Baz foo t` arising from the use of `f` ...



(It's this scenario that led me to suggest in step 7
that when exporting field foo,
_don't_ export field selector function foo.)


 
 This raises the funny possibility that you might have to define a local 
type
   data Unused = U { foo :: Int }
 simply so that there *is* at least on foo field in scope.
 

No, I don't see that funny decls are needed.


AntC

 
 | -Original Message-
 | From: glasgow-haskell-users On Behalf Of AntC
 | Sent: 27 June 2013 13:37
 | 
 | 7. Implement -XPolyRecordFields, not quite per Plan.
 |This generates a poly-record field selector function:
 | 
 |x :: r {x :: t} = r - t-- Has r x t = ...
 |x = getFld
 | 
 | And means that H98 syntax still works:
 | 
 |x e -- we must know e's type to pick which instance
 | 
 | But note that it must generate only one definition
 | for the whole module, even if x is declared in multiple data types.
 | (Or in both a declared and an imported.)
 | 
 | But not per the Plan:
 | Do _not_ export the generated field selector functions.
 | (If an importing module wants field selectors,
 |  it must set the extension, and generate them for imported data
 | types.
 |  Otherwise we risk name clash on the import.
 |  This effectively blocks H98-style modules
 |  from using the 'new' record selectors, I fear.)
 | Or perhaps I mean that the importing module could choose
 | whether to bring in the field selector function??
 | Or perhaps we export/import-control the selector function
 | separately to the record and field name???
 | 



___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Overloaded record fields

2013-06-28 Thread Malcolm Wallace

On 28 Jun 2013, at 12:16, AntC wrote:

 Thanks Simon, I'm a little puzzled what your worry is.
 
  f r b = r.foo  b

 With dot-notation baked in (non-orthogonally), f would get the type
 
  f :: (r { foo::Bool }) = r - Bool - Bool
 
 With the orthogonal proposal, f is equivalent to
  f r b = foo r  b


I believe Simon's point is that, if dot is special, we can infer the Has type 
above, even if the compiler is not currently aware of any actual record types 
that contain a foo field.  If dot is not special, then there *must* be some 
record containing foo already in scope, otherwise you cannot infer that type 
- you would get a name not in scope error instead.

The former case, where you can use a selector for a record that is not even 
defined yet, leads to good library separation.  The latter case couples 
somewhat-polymorphic record selectors to actual definitions.

Unless you require the type signature to be explicit, instead of inferred.

(For the record, I deeply dislike making dot special, so I would personally go 
for requiring the explicit type signature in this situation.)

Regards,
Malcolm
___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Overloaded record fields

2013-06-28 Thread AntC
 Malcolm Wallace malcolm.wallace at me.com writes:
 
  
  With the orthogonal proposal, f is equivalent to
 f r b = foo r  b
 
 I believe Simon's point is that, if dot is special, we can infer 
the Has type above, even if the compiler is
 not currently aware of any actual record types that contain a foo 
field.

Thanks Malcolm, yes I think I do understand what Simon had in mind.
In effect .foo is a kind of literal.
It 'stands for' the String type foo :: Symbol parameter to Has.
(And that's very odd, as SPJ's SORF write-up points out, because that 
isn't an explicit parameter to getFld.)

But contrast H98 field selector functions. They're regular functions, 
nothing about them to show they're specific to a record decl. And they 
work (apart from the non-overloadability).

So all we're doing is moving to foo being an overloaded field selection 
function. And it's a regular overloaded function, which resolves through 
instance matching.


  If dot is not special, then there
 *must* be some record containing foo already in scope, ...

I think you have it the wrong way round.
Field selector function foo must be in scope.
(Or rather what I mean is that name foo must be in scope,
and it's in-scope binding must be to a field selector.)

And function foo must be in scope because there's a record in scope with 
field foo, that generated the function via -XPolyRecordFields.


 
 ..., where you can use a selector for a record that is not
 even defined yet, leads to good library separation.

You can't do that currently. So I think you're asking for something beyond 
Simon's smallest increment.

 
 Unless you require the type signature to be explicit, instead of 
inferred.

Well, I think that's reasonable to require a signature if you use a 
selector for a record that is not even defined yet. I'm not convinced 
there's a strong enough use case to try to support auto type inference. 
Simon said vanishingly rare.


 
 (For the record, I deeply dislike making dot special, so I would 
personally go for requiring the explicit
 type signature in this situation.)
 
 Regards,
 Malcolm
 





___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Overloaded record fields

2013-06-28 Thread Dominique Devriese
Simon,

I see your point.  Essentially, the original proposal keeps the
namespace for field names syntactically distinguishable from that of
functions, so that the type given to r.foo doesn't depend on what is
in scope.  (.foo) is always defined and it is always a function of
type (r { foo::t }) = r - t. With the orthogonal proposal, it
would only be defined if there is a record with a foo field in scope,
although its definition or type does not actually depend on the
record.   One would then need to define an Unused record with a field
foo, or declare the following
  foo :: r { foo ::t} = r - t
  foo = getFld
to essentially declare that foo should be treated as a field selector
and I'm not even sure if type inference would work for this
definition... Maybe we could provide syntax like a declaration field
foo; as equivalent to the latter, but I have to acknowledge that this
is a downside for the orthogonal proposal.

Regards,
Dominique

2013/6/28 Simon Peyton-Jones simo...@microsoft.com:
 | Folks, I'm keenly aware that GSoC has a limited timespan; and that there
 | has already been much heat generated on the records debate.

 I am also keenly aware of this.  I think the plan Ant outlines below makes 
 sense; I'll work on it with Adam.

 I have, however, realised why I liked the dot idea.  Consider

 f r b = r.foo  b

 With dot-notation baked in (non-orthogonally), f would get the type

 f :: (r { foo::Bool }) = r - Bool - Bool

 With the orthogonal proposal, f is equivalent to
 f r b = foo r  b

 Now it depends.

 * If there is at least one record in scope with a field foo
   and no other foo's, then you get the above type

 * If there are no records in scope with field foo
   and no other foo's, the program is rejected

 * If there are no records in scope with field foo
   but there is a function foo, then the usual thing happens.

 This raises the funny possibility that you might have to define a local type
 data Unused = U { foo :: Int }
 simply so that there *is* at least on foo field in scope.

 I wanted to jot this point down, but I think it's a lesser evil than falling 
 into the dot-notation swamp.  After all, it must be vanishingly rare to write 
 a function manipulating foo fields when there are no such records around. 
 It's just a point to note (NB Adam: design document).

 Simon

 | -Original Message-
 | From: glasgow-haskell-users-boun...@haskell.org [mailto:glasgow-haskell-
 | users-boun...@haskell.org] On Behalf Of AntC
 | Sent: 27 June 2013 13:37
 | To: glasgow-haskell-users@haskell.org
 | Subject: Re: Overloaded record fields
 |
 | 
 |  ... the orthogonality is also an important benefit.
 |   It could allow people like Edward and others who dislike ...
 |   to still use ...
 | 
 |
 | Folks, I'm keenly aware that GSoC has a limited timespan; and that there
 | has already been much heat generated on the records debate.
 |
 | Perhaps we could concentrate on giving Adam a 'plan of attack', and help
 | resolving any difficulties he runs into. I suggest:
 |
 | 1. We postpone trying to use postfix dot:
 |It's controversial.
 |The syntax looks weird whichever way you cut it.
 |It's sugar, whereas we'd rather get going on functionality.
 |(This does mean I'm suggesting 'parking' Adam's/Simon's syntax, too.)
 |
 | 2. Implement class Has with method getFld, as per Plan.
 |
 | 3. Implement the Record field constraints new syntax, per Plan.
 |
 | 4. Implicitly generate Has instances for record decls, per Plan.
 |Including generating for imported records,
 |even if they weren't declared with the extension.
 |(Option (2) on-the-fly.)
 |
 | 5. Implement Record update, per Plan.
 |
 | 6. Support an extension to suppress generating field selector functions.
 |This frees the namespace.
 |(This is -XNoMonoRecordFields in the Plan,
 | but Simon M said he didn't like the 'Mono' in that name.)
 |Then lenses could do stuff (via TH?) with the name.
 |
 |[Those who've followed so far, will notice that
 | I've not yet offered a way to select fields.
 | Except with explicit getFld method.
 | So this 'extension' is actually 'do nothing'.]
 |
 | 7. Implement -XPolyRecordFields, not quite per Plan.
 |This generates a poly-record field selector function:
 |
 |x :: r {x :: t} = r - t-- Has r x t = ...
 |x = getFld
 |
 | And means that H98 syntax still works:
 |
 |x e -- we must know e's type to pick which instance
 |
 | But note that it must generate only one definition
 | for the whole module, even if x is declared in multiple data types.
 | (Or in both a declared and an imported.)
 |
 | But not per the Plan:
 | Do _not_ export the generated field selector functions.
 | (If an importing module wants field selectors,
 |  it must set the extension, and generate them for imported data
 | types.
 |  Otherwise we risk name clash on the import

Re: Overloaded record fields

2013-06-27 Thread AntC
 Edward Kmett ekmett at gmail.com writes:
 
 Let me take a couple of minutes to summarize how the lens approach 
tackles the composition problem today without requiring confusing changes 
in the lexical structure of the language. 

Thank you Edward, I do find the lens approach absolutely formidable. And I 
have tried to read the (plentiful) documentation. But I haven't seen a 
really, really simple example that shows the correspondence with H98 
records and fields -- as simple as Adam's example in the wiki. (And this 
message from you doesn't achieve that either. Sorry, but tl;dr, and there 
isn't even a record decl in it.)

Does the lens approach meet SPJ's criteria of:
 * It is the smallest increment I can come up with that
   meaningfully addresses the #1 pain point (the inability to
   re-use the same field name in different records).

 * It is backward-compatible.

[I note BTW that as the Plan currently stands, the '.field' postfix 
pseudo-operator doesn't rate too high on backward-compatible.]

I do think that freeing up the name space by not auto-generating a record-
type-bound field selector will help some of the naming work-rounds in the 
lens TH.

 ...

You say:
 
  template-haskell functions for lens try to tackle the SORF/DORF-like 
aspects. These are what Greg Weber was referring to in that earlier email. 
 

errm I didn't see an email from Greg(?)

AntC


___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Overloaded record fields

2013-06-27 Thread Dominique Devriese
Simon,

Yes, your summary is exactly what I meant.

2013/6/26 Simon Peyton-Jones simo...@microsoft.com:
 In fact, your observation allows us to regard our proposal as consisting of 
 two entirely orthogonal parts
   * Generalise the type of record field selectors
   * Introduce period as reverse function application

As Anthony points out below, I think the orthogonality is also an
important benefit.  It could allow people like Edward and others who
dislike DotAsPostFixApply to still use OverloadedRecordFields.  I
expect just the OverloadedRecordFields extension would fit reasonably
well into the existing lens libraries somehow.

Regards
Dominique

___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Overloaded record fields

2013-06-27 Thread Edward Kmett
On Thu, Jun 27, 2013 at 2:14 AM, AntC anthony_clay...@clear.net.nz wrote:

  Edward Kmett ekmett at gmail.com writes:
 
  Let me take a couple of minutes to summarize how the lens approach
 tackles the composition problem today without requiring confusing changes
 in the lexical structure of the language.

 Thank you Edward, I do find the lens approach absolutely formidable. And I
 have tried to read the (plentiful) documentation. But I haven't seen a
 really, really simple example that shows the correspondence with H98
 records and fields -- as simple as Adam's example in the wiki. (And this
 message from you doesn't achieve that either. Sorry, but tl;dr, and there
 isn't even a record decl in it.)


There was this one buried down near the bottom.

data Foo = Foo { _fooX, _fooY :: Int }

fooY f (Foo x y) = Foo x $ f y

We could implement that lens more like:

fooY :: Lens' Foo Int
fooY f s = (\a - r { _fooY = a }) $ f (_fooY s)

if you really want to see more record sugar in there, but the code means
the same thing.

So let me show you exactly what you just asked for. The correspondence with
the getter and setter for the field:

The correspondence with the getter comes from choosing to use the
appropriate functor. With some thought it becomes obvious that it should be
Const. I won't explain why as that apparently triggers *tl;dr. *;)

s ^. l = getConst (l Const s)


Recall that fmap f (Const a) = Const a, so


s ^. fooY = getConst ((\a - r { _fooY = a }) $ Const (_fooY s)) =
getConst (Const (_fooY s)) = _fooY s


and we can recover the setter by choosing the Functor to be Identity.


modify l f s = runIdentity (l (Identity . f) s)


modify fooY f s = runIdentity (fooY (Identity . f) s) = runIdentity
((\a - r { _fooY = a }) $ (Identity . f) (_fooY s) )


if you remove the newtype noise thats the same as


modify fooY f s = s { _fooY = f (_fooY s) }


Similarly after expansion:


set fooY a s = s { _fooY = a }


I sought to give a feel for the derivation in the previous email rather
than specific examples, but to work through that and the laws takes a fair
bit of text. There isn't any getting around it.



With language support one could envision an option where record
declarations cause the generation of lenses using whatever scheme one was
going to use for the 'magic (.)' in the first place.

The only difference is you get something that can already be used as both
the getter and setter and which can be composed with other known
constructions as well, isomorphisms, getters, setters, traversals, prisms,
and indexed variants all fit this same mold and have a consistent
theoretical framework.

Does the lens approach meet SPJ's criteria of:
  * It is the smallest increment I can come up with that
meaningfully addresses the #1 pain point (the inability to
re-use the same field name in different records).


The lens approach is *orthogonal* to the SORF/DORF design issue. It simply
provides a way to make the field accessors compose together in a more
coherent way, and helps alleviate the need to conconct confusing semantics
around (.), by showing that the existing ones are enough.

 * It is backward-compatible.


Lens already works today. So I'd dare say that the thing that works today
is compatible with what already works today, yes. ;)

[I note BTW that as the Plan currently stands, the '.field' postfix
 pseudo-operator doesn't rate too high on backward-compatible.]

 I do think that freeing up the name space by not auto-generating a record-
 type-bound field selector will help some of the naming work-rounds in the
 lens TH.


I'm going to risk going back into *tl;dr* territory in response to the
comment about lens TH:

Currently lens is pretty much non-commital about which strategy to use for
field naming / namespace management.

We do have three template-haskell combinators that provide lenses for
record types in lens, but they are more or less just 'what we can do in the
existing ecosystem'.

I am _not_ advocating any of these, merely describing what we already can
do today with no changes required to the language at all.

makeLenses - does the bare minimum to allow for type changing assignment
makeClassy - allows for easy 'nested record types'
makeFields - allows for highly ad hoc per field-name reuse

Consider

data Foo a = Foo { _fooBar :: Int, _fooBaz :: a }

and we can see what is generated by each.

*makeLenses ''Foo*

generates the minimum possible lens support

fooBar :: Lens' (Foo a) Int
fooBar f s = (\a - s { _fooBar = a }) $ f (_fooBar a)

fooBaz :: Lens (Foo a) (Foo b) a b
fooBaz f s = (\a - s { _fooBaz = a }) $ f (_fooBaz a)

*makeClassy ''Foo* generates

class HasFoo t a | t - a where
   foo :: Lens' t (Foo a)
   fooBar :: Lens' t Int
   fooBaz :: Lens' t a
   -- with default definitions of fooBar and fooBaz in terms of the simpler
definitions above precomposed with foo

It then provides

instance HasFoo (Foo a) a where
  foo = id

This form is particularly nice when you want to be 

RE: Overloaded record fields

2013-06-27 Thread Simon Peyton-Jones
|  Exactly! (I did tell you so:
| 
http://hackage.haskell.org/trac/ghc/wiki/Records/DeclaredOverloadedRecordFields/DotPostfix
|  billed as optional syntactic sugar)

I confess that I had not fully taken in this suggestion; thank you for 
reminding me.  The last round exceeded my input bandwidth, and in any case I 
often need to be told things more than once.

Anyway, glad to hear what others think about the idea.

Simon

___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Overloaded record fields

2013-06-27 Thread Brandon Allbery
On Thu, Jun 27, 2013 at 2:14 AM, AntC anthony_clay...@clear.net.nz wrote:

 Does the lens approach meet SPJ's criteria of:
  * It is the smallest increment I can come up with that
meaningfully addresses the #1 pain point (the inability to
re-use the same field name in different records).

  * It is backward-compatible.


It's difficult to get more backward compatible than is already working,
without any changes to the compiler or standard libraries at all. Note in
particular that (.) is not redefined or changed. I think the only pain
point is code that itself defines (^.) or functions beginning with an
underscore.

As for reusing the same field in different records, the point of lens is
it's a generic accessor/mutator mechanism. It doesn't just support
different records, it supports different pretty much everything — no
significant difference between a record, a tuple, a list, a Map,  And
it composes very well, so it's absurdly easy to drill down into a complex
nested structure.

-- 
brandon s allbery kf8nh   sine nomine associates
allber...@gmail.com  ballb...@sinenomine.net
unix, openafs, kerberos, infrastructure, xmonadhttp://sinenomine.net
___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Overloaded record fields

2013-06-27 Thread AntC
 Adam Gundry adam.gundry at strath.ac.uk writes:

 I've started to document the plan on the GHC wiki:
 
http://hackage.haskell.org/trac/ghc/wiki/Records/OverloadedRecordFields/Pla
n
 

Thank you Adam, (Simon)

I like the approach for Representation hiding. (That was something I was 
particularly trying to preserve out of H98 records.)

At first I was worried this would involve 'scoped' instances -- which 
seems a wild departure.

But I see in the 'Multiple modules' section that you're generating 
instances on-the-fly. So I agree that option (2) looks best.

As I understand it, this means that the extensions switched on in the 
importing module is all we have to worry about, not what extensions 
applied where the data type is declared.

So for backward compatibility, I can import historic Library L ( R(x) ) 
which knows nothing about the new stuff. And in my module (with the 
extension on) declare data type T with field x, and not have a clash of 
field names.

Sweet!





___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Overloaded record fields

2013-06-27 Thread AntC
 
 ... the orthogonality is also an important benefit.
  It could allow people like Edward and others who dislike ... 
  to still use ...
 

Folks, I'm keenly aware that GSoC has a limited timespan; and that there 
has already been much heat generated on the records debate.

Perhaps we could concentrate on giving Adam a 'plan of attack', and help 
resolving any difficulties he runs into. I suggest:

1. We postpone trying to use postfix dot:
   It's controversial.
   The syntax looks weird whichever way you cut it.
   It's sugar, whereas we'd rather get going on functionality.
   (This does mean I'm suggesting 'parking' Adam's/Simon's syntax, too.)

2. Implement class Has with method getFld, as per Plan.

3. Implement the Record field constraints new syntax, per Plan.

4. Implicitly generate Has instances for record decls, per Plan.
   Including generating for imported records, 
   even if they weren't declared with the extension.
   (Option (2) on-the-fly.)

5. Implement Record update, per Plan.

6. Support an extension to suppress generating field selector functions.
   This frees the namespace.
   (This is -XNoMonoRecordFields in the Plan,
but Simon M said he didn't like the 'Mono' in that name.)
   Then lenses could do stuff (via TH?) with the name.

   [Those who've followed so far, will notice that
I've not yet offered a way to select fields.
Except with explicit getFld method.
So this 'extension' is actually 'do nothing'.]

7. Implement -XPolyRecordFields, not quite per Plan.
   This generates a poly-record field selector function:

   x :: r {x :: t} = r - t-- Has r x t = ...
   x = getFld

And means that H98 syntax still works:

   x e -- we must know e's type to pick which instance

But note that it must generate only one definition
for the whole module, even if x is declared in multiple data types.
(Or in both a declared and an imported.)

But not per the Plan:
Do _not_ export the generated field selector functions.
(If an importing module wants field selectors,
 it must set the extension, and generate them for imported data types.
 Otherwise we risk name clash on the import.
 This effectively blocks H98-style modules
 from using the 'new' record selectors, I fear.)
Or perhaps I mean that the importing module could choose
whether to bring in the field selector function??
Or perhaps we export/import-control the selector function
separately to the record and field name???

Taking 6. and 7. together means that for the same record decl:
* one importing module could access it as a lens
* another could use field selector functions

8. (If GSoC hasn't expired yet!)
   Implement ‑XDotPostfixFuncApply as an orthogonal extension ;-).

AntC




___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Overloaded record fields

2013-06-27 Thread Gershom Bazerman

On 6/27/13 8:37 AM, AntC wrote:

Folks, I'm keenly aware that GSoC has a limited timespan; and that there
has already been much heat generated on the records debate.

Perhaps we could concentrate on giving Adam a 'plan of attack', and help
resolving any difficulties he runs into. I suggest:

Adam already has a plan of attack. It is in his proposal, and he appears 
to be proceeding with it. The great strength of his original GSoC 
proposal is that it recognized that we had spent some years debating 
bikeshed colors, but nobody had actually gone off and started to build 
the bikeshed to begin with. I imagine that if all goes well, Adam will 
complete the shed, and it will barely be painted at all.


Have no fear, at that point, there will still be plenty of time for 
debates to grind progress to a screeching halt :-)


--Gershom

___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Overloaded record fields

2013-06-27 Thread Barney Hilken
This (AntC's points 1-8) is the best plan yet. By getting rid of dot notation, 
things
become more compatible with existing code. The only dodgy bit is import/export 
in point 7:

 7. Implement -XPolyRecordFields, not quite per Plan.
   This generates a poly-record field selector function:
 
   x :: r {x :: t} = r - t-- Has r x t = ...
   x = getFld
 
And means that H98 syntax still works:
 
   x e -- we must know e's type to pick which instance
 
But note that it must generate only one definition
for the whole module, even if x is declared in multiple data types.
(Or in both a declared and an imported.)
 
But not per the Plan:
Do _not_ export the generated field selector functions.
(If an importing module wants field selectors,
 it must set the extension, and generate them for imported data types.
 Otherwise we risk name clash on the import.
 This effectively blocks H98-style modules
 from using the 'new' record selectors, I fear.)
Or perhaps I mean that the importing module could choose
whether to bring in the field selector function??
Or perhaps we export/import-control the selector function
separately to the record and field name???

I don't see the problem with H98 name clash. A field declared in a 
-XPolyRecordFields
module is just a polymorphic function; of course you can't use it in record 
syntax in a
-XNoPolyRecordFields module, but you can still use it.

I think a -XPolyRecordFields module should automatically hide all imported H98 
field names and
generate one Has instance per name on import. That way you could import two 
clashing H98
modules and the clash would be resolved automatically.

Barney.


___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Overloaded record fields

2013-06-27 Thread Stephen Paul Weber

Somebody claiming to be Simon Peyton-Jones wrote:

It is kind of weird that
f . g  means\x. f (g x)
but f.gmeansg f


Anything that makes f.g mean something different from f . g just makes the 
code soup.


F . g being different from F.g is already *very* unfortunate.  The 
capital-letter makes it normally not too crazy, but sometimes you want to 
compose data constructors, and then it's a big issue.


Making this issue worse in order to solve something else does not seem like 
a good trade-off.


Why not use a different character?  There are lots of them :)

--
Stephen Paul Weber, @singpolyma
See http://singpolyma.net for how I prefer to be contacted
edition right joseph


signature.asc
Description: Digital signature
___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Overloaded record fields

2013-06-27 Thread Stephen Paul Weber

Somebody claiming to be Dominique Devriese wrote:

I would prefer to have dot notation for a
general, very tightly-binding reverse application, and the type of the record
selector for a field f changed to forall r t. r { f :: t } = r - t
instead of
SomeRecordType - t.  Such a general reverse application dot would
allow things like string.toUpper


If that's even possible, then we do not need the `.` at all, and can just 
use perfectly normal function application.


If people want to create YetAnotherFunctionApplicationOperator, we can't 
stop them, but no reason to include one (especially that overlaps with an 
existing, more useful, operator)


--
Stephen Paul Weber, @singpolyma
See http://singpolyma.net for how I prefer to be contacted
edition right joseph


signature.asc
Description: Digital signature
___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Overloaded record fields

2013-06-27 Thread Adam Gundry
Thanks everyone for the illuminating discussion, and for your awareness
of the dangers of bikeshedding. ;-) I think we are making progress though.

I like the idea of making -XFunnyDotSyntax or whatever a separate
extension. It's simple, resolves something of a love-hate issue, and
reduces backwards incompatibility for people who want overloaded record
fields in their existing code. Perhaps we can leave the arguments over
dot syntax for another thread?

There are a bunch of options for translating record fields into selector
functions:
 * monomorphically, as in Haskell 98, which is simple and robust but
doesn't allow overloading;
 * polymorphically, with Has, which permits overloading and is often the
'right' thing (but not always: it isn't great for higher-rank fields,
and can result in too much ambiguity);
 * do nothing in GHC itself, so the namespace is left open for lens or
another library to do wonderful things.

Rather than committing to one of these options, let's allow all of them.
If we start thinking of modules as importing/exporting *field names*,
rather than *selector functions*, perhaps we can allow each module to
decide for itself (via appropriate extensions) how it wants to bring
them in to scope.

I'll see what Simon thinks, draft an updated Plan, and continue trying
to understand what this will mean for GHC's Glorious Renamer...

Adam


On 27/06/13 14:10, Barney Hilken wrote:
 This (AntC's points 1-8) is the best plan yet. By getting rid of dot 
 notation, things
 become more compatible with existing code. The only dodgy bit is 
 import/export in point 7:
 
 7. Implement -XPolyRecordFields, not quite per Plan.
   This generates a poly-record field selector function:

   x :: r {x :: t} = r - t-- Has r x t = ...
   x = getFld

And means that H98 syntax still works:

   x e -- we must know e's type to pick which instance

But note that it must generate only one definition
for the whole module, even if x is declared in multiple data types.
(Or in both a declared and an imported.)

But not per the Plan:
Do _not_ export the generated field selector functions.
(If an importing module wants field selectors,
 it must set the extension, and generate them for imported data types.
 Otherwise we risk name clash on the import.
 This effectively blocks H98-style modules
 from using the 'new' record selectors, I fear.)
Or perhaps I mean that the importing module could choose
whether to bring in the field selector function??
Or perhaps we export/import-control the selector function
separately to the record and field name???
 
 I don't see the problem with H98 name clash. A field declared in a 
 -XPolyRecordFields
 module is just a polymorphic function; of course you can't use it in record 
 syntax in a
 -XNoPolyRecordFields module, but you can still use it.
 
 I think a -XPolyRecordFields module should automatically hide all imported 
 H98 field names and
 generate one Has instance per name on import. That way you could import two 
 clashing H98
 modules and the clash would be resolved automatically.
 
 Barney.
 
 
 ___
 Glasgow-haskell-users mailing list
 Glasgow-haskell-users@haskell.org
 http://www.haskell.org/mailman/listinfo/glasgow-haskell-users
 


___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Overloaded record fields

2013-06-27 Thread Evan Laforge
I'm reluctant to add yet another opinion, but, oh what the heck:

For me, lenses basically already solve the record problem.  The only
missing thing is to integrate them better with record declaration
syntax.  Having to rely on TH and then write a makeLenses splice is
just too much friction to have lenses added everywhere automatically.
TH makes compiles more fragile and slower, and worst of all introduces
a declaration order constraint in the source file.  So I declare by
hand, but even at one line per lens, it's still too much friction,
because after all they don't start saving you lines until you want to
update a nested field.

In addition, I can't use unqualified names because I would want to
import only the record lenses unqualified, not the rest of the module.
 So I'd have to move all the data types into individual modules,
because giant long import lists is definitely way too much friction.
But the separate module is no good, because that in turns doesn't let
you preserve invariants by restricting exports.

So if I were doing the GSoC thing, here's what I would do:

1 - Add an option to add a 'deriving (Lens)' to record declarations.
That makes the record declare lenses instead of functions.  That's
already most of the problem solved, for me, because it removes the TH
friction.

2 - The next step is to allow 'deriving (ClassyLens)', which declares
lenses plus the typeclasses to allow shared names.  Then when you
write 'import M (Record(..))', the (..) will import the stuff
generated by 'deriving (ClassyLens)', i.e. the class methods.  Now you
can drop the record name prefixing and import unqualified to drop the
module name qualification as well.

It's still not ideal because you would have to add the unqualified
'import M (Record(..))', but is better than having to write out the
list of fields every single time.  And actually I'm not sure I could
use even that, because record field names are usually the same as what
you want to name the variable, e.g.: name = parent.name .^ person.
A hardcoded record field thing like SORF has the edge here because you
can write name = person.parent.name without 'name' clashing.  But in
every other respect, lenses fit much better into the rest of the
language and are much more powerful for much less (i.e. none!) ad-hoc
language level complexity to support them, so to me they clearly win
at power to weight ratio.

But I don't mind always qualifying, e.g. 'name = Person.parent .
Person.name .^ person' and avoiding the whole classes and unqualified
import hassle, so just step 1 is basically problem solved (in fact,
this is what I already do, just without the automatic lens
generation).

Alas, not everyone shares my attitude towards qualification.  In fact,
I'm probably in a small minority (hi Henning!).  Which is sad, because
just doing #1 would be so easy!  Maybe I should just go do it myself,
it's not like it would conflict with any of the other proposed
extensions.

___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Overloaded record fields

2013-06-26 Thread Dominique Devriese
I think it's a good idea to push forward on the records design because
it seems futile to hope for an ideal consensus proposal.

The only thing I dislike though is that dot notation is special-cased to
record projections.  I would prefer to have dot notation for a
general, very tightly-binding reverse application, and the type of the record
selector for a field f changed to forall r t. r { f :: t } = r - t
instead of
SomeRecordType - t.  Such a general reverse application dot would
allow things like string.toUpper and for me personally, it would
make a Haskell OO library that I'm working on more elegant...

But I guess you've considered such a design and decided against it,
perhaps because of the stronger backward compatibility implications of
changing the selectors' types?

Dominique

2013/6/24 Adam Gundry adam.gun...@strath.ac.uk:
 Hi everyone,

 I am implementing an overloaded record fields extension for GHC as a
 GSoC project. Thanks to all those who gave their feedback on the
 original proposal! I've started to document the plan on the GHC wiki:

 http://hackage.haskell.org/trac/ghc/wiki/Records/OverloadedRecordFields/Plan

 If you have any comments on the proposed changes, or anything is unclear
 about the design, I'd like to hear from you.

 Thanks,

 Adam Gundry

 ___
 Glasgow-haskell-users mailing list
 Glasgow-haskell-users@haskell.org
 http://www.haskell.org/mailman/listinfo/glasgow-haskell-users

___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


RE: Overloaded record fields

2013-06-26 Thread Simon Peyton-Jones
|  record projections.  I would prefer to have dot notation for a
|  general, very tightly-binding reverse application, and the type of the record
|  selector for a field f changed to forall r t. r { f :: t } = r - t
|  instead of SomeRecordType - t.  Such a general reverse application dot 
would
|  allow things like string.toUpper and for me personally, it would
|  make a Haskell OO library that I'm working on more elegant...

Actually I *hadn't* considered that.   I'm sure it's been suggested before 
(there has been so much discussion), but I had not really thought about it in 
the context of our very modest proposal.

We're proposing, in effect, that .f is a postfix function with type forall r 
t. r { f :: t } = r - t.   You propose to decompose that idea further, into 
(a) reverse function application and (b) a first class function f.

It is kind of weird that
f . g  means\x. f (g x)
but f.gmeansg f

but perhaps it is not *more* weird than our proposal.

Your proposal also allows things like

data T = MkT { f :: Int }

foo :: [T] - [Int]
foo = map f xs

because the field selector 'f' has the very general type you give, but the type 
signature would be enough to fix it.  Or, if foo lacks a type signature, I 
suppose we'd infer

foo :: (r { f::a }) = [r] - [a]

which is also fine.

It also allows you to use record field names in prefix position, just as now, 
which is a good thing.  

In fact, your observation allows us to regard our proposal as consisting of two 
entirely orthogonal parts
  * Generalise the type of record field selectors
  * Introduce period as reverse function application

Both have merit.

Simon

|  -Original Message-
|  From: glasgow-haskell-users-boun...@haskell.org 
[mailto:glasgow-haskell-users-
|  boun...@haskell.org] On Behalf Of Dominique Devriese
|  Sent: 26 June 2013 13:16
|  To: Adam Gundry
|  Cc: glasgow-haskell-users@haskell.org
|  Subject: Re: Overloaded record fields
|  
|  I think it's a good idea to push forward on the records design because
|  it seems futile to hope for an ideal consensus proposal.
|  
|  The only thing I dislike though is that dot notation is special-cased to
|  record projections.  I would prefer to have dot notation for a
|  general, very tightly-binding reverse application, and the type of the record
|  selector for a field f changed to forall r t. r { f :: t } = r - t
|  instead of   
|  SomeRecordType - t.  Such a general reverse application dot would
|  allow things like string.toUpper and for me personally, it would
|  make a Haskell OO library that I'm working on more elegant...
|  
|  But I guess you've considered such a design and decided against it,
|  perhaps because of the stronger backward compatibility implications of
|  changing the selectors' types?
|  
|  Dominique
|  
|  2013/6/24 Adam Gundry adam.gun...@strath.ac.uk:
|   Hi everyone,
|  
|   I am implementing an overloaded record fields extension for GHC as a
|   GSoC project. Thanks to all those who gave their feedback on the
|   original proposal! I've started to document the plan on the GHC wiki:
|  
|   
http://hackage.haskell.org/trac/ghc/wiki/Records/OverloadedRecordFields/Plan
|  
|   If you have any comments on the proposed changes, or anything is unclear
|   about the design, I'd like to hear from you.
|  
|   Thanks,
|  
|   Adam Gundry
|  
|   ___
|   Glasgow-haskell-users mailing list
|   Glasgow-haskell-users@haskell.org
|   http://www.haskell.org/mailman/listinfo/glasgow-haskell-users
|  
|  ___
|  Glasgow-haskell-users mailing list
|  Glasgow-haskell-users@haskell.org
|  http://www.haskell.org/mailman/listinfo/glasgow-haskell-users

___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Overloaded record fields

2013-06-26 Thread Edward Kmett
Note: the lens solution already gives you 'reverse function application'
with the existing (.) due to CPS in the lens type.

-Edward

On Wed, Jun 26, 2013 at 4:39 PM, Simon Peyton-Jones
simo...@microsoft.comwrote:

 |  record projections.  I would prefer to have dot notation for a
 |  general, very tightly-binding reverse application, and the type of the
 record
 |  selector for a field f changed to forall r t. r { f :: t } = r - t
 |  instead of SomeRecordType - t.  Such a general reverse application
 dot would
 |  allow things like string.toUpper and for me personally, it would
 |  make a Haskell OO library that I'm working on more elegant...

 Actually I *hadn't* considered that.   I'm sure it's been suggested before
 (there has been so much discussion), but I had not really thought about it
 in the context of our very modest proposal.

 We're proposing, in effect, that .f is a postfix function with type
 forall r t. r { f :: t } = r - t.   You propose to decompose that idea
 further, into (a) reverse function application and (b) a first class
 function f.

 It is kind of weird that
 f . g  means\x. f (g x)
 but f.gmeansg f

 but perhaps it is not *more* weird than our proposal.

 Your proposal also allows things like

 data T = MkT { f :: Int }

 foo :: [T] - [Int]
 foo = map f xs

 because the field selector 'f' has the very general type you give, but the
 type signature would be enough to fix it.  Or, if foo lacks a type
 signature, I suppose we'd infer

 foo :: (r { f::a }) = [r] - [a]

 which is also fine.

 It also allows you to use record field names in prefix position, just as
 now, which is a good thing.

 In fact, your observation allows us to regard our proposal as consisting
 of two entirely orthogonal parts
   * Generalise the type of record field selectors
   * Introduce period as reverse function application

 Both have merit.

 Simon

 |  -Original Message-
 |  From: glasgow-haskell-users-boun...@haskell.org [mailto:
 glasgow-haskell-users-
 |  boun...@haskell.org] On Behalf Of Dominique Devriese
 |  Sent: 26 June 2013 13:16
 |  To: Adam Gundry
 |  Cc: glasgow-haskell-users@haskell.org
 |  Subject: Re: Overloaded record fields
 |
 |  I think it's a good idea to push forward on the records design because
 |  it seems futile to hope for an ideal consensus proposal.
 |
 |  The only thing I dislike though is that dot notation is special-cased to
 |  record projections.  I would prefer to have dot notation for a
 |  general, very tightly-binding reverse application, and the type of the
 record
 |  selector for a field f changed to forall r t. r { f :: t } = r - t
 |  instead of
 |  SomeRecordType - t.  Such a general reverse application dot would
 |  allow things like string.toUpper and for me personally, it would
 |  make a Haskell OO library that I'm working on more elegant...
 |
 |  But I guess you've considered such a design and decided against it,
 |  perhaps because of the stronger backward compatibility implications of
 |  changing the selectors' types?
 |
 |  Dominique
 |
 |  2013/6/24 Adam Gundry adam.gun...@strath.ac.uk:
 |   Hi everyone,
 |  
 |   I am implementing an overloaded record fields extension for GHC as a
 |   GSoC project. Thanks to all those who gave their feedback on the
 |   original proposal! I've started to document the plan on the GHC wiki:
 |  
 |  
 http://hackage.haskell.org/trac/ghc/wiki/Records/OverloadedRecordFields/Plan
 |  
 |   If you have any comments on the proposed changes, or anything is
 unclear
 |   about the design, I'd like to hear from you.
 |  
 |   Thanks,
 |  
 |   Adam Gundry
 |  
 |   ___
 |   Glasgow-haskell-users mailing list
 |   Glasgow-haskell-users@haskell.org
 |   http://www.haskell.org/mailman/listinfo/glasgow-haskell-users
 |
 |  ___
 |  Glasgow-haskell-users mailing list
 |  Glasgow-haskell-users@haskell.org
 |  http://www.haskell.org/mailman/listinfo/glasgow-haskell-users

 ___
 Glasgow-haskell-users mailing list
 Glasgow-haskell-users@haskell.org
 http://www.haskell.org/mailman/listinfo/glasgow-haskell-users

___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Overloaded record fields

2013-06-26 Thread AntC
 Mateusz Kowalczyk fuuzetsu at fuuzetsu.co.uk writes:
 
 
 On 24/06/13 11:04, Roman Cheplyaka wrote:
  * Mateusz Kowalczyk fuuzetsu at fuuzetsu.co.uk [2013-06-24
  10:47:09+0100]
  Restricting function composition to have spaces around it will
  require changing a large amount of existing code if one is
  willing to use it.
  
  
 Sure that it's unreasonable to have them change some of their code to
 use new, cool features. I'm just questioning whether it's absolutely
 necessary to do it by forcing restrictions on what is probably the
 most commonly used operator in the whole language.
 

For my 2-penn'orth, requiring spaces around composition won't break any of 
my code: I always do put spaces.

Re use of 'infix' dots, I grew up on Russell  Whitehead's Principia 
Mathematica, Wittgenstein's Tractatus, BCPL (dots inside names), LISP's 
dotted pairs (which IIRC always have surrounding spaces), SQL's 
table.field.

I find it is Haskell that is 'odd man out'.

OTOH, there is a high cost in breaking that existing code with non-spaced 
composition, and I'm not convinced that record-field access alone is a 
sufficient benefit. (This is what SPJ would call a low power to weight 
ratio.)

What's more, the new dot syntax seems a bit weird:

A dotted right-section is allowed, so presumably the wiki example could go:

getPersonId e = e.PersonId
getPersonId   = (.PersonId)  -- eta reduce(?)

What do these terms mean/are they valid?

(.PersonId) e-- prefix application
e (.PersonId)-- postfix application??
let f = (.PersonId) in e.f   -- no Has instance for f

let fullName r = r.firstName ++   ++ r.lastName
e.fullName   -- trying to use Virtual field

So I'm thinking that this dot operator is not really an operator, neither 
is it part of the name as in module prefixes(?)

(I'll add some more thoughts to SPJ's comment.)

AntC



___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Overloaded record fields

2013-06-26 Thread AntC
 Simon Peyton-Jones simonpj at microsoft.com writes:
 
 |  record projections.  I would prefer to have dot notation for a
 |  general, very tightly-binding reverse application, ...
 |  Such a general reverse application dot would
 |  allow things like string.toUpper and for me personally, it would
 |  make a Haskell OO library that I'm working on more elegant...
 
 Actually I *hadn't* considered that.   I'm sure it's been suggested 
before (there has been so much
 discussion), but I had not really thought about it in the context of our 
very modest proposal.

Thanks Simon, 

I'd better start by saying that I'm very keen for Adam to get going on 
this and produce something/anything better than H98's record fields. So I 
fully understand you're trying to make this a minimal proposal.

At risk of I told you so dot as postfix apply is exactly what I had in 
mind for my record proposals (DORF and TPDORF on the wiki):

- Since H98 field selectors are just functions we could leave them as is
  (leave the selector as Mono/specific to a data type)
- make the new OverloadedRecordFields also just functions
  (via the Has instance
   -- in effect this is PolyRecordFields per the wiki Plan.)
- make Virtual record fields just functions
  (don't need a Has instance, and don't get into trouble with update)
- (then toUpper could seem like a record field kinda thing)

All of them could use the dot notation syntax. (As tight-binding reverse 
function apply.)

person.lastName.toUpper-- == toUpper (lastName person)

So, as you say:
 
 It also allows you to use record field names in prefix position, just as 
now, which is a good thing.  
 
 In fact, your observation allows us to regard our proposal as consisting 
of two entirely orthogonal parts
   * Generalise the type of record field selectors
   * Introduce period as reverse function application
 

Exactly! (I did tell you so: 
http://hackage.haskell.org/trac/ghc/wiki/Records/DeclaredOverloadedRecordFi
elds/DotPostfix -- billed as optional syntactic sugar)
So make those two orthogonal extensions. 

For people who really don't like breaking their existing code that uses 
dot as composition in tight-binding contexts (and they were vociferous), 
they simply don't switch on the ‑XDotPostfixFuncApply extension, and they 
can still get the benefits of OverloadedRecordFields.



___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Overloaded record fields

2013-06-26 Thread AntC
 
 person.lastName.toUpper-- == toUpper (lastName person)
 

Oops! that should be one of:

  person.lastName.head.toUpper

  person.lastName.(map toUpper)




___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Overloaded record fields

2013-06-26 Thread Edward Kmett
 |  instead of SomeRecordType - t.  Such a general reverse application
 dot would
 |  allow things like string.toUpper and for me personally, it would
 |  make a Haskell OO library that I'm working on more elegant...

 Actually I *hadn't* considered that.   I'm sure it's been suggested before
 (there has been so much discussion), but I had not really thought about it
 in the context of our very modest proposal.

 We're proposing, in effect, that .f is a postfix function with type
 forall r t. r { f :: t } = r - t.   You propose to decompose that idea
 further, into (a) reverse function application and (b) a first class
 function f.

 It is kind of weird that
 f . g  means\x. f (g x)
 but f.gmeansg f

 but perhaps it is not *more* weird than our proposal.

 Your proposal also allows things like

 data T = MkT { f :: Int }

 foo :: [T] - [Int]
 foo = map f xs

 because the field selector 'f' has the very general type you give, but the
 type signature would be enough to fix it.  Or, if foo lacks a type
 signature, I suppose we'd infer

 foo :: (r { f::a }) = [r] - [a]

 which is also fine.

 It also allows you to use record field names in prefix position, just as
 now, which is a good thing.

 In fact, your observation allows us to regard our proposal as consisting
 of two entirely orthogonal parts
   * Generalise the type of record field selectors
   * Introduce period as reverse function application

 Both have merit.

 Simon

 |  -Original Message-
 |  From: glasgow-haskell-users-boun...@haskell.org [mailto:
 glasgow-haskell-users-
 |  boun...@haskell.org] On Behalf Of Dominique Devriese
 |  Sent: 26 June 2013 13:16
 |  To: Adam Gundry
 |  Cc: glasgow-haskell-users@haskell.org
 |  Subject: Re: Overloaded record fields
 |
 |  I think it's a good idea to push forward on the records design because
 |  it seems futile to hope for an ideal consensus proposal.
 |
 |  The only thing I dislike though is that dot notation is special-cased to
 |  record projections.  I would prefer to have dot notation for a
 |  general, very tightly-binding reverse application, and the type of the
 record
 |  selector for a field f changed to forall r t. r { f :: t } = r - t
 |  instead of
 |  SomeRecordType - t.  Such a general reverse application dot would
 |  allow things like string.toUpper and for me personally, it would
 |  make a Haskell OO library that I'm working on more elegant...
 |
 |  But I guess you've considered such a design and decided against it,
 |  perhaps because of the stronger backward compatibility implications of
 |  changing the selectors' types?
 |
 |  Dominique
 |
 |  2013/6/24 Adam Gundry adam.gun...@strath.ac.uk:
 |   Hi everyone,
 |  
 |   I am implementing an overloaded record fields extension for GHC as a
 |   GSoC project. Thanks to all those who gave their feedback on the
 |   original proposal! I've started to document the plan on the GHC wiki:
 |  
 |  
 http://hackage.haskell.org/trac/ghc/wiki/Records/OverloadedRecordFields/Plan
 |  
 |   If you have any comments on the proposed changes, or anything is
 unclear
 |   about the design, I'd like to hear from you.
 |  
 |   Thanks,
 |  
 |   Adam Gundry
 |  
 |   ___
 |   Glasgow-haskell-users mailing list
 |   Glasgow-haskell-users@haskell.org
 |   http://www.haskell.org/mailman/listinfo/glasgow-haskell-users
 |
 |  ___
 |  Glasgow-haskell-users mailing list
 |  Glasgow-haskell-users@haskell.org
 |  http://www.haskell.org/mailman/listinfo/glasgow-haskell-users

 ___
 Glasgow-haskell-users mailing list
 Glasgow-haskell-users@haskell.org
 http://www.haskell.org/mailman/listinfo/glasgow-haskell-users

___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Overloaded record fields

2013-06-24 Thread Adam Gundry
Hi everyone,

I am implementing an overloaded record fields extension for GHC as a
GSoC project. Thanks to all those who gave their feedback on the
original proposal! I've started to document the plan on the GHC wiki:

http://hackage.haskell.org/trac/ghc/wiki/Records/OverloadedRecordFields/Plan

If you have any comments on the proposed changes, or anything is unclear
about the design, I'd like to hear from you.

Thanks,

Adam Gundry

___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


RE: Overloaded record fields

2013-06-24 Thread Simon Peyton-Jones
 
| I am implementing an overloaded record fields extension for GHC as a
| GSoC project. Thanks to all those who gave their feedback on the
| original proposal! I've started to document the plan on the GHC wiki:
| 
| http://hackage.haskell.org/trac/ghc/wiki/Records/OverloadedRecordFields/
| Plan
| 
| If you have any comments on the proposed changes, or anything is unclear
| about the design, I'd like to hear from you

By way of context, there have been a succession of adding-records-to-Haskell 
debates which have failed to reach consensus. That's not because people are 
awkward.  Rather it's a complex design space with no global maximum; and 
because a clean-slate design (even if we were sure of a good one, which we 
aren't) would lack backward compatibility.

I have also had the sense of I wish GHC HQ would just cut to the chase and 
decide *something*, even if not everyone thinks it's ideal.

So that's what this proposal is intended to do:

 * It is the smallest increment I can come up with that
   meaningfully addresses the #1 pain point (the inability to
   re-use the same field name in different records).

 * It is backward-compatible.

It does not do everything -- far from it -- leaving the field open for 
experimentation with more far-reaching designs.

The hope is that it offers a good power-to-weight ratio.  Do comment.  In 
particular, if you think it does *not* address the pain points, and hence 
offers weight but not power, please say so.  Tweaks to improve the design are 
also most welcome.  (Completely new designs less so; that's what we've been 
exploring over the last year or five.)

Thanks!

Simon




___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Overloaded record fields

2013-06-24 Thread Mateusz Kowalczyk
-BEGIN PGP SIGNED MESSAGE-
Hash: SHA1

On 24/06/13 08:44, Adam Gundry wrote:
 Hi everyone,
 
 I am implementing an overloaded record fields extension for GHC as
 a GSoC project. Thanks to all those who gave their feedback on the 
 original proposal! I've started to document the plan on the GHC
 wiki:
 
 http://hackage.haskell.org/trac/ghc/wiki/Records/OverloadedRecordFields/Plan

  If you have any comments on the proposed changes, or anything is
 unclear about the design, I'd like to hear from you.
 
 Thanks,
 
 Adam Gundry
 
 ___ 
 Glasgow-haskell-users mailing list 
 Glasgow-haskell-users@haskell.org 
 http://www.haskell.org/mailman/listinfo/glasgow-haskell-users
 
On the wiki, you say ` It is critical to support dot-notation.' and
then you follow up with multiple reasons on why this is troublesome
because of the conflict with function composition.

You say `There is an overlap with the function composition operator,
but that is already true with qualified names.'

True, but qualified names always have LHS starting with a capital
letter while records wouldn't. I don't see how this is a supporting
argument.

Then you write:
Function composition will only work when surrounded by spaces,
thus (f . g).
Dot-notation for record selection only works with no spaces.

Restricting function composition to have spaces around it will require
changing a large amount of existing code if one is willing to use it.
While I personally would like the restriction because I hate seeing
people skimp out on whitespace around operators, there are a lot of
people with a different opinion than mine and I imagine it'd be a
great inconvenience to make them change their code if they want to
start using SORF. Have you considered not using a dot to begin with? I
imagine the reason behind the dot is that it makes it look like
methods on objects in OO languages which is a rather poor justification...

- -- 
Mateusz K.
-BEGIN PGP SIGNATURE-
Version: GnuPG v2.0.19 (GNU/Linux)

iQIcBAEBAgAGBQJRyBWdAAoJEM1mucMq2pqXD08P/3MhVNa9GnuIABb5MT8gAq3Z
yuV/NJE4briRwtoM9ki2hciRbTluY0t7F0WlcjDgwmd2c7tO7XzGZFwx6RwsVQM6
4/fQ2jo2/HKR5+6IX3CF2zkKZGyZSUdaqdGFLUbTNw/VYnU7sP9l4TyvpEEB7P78
tCoycZ193qwH0V7I7Am57PSebFKtgKhmjXU9HKLT3wa1HRcFY5UDgi4fj/EoAHG+
ZAmxlg+8NhLbnR3lHNXC+8vUo6eG6TEf50Qn2MJNMW2CHSl8OyN+yFzTI0OO4yEK
gIirzzwz+hp4X/WOKVwUnRasv/j9EjTDx1f3ZwoJlT6UAKwh+TUxDNn8oIgLEyxi
9Vik73kvyCBBaWq8/K5CGYGtRrYQurZHBdxtfmiPe8HWWwYhNY2UKkEpKQhxzQJ2
aIl9coocdHWpbAW201dYBXkmC+Ey/oXDbubL/csaXH1kRF0HXghUacUIhIiYedk0
o5mySfd6SnsQ/Kqzjj2HM5Q0ib+5ExYmOgI21hEmWqjeeOz/oKamgaPTcrbXhWaQ
IY9isLnZwOYziGF6gs16TNfSvy8NCARCW03NjxM8gDxgXAC60ZNivZsfJ2ErjxY6
4cPqMmkXNbVTNssMbc+h4dpDGiQkwxrZKOP+RY1dp0mFtE7uY27RPRYgyW9LXfyO
L5EqGQoT18iVh7BZ7Ra7
=mkvJ
-END PGP SIGNATURE-

___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Overloaded record fields

2013-06-24 Thread Roman Cheplyaka
* Mateusz Kowalczyk fuuze...@fuuzetsu.co.uk [2013-06-24 10:47:09+0100]
 Restricting function composition to have spaces around it will require
 changing a large amount of existing code if one is willing to use it.

I assume this semantics will be triggered only by an extension, so
there'd be no need to change existing code.

 While I personally would like the restriction because I hate seeing
 people skimp out on whitespace around operators, there are a lot of
 people with a different opinion than mine and I imagine it'd be a
 great inconvenience to make them change their code if they want to
 start using SORF.

Well, if they *want* it, it's not unreasonable to require them to *pay*
for it (in the form of adjusting their coding style).

Roman

___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Overloaded record fields

2013-06-24 Thread Mateusz Kowalczyk
-BEGIN PGP SIGNED MESSAGE-
Hash: SHA1

On 24/06/13 11:04, Roman Cheplyaka wrote:
 * Mateusz Kowalczyk fuuze...@fuuzetsu.co.uk [2013-06-24
 10:47:09+0100]
 Restricting function composition to have spaces around it will
 require changing a large amount of existing code if one is
 willing to use it.
 
 I assume this semantics will be triggered only by an extension, so 
 there'd be no need to change existing code.
 
 While I personally would like the restriction because I hate
 seeing people skimp out on whitespace around operators, there are
 a lot of people with a different opinion than mine and I imagine
 it'd be a great inconvenience to make them change their code if
 they want to start using SORF.
 
 Well, if they *want* it, it's not unreasonable to require them to
 *pay* for it (in the form of adjusting their coding style).
 
 Roman
 
Sure that it's unreasonable to have them change some of their code to
use new, cool features. I'm just questioning whether it's absolutely
necessary to do it by forcing restrictions on what is probably the
most commonly used operator in the whole language.

- -- 
Mateusz K.
-BEGIN PGP SIGNATURE-
Version: GnuPG v2.0.19 (GNU/Linux)

iQIcBAEBAgAGBQJRyBnOAAoJEM1mucMq2pqXX54P/Rn4czScB9SMJnOMawzwHU3k
SiPRGjflgzTM3OK4D7AxF5q02jX0TbkS5GeZvXyQ59e8q1qeyvK9cXQsDX8v1GEb
oxx1bc+sNRhjz+8aSBvu3uBIVPq1VY6QHD7sQbmYCPMjfJLVXzI5XsWIpSnam0q8
8xBSeC93TaPTxloRzEFnxF2maAjIJ5YR3kXzb+xCUBrF1D6++P1gQKcseuFL+E4p
kqfaOMz4bdQ6T0fpzgZDvXGgopVz8J5pm0FfHTzhRJbCuWi7B9Ubpbt9a4mwtJo5
QZqozDuAFVy1b9MEBiGSh+XJDEFIrR6EdDvD9DXVE4qEr/3CNFL/HEXoEpaYchgw
kpxyzFLWyBOYPRk7z1D+Ge/hzoeAk11U4hj5BbTBtRQLgK/5rXgVprqn1cYFJhr5
bAlvip7+4Dns6NkA/mS9+14dQW97lvPhZcnhUnuRxFvyqTBTmqdlU5dyllDG7C4/
yJ1DY/kPpF94T6jyCJ85EAQmYxCRzSRMCvRTYzjwQTPZVbM2+WnQ9zdr/tJ6vuvW
Mb3PiAQnZEpl7dMv3PSEfkPToLAVwDM+9SFVpVkw9ICs1sjaK6V/NlCJDFtRGSBv
4P/FUYCMQpo/6W71e4IyYDuS0R5UyrTWu7QjCSWoO6jec3tVvwVxT/+ZKkCVzO8e
27eHbi3j/QC0Qe/FIkKD
=NRx3
-END PGP SIGNATURE-

___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Overloaded record fields

2013-06-24 Thread Mateusz Kowalczyk
-BEGIN PGP SIGNED MESSAGE-
Hash: SHA1

On 24/06/13 11:05, Mateusz Kowalczyk wrote:
 On 24/06/13 11:04, Roman Cheplyaka wrote:
 * Mateusz Kowalczyk fuuze...@fuuzetsu.co.uk [2013-06-24 
 10:47:09+0100]
 Restricting function composition to have spaces around it will 
 require changing a large amount of existing code if one is 
 willing to use it.
 
 I assume this semantics will be triggered only by an extension,
 so there'd be no need to change existing code.
 
 While I personally would like the restriction because I hate 
 seeing people skimp out on whitespace around operators, there
 are a lot of people with a different opinion than mine and I
 imagine it'd be a great inconvenience to make them change their
 code if they want to start using SORF.
 
 Well, if they *want* it, it's not unreasonable to require them
 to *pay* for it (in the form of adjusting their coding style).
 
 Roman
 
 Sure that it's unreasonable to have them change some of their code
 to use new, cool features. I'm just questioning whether it's
 absolutely necessary to do it by forcing restrictions on what is
 probably the most commonly used operator in the whole language.
 
 
 ___ 
 Glasgow-haskell-users mailing list 
 Glasgow-haskell-users@haskell.org 
 http://www.haskell.org/mailman/listinfo/glasgow-haskell-users
 
That meant to say `that it's *not* unreasonable'.
- -- 
Mateusz K.
-BEGIN PGP SIGNATURE-
Version: GnuPG v2.0.19 (GNU/Linux)

iQIcBAEBAgAGBQJRyBp0AAoJEM1mucMq2pqXHbEP/3myuTjcUiG59ee3/32PFZTQ
Qb0308VmgTzTMhZCKosn+iymgLm1DFThR5P3aOgRgixn2gnvIpf7tu3GhAYvn+5Q
BzpNwWOt17+sFBf0ovLW3bdFmKDQhzPy5OTtCcTDBAf6AyRJLFlTFRMFl4oQWpuF
KI34M0gNwKjh2NIDk3z21afVG7go9rdxtRZwMV9OqVwFgeAKJ4QY2U5kPu47p8cr
HOZzaPsPsdf89Izaun8X3ApYLO0fDvi55nbogTJCEN+BoqK/+ZE/upDAoLJB4k6m
iuFA86RmfJfHgrIWp2EpR3G7G6+jW/1gwOrx5RjXjyW6SzBTBuhcBQdmtIZXTqih
PhpWMmydS4iwYJWIAekiPbO2pCFlgeN++NJ4fyt2b8ypVfRm27k+xjfRso/up9gf
dNgU7WXlx1tm0mzLWzauMojK65HEDVd8IjQ0DRj9Prmr0EiB9e/KbrR592YFAl+p
7fvAGxV5Vc83LRN0smIg9RrHrPe8hVeDJTKbU5KU0QURil3RIMatIy0MNebIoz6u
csnmcXBKmYKGMifAvNYLOFGrwlvIEGdb0oPDf8WlP2A6LPDEecBLW1x9KUIMeLVf
b/x8KiGVw49J4Osr0vwI3U8ThxgrksNqHVPdxLYS5GvbPT8+74EPmMTVTixFOROY
oK26lPQ7hEUb++bGCBR+
=QZmK
-END PGP SIGNATURE-

___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Overloaded record fields

2013-06-24 Thread Oliver Charles
On 06/24/2013 08:44 AM, Adam Gundry wrote:
 Hi everyone,

 I am implementing an overloaded record fields extension for GHC as a
 GSoC project. Thanks to all those who gave their feedback on the
 original proposal! I've started to document the plan on the GHC wiki:

 http://hackage.haskell.org/trac/ghc/wiki/Records/OverloadedRecordFields/Plan

 If you have any comments on the proposed changes, or anything is unclear
 about the design, I'd like to hear from you.

 Thanks,

 Adam Gundry

 ___
 Glasgow-haskell-users mailing list
 Glasgow-haskell-users@haskell.org
 http://www.haskell.org/mailman/listinfo/glasgow-haskell-users
The wiki page says:

The base design has the following distinct components:

  * A library class

class Has (r :: *) (f :: String) (t :: *) where
  get :: r - t

  * A record declaration generates an instance declaration for each
field. For example

data T a = T1 { x :: a, y :: Bool }
 | T2 { x :: a }

would generate

instance (t~a) = Has (T a) x t where
  get (T1 x _) = x
  get (T2 x)   = x
instance (t~Bool) = Has (T a) y t where
  get (T1 _ y) = y 

Is this instance for y not partial? If it is, is that a problem?
Perhaps I missed something that makes that instance total.

- Ollie




signature.asc
Description: OpenPGP digital signature
___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Overloaded record fields

2013-06-24 Thread Erik Hesselink
It looks like this instance is partial. Note that the record field 'y'
is also a partial function in plain Haskell. I've always considered
this a misfeature, but perhaps fixing that is outside the scope of
this proposal.

Erik

On Mon, Jun 24, 2013 at 4:40 PM, Oliver Charles ol...@ocharles.org.uk wrote:
 On 06/24/2013 08:44 AM, Adam Gundry wrote:
 Hi everyone,

 I am implementing an overloaded record fields extension for GHC as a
 GSoC project. Thanks to all those who gave their feedback on the
 original proposal! I've started to document the plan on the GHC wiki:

 http://hackage.haskell.org/trac/ghc/wiki/Records/OverloadedRecordFields/Plan

 If you have any comments on the proposed changes, or anything is unclear
 about the design, I'd like to hear from you.

 Thanks,

 Adam Gundry

 ___
 Glasgow-haskell-users mailing list
 Glasgow-haskell-users@haskell.org
 http://www.haskell.org/mailman/listinfo/glasgow-haskell-users
 The wiki page says:

 The base design has the following distinct components:

   * A library class

 class Has (r :: *) (f :: String) (t :: *) where
   get :: r - t

   * A record declaration generates an instance declaration for each
 field. For example

 data T a = T1 { x :: a, y :: Bool }
  | T2 { x :: a }

 would generate

 instance (t~a) = Has (T a) x t where
   get (T1 x _) = x
   get (T2 x)   = x
 instance (t~Bool) = Has (T a) y t where
   get (T1 _ y) = y

 Is this instance for y not partial? If it is, is that a problem?
 Perhaps I missed something that makes that instance total.

 - Ollie



 ___
 Glasgow-haskell-users mailing list
 Glasgow-haskell-users@haskell.org
 http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users