<div dir="ltr">Hi all, <div><br></div><div>I'm playing with the OverloadedLabels extension in GHC 8 RC2. I have been able to define simple record accessors, like in this gist: https://gist.github.com/danidiaz/3b9a6865686c777f328c</div><div><br></div><div>After realizing than with OverloadedLabels a single symbol can be used to extract two different types from the same record, I tried to define an instance that says: "if a symbol can be used to extract an string from my record, then it can also be used to extract that a Text value".</div><div><br></div><div>Here's my attempt (using a dummy Text type):</div><div><br></div><blockquote style="margin: 0 0 0 40px; border: none; padding: 0px;"><div><div>{-# LANGUAGE OverloadedLabels #-}</div></div><div><div>{-# LANGUAGE DataKinds #-}</div></div><div><div>{-# LANGUAGE FlexibleInstances #-}</div></div><div><div>{-# LANGUAGE FlexibleContexts #-}</div></div><div><div>{-# LANGUAGE UndecidableInstances #-}</div></div><div><div>{-# LANGUAGE MultiParamTypeClasses #-}</div></div><div><div>{-# LANGUAGE MagicHash #-}</div></div><div><div>module Main where</div></div><div><div><br></div></div><div><div>import GHC.OverloadedLabels</div></div><div><div>import GHC.Prim</div></div><div><div><br></div></div><div><div>newtype Text = Text { getText :: String } deriving Show </div></div><div><div><br></div></div><div><div>data Person = Person { _id :: Int ,  _name :: String }</div></div><div><div><br></div></div><div><div>instance IsLabel "name" (Person -> String) where</div></div><div><div>    fromLabel _ =  _name</div></div><div><div><br></div></div><div><div>instance IsLabel symbol (Person -> String) => IsLabel symbol (Person -> Text) where</div></div><div><div>    fromLabel _ =  Text . fromLabel (proxy# :: (Proxy# (Person -> String))) </div></div><div><div><br></div></div><div><div>person :: Person</div></div><div><div>person = Person 123 "Horace"</div></div><div><div><br></div></div><div><div>main :: IO ()</div></div><div><div>main = do</div></div><div><div>    print (#name person :: String)</div></div><div><div>    print (#name person :: Text)</div></div></blockquote><div><br></div><div>Bu this doesn't work. The error I get is puzzling:</div><div><br></div><blockquote style="margin: 0 0 0 40px; border: none; padding: 0px;"><div><div>    • Expected kind ‘Proxy# ((->) Person String)’,</div></div><div><div>        but ‘proxy# :: Proxy# (Person -> String)’ has kind ‘Proxy# (Person -> String)’</div></div><div><div>    • In the first argument of ‘fromLabel’, namely</div></div><div><div>        ‘(proxy# :: Proxy# (Person -> String))’</div></div></blockquote><div><br></div><div>Is this a bug? What is going on here?</div></div>