<div dir="ltr">It works, thanks!<div><br></div><div>I was wondering: if I define a bunch of records in a module, how to make this the behaviour for all records in the module, without much boilerplate and without affecting any records elsewhere?</div><div><br></div><div>One possible solution would be to define a empty type class that will not be exported:</div><div><br></div><blockquote style="margin: 0 0 0 40px; border: none; padding: 0px;"><div>class Marker r</div></blockquote><div><br></div><div><div>and the following instance:</div></div><div><br></div><blockquote style="margin: 0 0 0 40px; border: none; padding: 0px;"><div><div>instance (Marker r,IsLabel symbol (r -> String)) => IsLabel symbol (r -> Text) where</div></div><div><div>    fromLabel _ =  Text . fromLabel (proxy# :: (Proxy# symbol))</div></div></blockquote><div><br></div><div>And make every record in the module an instance of Marker:</div><div><br></div><blockquote style="margin: 0 0 0 40px; border: none; padding: 0px;"><div>instance Marker Person</div></blockquote><div><br></div><div>I'm not sure if there's a simpler way.</div><div><br></div><div>Even if we don't export the fields directly, another way to employ OverloadedLabels (OverloadedRecordFields, once it arrives) is for giving default implementations of public interfaces, in combination with DefaultSignatures. A not very useful example:</div><div><br></div><blockquote style="margin: 0 0 0 40px; border: none; padding: 0px;"><div><div>class Named r where</div></div><div><div>    name :: r -> String      </div></div><div><div>    default name :: IsLabel "name" (r -> String) => r -> String</div></div><div><div>    name = #name</div></div></blockquote><div><br></div><div>           instance Named Person</div><div><br>On Tuesday, February 23, 2016 at 10:16:21 AM UTC+1, Adam Gundry wrote:<blockquote class="gmail_quote" style="margin: 0;margin-left: 0.8ex;border-left: 1px #ccc solid;padding-left: 1ex;">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" target="_blank" rel="nofollow" onmousedown="this.href='https://www.google.com/url?q\75https%3A%2F%2Fgist.github.com%2Fdanidiaz%2F3b9a6865686c777f328c\46sa\75D\46sntz\0751\46usg\75AFQjCNG4vYEI_iLdhWbq8xD-ZJn7AsKhJg';return true;" onclick="this.href='https://www.google.com/url?q\75https%3A%2F%2Fgist.github.com%2Fdanidiaz%2F3b9a6865686c777f328c\46sa\75D\46sntz\0751\46usg\75AFQjCNG4vYEI_iLdhWbq8xD-ZJn7AsKhJg';return true;">https://gist.github.com/<wbr>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/" target="_blank" rel="nofollow" onmousedown="this.href='http://www.google.com/url?q\75http%3A%2F%2Fwww.well-typed.com%2F\46sa\75D\46sntz\0751\46usg\75AFQjCNH3dPQhLlEisdkTYU2PhDTx4rrvnA';return true;" onclick="this.href='http://www.google.com/url?q\75http%3A%2F%2Fwww.well-typed.com%2F\46sa\75D\46sntz\0751\46usg\75AFQjCNH3dPQhLlEisdkTYU2PhDTx4rrvnA';return true;">http://www.well-typed.com/</a>
<br>______________________________<wbr>_________________
<br>Haskell-Cafe mailing list
<br><a href="javascript:" target="_blank" gdf-obfuscated-mailto="X-dlEYzlFgAJ" rel="nofollow" onmousedown="this.href='javascript:';return true;" onclick="this.href='javascript:';return true;">Haskel...@haskell.org</a>
<br><a href="http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe" target="_blank" rel="nofollow" onmousedown="this.href='http://www.google.com/url?q\75http%3A%2F%2Fmail.haskell.org%2Fcgi-bin%2Fmailman%2Flistinfo%2Fhaskell-cafe\46sa\75D\46sntz\0751\46usg\75AFQjCNH7sFgl7KfuDcDlaGGG3ip3kRaoIA';return true;" onclick="this.href='http://www.google.com/url?q\75http%3A%2F%2Fmail.haskell.org%2Fcgi-bin%2Fmailman%2Flistinfo%2Fhaskell-cafe\46sa\75D\46sntz\0751\46usg\75AFQjCNH7sFgl7KfuDcDlaGGG3ip3kRaoIA';return true;">http://mail.haskell.org/cgi-<wbr>bin/mailman/listinfo/haskell-<wbr>cafe</a>
<br></blockquote></div></div>