<div dir="ltr"><div>Hi Daniel,<br><br></div><div>One way to get around your problem is to make a list of all paths through the given records, then filter that list to contain only the fields that match with the last label and result type:<br></div><div><br><a href="https://gist.github.com/aavogt/c206c45362ed2115f392">https://gist.github.com/aavogt/c206c45362ed2115f392</a><br><br></div><div>I'm not sure that "filtering by result type" is a good idea, at least at this point, because it doesn't work well when you have type variables in the record or result type. Part of the problem seems to be that Data.Type.Equality.== gets stuck when it sees type variables: I think what is really needed in that case is a way to ask if (a ~ b) would be a type error.<br><br></div><div>Regards,<br></div><div>Adam<br></div><div><br></div></div><div class="gmail_extra"><br><div class="gmail_quote">On Wed, Feb 24, 2016 at 7:12 PM, Daniel Díaz <span dir="ltr"><<a href="mailto:diaz.carrete@gmail.com" target="_blank">diaz.carrete@gmail.com</a>></span> wrote:<br><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex"><div dir="ltr">I wonder if is there is some way of making the labels "transitive". For example, if I have a record embedded in another record, it would be nice if the labels of the embedded record worked for the enclosing record as well, assuming there's no ambiguity.<div><br></div><div>Here's an attempt. Consider this "strengthened" version of IsLabel that uses functional dependencies. Only certain fields will be able to have instances:</div><div><br></div><blockquote style="margin:0 0 0 40px;border:none;padding:0px"><div>class IsLabel symbol (a -> b) => IsUnambiguousLabel symbol a b | symbol -> a b, a b -> symbol, symbol a -> b, symbol b -> a</div></blockquote><div><br></div><div>and then this</div><div><br></div><blockquote style="margin:0 0 0 40px;border:none;padding:0px"><div><div>instance (IsUnambiguousLabel symbol1 a b, IsUnambiguousLabel symbol2 b c) => IsLabel symbol2 (a -> c) where</div></div><div><div>    fromLabel _ = fromLabel (proxy# :: (Proxy# symbol2)) . fromLabel (proxy# :: (Proxy# symbol1))</div></div></blockquote><div><br></div><div>But it doesn't work. GHC complains angrily about overlapping instances.</div><div><div><div><span class=""><br>On Tuesday, February 23, 2016 at 10:16:21 AM UTC+1, Adam Gundry wrote:</span><blockquote class="gmail_quote" style="margin:0;margin-left:0.8ex;border-left:1px #ccc solid;padding-left:1ex"><div><div class="h5">Hi,
<br>
<br>The type of `fromLabel` is
<br>
<br>    forall (x :: Symbol) a . IsLabel x a => Proxy# x -> a
<br>
<br>where `x` represents the text of the label, so rather than applying it to
<br>
<br>    (proxy# :: (Proxy# (Person -> String)))
<br>
<br>you need to apply it to
<br>
<br>    (proxy# :: Proxy# symbol)
<br>
<br>and you will need to turn on the ScopedTypeVariables extension (so that
<br>`symbol` refers to the variable bound in the class instance). With that
<br>change, your program works.
<br>
<br>That's a truly atrocious error message though. It's marginally better if
<br>you enable -fprint-explicit-kinds:
<br>
<br>    • Expected kind ‘Proxy# GHC.Types.Symbol ((->) Person String)’,
<br>        but ‘proxy# :: Proxy# (Person -> String)’ has kind
<br>          ‘Proxy# * (Person -> String)’
<br>
<br>This shows the real problem, namely that you have `Proxy# *` instead of
<br>`Proxy# Symbol`. However, `Proxy# Symbol ((->) Person String)` is
<br>blatantly ill-kinded, so the error message doesn't make much sense. I
<br>suggest you file a GHC ticket, if there isn't a suitable one already.
<br>
<br>Hope this helps,
<br>
<br>Adam
<br>
<br>
<br>On 23/02/16 08:29, Daniel Díaz wrote:
<br>> Hi all, 
<br>> 
<br>> I'm playing with the OverloadedLabels extension in GHC 8 RC2. I have
<br>> been able to define simple record accessors, like in this
<br>> gist: <a href="https://gist.github.com/danidiaz/3b9a6865686c777f328c" rel="nofollow" target="_blank">https://gist.github.com/danidiaz/3b9a6865686c777f328c</a>
<br>> 
<br>> After realizing than with OverloadedLabels a single symbol can be used
<br>> to extract two different types from the same record, I tried to define
<br>> an instance that says: "if a symbol can be used to extract an string
<br>> from my record, then it can also be used to extract that a Text value".
<br>> 
<br>> Here's my attempt (using a dummy Text type):
<br>> 
<br>>     {-# LANGUAGE OverloadedLabels #-}
<br>>     {-# LANGUAGE DataKinds #-}
<br>>     {-# LANGUAGE FlexibleInstances #-}
<br>>     {-# LANGUAGE FlexibleContexts #-}
<br>>     {-# LANGUAGE UndecidableInstances #-}
<br>>     {-# LANGUAGE MultiParamTypeClasses #-}
<br>>     {-# LANGUAGE MagicHash #-}
<br>>     module Main where
<br>> 
<br>>     import GHC.OverloadedLabels
<br>>     import GHC.Prim
<br>> 
<br>>     newtype Text = Text { getText :: String } deriving Show 
<br>> 
<br>>     data Person = Person { _id :: Int ,  _name :: String }
<br>> 
<br>>     instance IsLabel "name" (Person -> String) where
<br>>         fromLabel _ =  _name
<br>> 
<br>>     instance IsLabel symbol (Person -> String) => IsLabel symbol (Person
<br>>     -> Text) where
<br>>         fromLabel _ =  Text . fromLabel (proxy# :: (Proxy# (Person ->
<br>>     String))) 
<br>> 
<br>>     person :: Person
<br>>     person = Person 123 "Horace"
<br>> 
<br>>     main :: IO ()
<br>>     main = do
<br>>         print (#name person :: String)
<br>>         print (#name person :: Text)
<br>> 
<br>> 
<br>> Bu this doesn't work. The error I get is puzzling:
<br>> 
<br>>         • Expected kind ‘Proxy# ((->) Person String)’,
<br>>             but ‘proxy# :: Proxy# (Person -> String)’ has kind ‘Proxy#
<br>>     (Person -> String)’
<br>>         • In the first argument of ‘fromLabel’, namely
<br>>             ‘(proxy# :: Proxy# (Person -> String))’
<br>> 
<br>> 
<br>> Is this a bug? What is going on here?
<br>
<br>
<br>-- 
<br>Adam Gundry, Haskell Consultant
<br>Well-Typed LLP, <a href="http://www.well-typed.com/" rel="nofollow" target="_blank">http://www.well-typed.com/</a>
<br>_______________________________________________
<br>Haskell-Cafe mailing list
<br></div></div><a rel="nofollow">Haskel...@haskell.org</a>
<br><a href="http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe" rel="nofollow" target="_blank">http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe</a>
<br></blockquote></div></div></div></div><br>_______________________________________________<br>
Haskell-Cafe mailing list<br>
<a href="mailto:Haskell-Cafe@haskell.org">Haskell-Cafe@haskell.org</a><br>
<a href="http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe" rel="noreferrer" target="_blank">http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe</a><br>
<br></blockquote></div><br></div>