Re: [Haskell-cafe] Type Constraints on Data Constructors

2011-06-09 Thread Guy
Malcolm Wallace  me.com> writes:

> The class context on the data constructor buys you nothing extra in terms of
expressivity in the language. 
> All it does is force you to repeat the context on every function that uses the
datatype.  For this reason, the
> language committee has decided that the feature will be removed in the next
revision of Haskell.
> 
> Regards,
> Malcolm

Why not infer class contexts from type or data constructors, instead of ignoring
them?

Having to repeatedly state redundant type information is not a desirable state
of affairs.


___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Type Constraints on Data Constructors

2011-06-09 Thread Daniel Schüssler
You could do something like this, but admittedly it appears slightly clunky:

newtype Baz f a = Baz (Foo f => BazInner f a)

data BazInner f a = BazInner { baz :: f a, baz2 :: f a }

instance Foo (Baz f) where
foo a = Baz (let b = foo a in BazInner b b) 

Cheers,
Daniel

On 2011-June-09 Thursday 15:25:40 Guy wrote:
> Can this be extended to records, without redundant repetition?
> 
> data Baz f a = Baz {baz :: Foo f => f a, baz2 :: Foo f => f a}
> 
> The type constraint for baz2 adds no information, as it's the same f as
> baz, but I can't leave it out.
> 
> 
> 
> - Original Message -
> 
> > From: Daniel Schüssler 
> > To: haskell-cafe@haskell.org
> > Cc: Guy 
> > Sent: Thursday, 9 June 2011, 2:06
> > Subject: Re: [Haskell-cafe] Type Constraints on Data Constructors
> > 
> > Hello,
> > 
> > you might be thinking of this type?
> > 
> > {-# LANGUAGE Rank2Types #-}
> > 
> > class Foo f where
> > foo :: a -> f a
> > 
> > data Baz f a = Baz (forall f. Foo f => f a)
> > 
> > instance Foo (Baz f) where
> >  foo a = Baz (foo a)
> > 
> > Maybe the difference between Bar and Baz ist best explained by writing it
> > with an explicit class dictionary for Foo:
> > 
> > {-# LANGUAGE Rank2Types #-}
> > 
> > data FooDict f = FooDict {
> > foo :: forall a. a -> f a
> > }
> > 
> > data Bar f a = Bar (FooDict f) (f a)
> > 
> > data Baz f a = Baz (FooDict f -> f a)
> > 
> > fooDict_Baz :: FooDict (Baz f)
> > fooDict_Baz = FooDict (\a -> Baz (\d -> foo d a))
> > 
> > -- fooDict_Bar :: FooDict (Bar f)
> > -- fooDict_Bar = FooDict (\a -> Bar ? ?)
> > -- Doesn't work - you'd have to create a 'FooDict f' and a
> > 'f a' out of just
> > an 'a'
> > 
> > 
> > 
> > Cheers,
> > Daniel
> 
> ___
> Haskell-Cafe mailing list
> Haskell-Cafe@haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Type Constraints on Data Constructors

2011-06-09 Thread Daniel Schüssler
Correction: I meant

data Baz f a = Baz (Foo f => f a)

(Dropped the 'forall', which would make the inner 'f' have nothing to do with 
the type parameter 'f' of 'Baz')

On 2011-June-09 Thursday 01:07:13 Daniel Schüssler wrote:
> Hello,
> 
> you might be thinking of this type?
> 
> {-# LANGUAGE Rank2Types #-}
> 
> class Foo f where
> foo :: a -> f a
> 
> data Baz f a = Baz (forall f. Foo f => f a)
> 
> instance Foo (Baz f) where
>  foo a = Baz (foo a)
> 
> Maybe the difference between Bar and Baz ist best explained by writing it
> with an explicit class dictionary for Foo:
> 
> {-# LANGUAGE Rank2Types #-}
> 
> data FooDict f = FooDict {
>   foo :: forall a. a -> f a
>   }
> 
> data Bar f a = Bar (FooDict f) (f a)
> 
> data Baz f a = Baz (FooDict f -> f a)
> 
> fooDict_Baz :: FooDict (Baz f)
> fooDict_Baz = FooDict (\a -> Baz (\d -> foo d a))
> 
> -- fooDict_Bar :: FooDict (Bar f)
> -- fooDict_Bar = FooDict (\a -> Bar ? ?)
> -- Doesn't work - you'd have to create a 'FooDict f' and a 'f a' out of
> just an 'a'
> 
> 
> 
> Cheers,
> Daniel
> 
> On 2011-June-08 Wednesday 20:45:56 Guy wrote:
> > {- continuing discussion from beginners@ -}
> > 
> > I have code such as
> > 
> > class Foo f where
> > 
> >  foo :: a -> f a
> > 
> > data Bar f a = Foo f => Bar {bar :: f a}
> > 
> > instance Foo (Bar f) where
> > 
> >  foo a = Bar $ foo a
> > 
> > GHC insists that I put Foo f => on the instance declaration, even though
> > the constructor for Bar implies this.
> > 
> > Is there any reason why GHC cannot infer this constraint from the Bar
> > constructor? One issue raised in the beginners thread is that
> > undefined :: Bar f a
> > is not Foo f, but as undefined cannot be evaluated, this would not appear
> > to be a problem.
> > 
> > 
> > ___
> > Haskell-Cafe mailing list
> > Haskell-Cafe@haskell.org
> > http://www.haskell.org/mailman/listinfo/haskell-cafe
> 
> ___
> Haskell-Cafe mailing list
> Haskell-Cafe@haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe


___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Type Constraints on Data Constructors

2011-06-09 Thread Guy
Can this be extended to records, without redundant repetition?

data Baz f a = Baz {baz :: Foo f => f a, baz2 :: Foo f => f a}

The type constraint for baz2 adds no information, as it's the same f as baz, 
but I can't leave it out.



- Original Message -
> From: Daniel Schüssler 
> To: haskell-cafe@haskell.org
> Cc: Guy 
> Sent: Thursday, 9 June 2011, 2:06
> Subject: Re: [Haskell-cafe] Type Constraints on Data Constructors
> 
> Hello,
> 
> you might be thinking of this type?
> 
> {-# LANGUAGE Rank2Types #-}
> 
> class Foo f where
>     foo :: a -> f a
> 
> data Baz f a = Baz (forall f. Foo f => f a) 
> 
> instance Foo (Baz f) where
>      foo a = Baz (foo a)
> 
> Maybe the difference between Bar and Baz ist best explained by writing it 
> with 
> an explicit class dictionary for Foo:
> 
> {-# LANGUAGE Rank2Types #-} 
> 
> data FooDict f = FooDict { 
>         foo :: forall a. a -> f a 
>     }
> 
> data Bar f a = Bar (FooDict f) (f a) 
> 
> data Baz f a = Baz (FooDict f -> f a) 
> 
> fooDict_Baz :: FooDict (Baz f)
> fooDict_Baz = FooDict (\a -> Baz (\d -> foo d a)) 
> 
> -- fooDict_Bar :: FooDict (Bar f)
> -- fooDict_Bar = FooDict (\a -> Bar ? ?) 
> -- Doesn't work - you'd have to create a 'FooDict f' and a 
> 'f a' out of just 
> an 'a'
> 
> 
> 
> Cheers,
> Daniel

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Type Constraints on Data Constructors

2011-06-09 Thread Erik Hesselink
On Thu, Jun 9, 2011 at 09:46, DavidA  wrote:
> I think that's exactly what the original poster is complaining about. As a 
> real-
> life example, consider
> data Graph a = Ord a => G [a] [[a]]
>
> My intention is that whenever I have a Graph a, I want to be able to use the 
> Ord
> instance on a.
>
> So suppose I now define
> automorphisms :: (Ord a) => Graph a -> [Permutation a]
>
> On the basis of the "don't repeat yourself" principle, it seems redundant to
> have to specify the (Ord a) context here, since I already specified it in the
> data constructor for Graph a.
>
> So this is a proposal for a change to the language: don't require a context 
> on a
> function if it is already implied by a context on a data type.

You can do this using GADTs. Like this:

data Graph a where
  G :: Ord a => [a] -> [[a]] -> Graph a

Now functions that pattern match on the 'G' constructor automatically
have the Ord instance in scope, so it is no longer needed in the
signature.

Erik

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Type Constraints on Data Constructors

2011-06-09 Thread DavidA
Malcolm Wallace  me.com> writes:

> 
> 
> > data Bar f a = Foo f => Bar {bar :: f a}
> 
> The class context on the data constructor buys you nothing extra in terms of 
expressivity in the language. 
> All it does is force you to repeat the context on every function that uses 
> the 
datatype.  For this reason, the
> language committee has decided that the feature will be removed in the next 
revision of Haskell.
> 
> Regards,
> Malcolm
> 

"All it does is force you to repeat the context on every function that uses the 
datatype"

I think that's exactly what the original poster is complaining about. As a real-
life example, consider
data Graph a = Ord a => G [a] [[a]]

My intention is that whenever I have a Graph a, I want to be able to use the 
Ord 
instance on a.

So suppose I now define
automorphisms :: (Ord a) => Graph a -> [Permutation a]

On the basis of the "don't repeat yourself" principle, it seems redundant to 
have to specify the (Ord a) context here, since I already specified it in the 
data constructor for Graph a.

So this is a proposal for a change to the language: don't require a context on 
a 
function if it is already implied by a context on a data type.

(This would make even more sense for newtypes, where we know there is exactly 
one data constructor, so no possibility of different data constructors 
requiring 
different contexts.)



___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Type Constraints on Data Constructors

2011-06-08 Thread Daniel Schüssler
Hello,

you might be thinking of this type?

{-# LANGUAGE Rank2Types #-}

class Foo f where
foo :: a -> f a

data Baz f a = Baz (forall f. Foo f => f a) 

instance Foo (Baz f) where
 foo a = Baz (foo a)

Maybe the difference between Bar and Baz ist best explained by writing it with 
an explicit class dictionary for Foo:

{-# LANGUAGE Rank2Types #-} 

data FooDict f = FooDict { 
foo :: forall a. a -> f a 
}

data Bar f a = Bar (FooDict f) (f a) 

data Baz f a = Baz (FooDict f -> f a) 

fooDict_Baz :: FooDict (Baz f)
fooDict_Baz = FooDict (\a -> Baz (\d -> foo d a)) 

-- fooDict_Bar :: FooDict (Bar f)
-- fooDict_Bar = FooDict (\a -> Bar ? ?) 
-- Doesn't work - you'd have to create a 'FooDict f' and a 'f a' out of just 
an 'a'



Cheers,
Daniel

On 2011-June-08 Wednesday 20:45:56 Guy wrote:
> {- continuing discussion from beginners@ -}
> 
> I have code such as
> 
> class Foo f where
>  foo :: a -> f a
> 
> data Bar f a = Foo f => Bar {bar :: f a}
> 
> instance Foo (Bar f) where
>  foo a = Bar $ foo a
> 
> GHC insists that I put Foo f => on the instance declaration, even though
> the constructor for Bar implies this.
> 
> Is there any reason why GHC cannot infer this constraint from the Bar
> constructor? One issue raised in the beginners thread is that
> undefined :: Bar f a
> is not Foo f, but as undefined cannot be evaluated, this would not appear
> to be a problem.
> 
> 
> ___
> Haskell-Cafe mailing list
> Haskell-Cafe@haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Type Constraints on Data Constructors

2011-06-08 Thread David Menendez
On Wed, Jun 8, 2011 at 3:15 PM, Malcolm Wallace  wrote:
>
>> data Bar f a = Foo f => Bar {bar :: f a}
>
> The class context on the data constructor buys you nothing extra in terms of 
> expressivity in the language.  All it does is force you to repeat the context 
> on every function that uses the datatype.  For this reason, the language 
> committee has decided that the feature will be removed in the next revision 
> of Haskell.

You're thinking of a context on the type constructor, i.e.,

data Foo f => Bar f a = Bar { bar :: f a }


The reason the original code does not work is that the constructor
only adds Foo f to the class context during pattern matching. So, for
example, this works:

baz :: Bar f a -> a -> f a   -- n.b., no Foo context
baz (Bar _) = foo

But the code in the original post is trying to create a value of type
Bar f a, so the context is needed.

-- 
Dave Menendez 


___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Type Constraints on Data Constructors

2011-06-08 Thread Malcolm Wallace

> data Bar f a = Foo f => Bar {bar :: f a}

The class context on the data constructor buys you nothing extra in terms of 
expressivity in the language.  All it does is force you to repeat the context 
on every function that uses the datatype.  For this reason, the language 
committee has decided that the feature will be removed in the next revision of 
Haskell.

Regards,
Malcolm


___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Type Constraints on Data Constructors

2011-06-08 Thread Guy

{- continuing discussion from beginners@ -}

I have code such as

class Foo f where
foo :: a -> f a

data Bar f a = Foo f => Bar {bar :: f a}

instance Foo (Bar f) where
foo a = Bar $ foo a

GHC insists that I put Foo f => on the instance declaration, even though the 
constructor for Bar implies this.

Is there any reason why GHC cannot infer this constraint from the Bar constructor? One issue raised in the beginners 
thread is that

undefined :: Bar f a
is not Foo f, but as undefined cannot be evaluated, this would not appear to be 
a problem.


___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe