[Haskell-cafe] Playing with OverloadedLabels in GHC 8 RC2, how to do this?
Adam Gundry
adam at well-typed.com
Fri Feb 26 22:24:37 UTC 2016
On 25/02/16 00:12, Daniel Díaz wrote:
> 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.
Sadly I think transitivity is going to be hard to achieve, without
endless overlapping instance problems, because it's not clear how to
make type inference determine the "in-between" type.
> Here's an attempt. Consider this "strengthened" version of IsLabel that
> uses functional dependencies. Only certain fields will be able to have
> instances:
>
> class IsLabel symbol (a -> b) => IsUnambiguousLabel symbol a b |
> symbol -> a b, a b -> symbol, symbol a -> b, symbol b -> a
>
> and then this
>
> instance (IsUnambiguousLabel symbol1 a b, IsUnambiguousLabel symbol2
> b c) => IsLabel symbol2 (a -> c) where
> fromLabel _ = fromLabel (proxy# :: (Proxy# symbol2)) . fromLabel
> (proxy# :: (Proxy# symbol1))
>
> But it doesn't work. GHC complains angrily about overlapping instances.
It took me a while to understand that the overlap is actually between
the instance being defined, and one of its own superclasses. You can
resolve it by giving a type signature to one of the `fromLabel`
occurrences, thereby fixing the intermediate variable. But I've not been
able to get much further...
All the best,
Adam
> On Tuesday, February 23, 2016 at 10:16:21 AM UTC+1, Adam Gundry wrote:
>
> Hi,
>
> The type of `fromLabel` is
>
> forall (x :: Symbol) a . IsLabel x a => Proxy# x -> a
>
> where `x` represents the text of the label, so rather than applying
> it to
>
> (proxy# :: (Proxy# (Person -> String)))
>
> you need to apply it to
>
> (proxy# :: Proxy# symbol)
>
> and you will need to turn on the ScopedTypeVariables extension (so that
> `symbol` refers to the variable bound in the class instance). With that
> change, your program works.
>
> That's a truly atrocious error message though. It's marginally
> better if
> you enable -fprint-explicit-kinds:
>
> • Expected kind ‘Proxy# GHC.Types.Symbol ((->) Person String)’,
> but ‘proxy# :: Proxy# (Person -> String)’ has kind
> ‘Proxy# * (Person -> String)’
>
> This shows the real problem, namely that you have `Proxy# *` instead of
> `Proxy# Symbol`. However, `Proxy# Symbol ((->) Person String)` is
> blatantly ill-kinded, so the error message doesn't make much sense. I
> suggest you file a GHC ticket, if there isn't a suitable one already.
>
> Hope this helps,
>
> Adam
>
>
> On 23/02/16 08:29, Daniel Díaz wrote:
> > Hi all,
> >
> > 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
> <https://gist.github.com/danidiaz/3b9a6865686c777f328c>
> >
> > 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".
> >
> > Here's my attempt (using a dummy Text type):
> >
> > {-# LANGUAGE OverloadedLabels #-}
> > {-# LANGUAGE DataKinds #-}
> > {-# LANGUAGE FlexibleInstances #-}
> > {-# LANGUAGE FlexibleContexts #-}
> > {-# LANGUAGE UndecidableInstances #-}
> > {-# LANGUAGE MultiParamTypeClasses #-}
> > {-# LANGUAGE MagicHash #-}
> > module Main where
> >
> > import GHC.OverloadedLabels
> > import GHC.Prim
> >
> > newtype Text = Text { getText :: String } deriving Show
> >
> > data Person = Person { _id :: Int , _name :: String }
> >
> > instance IsLabel "name" (Person -> String) where
> > fromLabel _ = _name
> >
> > instance IsLabel symbol (Person -> String) => IsLabel symbol
> (Person
> > -> Text) where
> > fromLabel _ = Text . fromLabel (proxy# :: (Proxy# (Person ->
> > String)))
> >
> > person :: Person
> > person = Person 123 "Horace"
> >
> > main :: IO ()
> > main = do
> > print (#name person :: String)
> > print (#name person :: Text)
> >
> >
> > Bu this doesn't work. The error I get is puzzling:
> >
> > • Expected kind ‘Proxy# ((->) Person String)’,
> > but ‘proxy# :: Proxy# (Person -> String)’ has kind
> ‘Proxy#
> > (Person -> String)’
> > • In the first argument of ‘fromLabel’, namely
> > ‘(proxy# :: Proxy# (Person -> String))’
> >
> >
> > Is this a bug? What is going on here?
--
Adam Gundry, Haskell Consultant
Well-Typed LLP, http://www.well-typed.com/
More information about the Haskell-Cafe
mailing list