Re: [Haskell-cafe] Deduce problem.

2011-11-21 Thread Ben Franksen
Magicloud Magiclouds wrote:
> So I think I got what you guys meant, I limited ClassB to only H.
> Then how to archive my requirement, that from and to only return items
> that instanced ClassB?

If you are willing to go beyond Haskell98 (or Haskell2010), you can use a 
multi-parameter class. Enable the extension:

{-# LANGUAGE MultiParamTypeClasses #-}

An then, instead of

class (ClassA a) => ClassC a where
  from :: (ClassB b) => a -> [b]
  to :: (ClassB c) => a -> [c]

you say

class (ClassA a, ClassB b) => ClassC a b c where
  from :: c -> [b]
  to :: c -> [a]

This means that for each triple of concrete types (a,b,c) that you wish to 
be an instance of ClassC, you must provide an instance declaration, e.g.

instance ClassC Test H H where
  from = ...whatever...
  to = ...whatever...

Now you have the fixed type H in the instance declaration and not a 
universally quantified type variable.

Cheers
Ben


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


Re: [Haskell-cafe] Deduce problem.

2011-11-17 Thread Magicloud Magiclouds
From the code, I think it is what I want. But still, I need some time
to understand it
Anyway, thank you.

On Thu, Nov 17, 2011 at 4:02 PM,   wrote:
>
> Multi-parameter type classes are more flexible. Here is how you can
> write your old code:
>
>> {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
>>
>> class (ClassA a, ClassB b) => ClassC a b where
>>   from :: a -> [b]
>>   to   :: a -> [b]
>>
>> data H = H
>>
>> class ClassA a where toInt :: a -> Int
>> class ClassB b where fromInt :: Int -> b
>>
>> instance ClassB H where fromInt _ = H
>>
>> data Test = Test { m :: H }
>> instance ClassA Test where toInt _ = 0
>>
>> instance ClassC Test H where
>>   from = (:[]) . m
>>   to   = (:[]) . m
>
>
> The constraints in the ClassC a b declaration specify that in all
> instances of ClassC, the type a must be in ClassA and the type b must
> be in ClassB. This is the case for the "ClassC Test H" instance.
>
> You can also specify that for some particular 'a' the function 'from'
> can produce the value of the type [b] for any b in ClassB. The caller
> will determine which b it wants. This is similar to your original
> intention, as I understand.
>
>> instance ClassA Int where toInt = id
>>
>> instance ClassB b => ClassC Int b where
>>   from x = [fromInt x]
>>
>> t1:: [H]
>> t1 = from (5::Int)
>
>
>



-- 
竹密岂妨流水过
山高哪阻野云飞

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


Re: [Haskell-cafe] Deduce problem.

2011-11-17 Thread oleg

Multi-parameter type classes are more flexible. Here is how you can
write your old code:

> {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
>
> class (ClassA a, ClassB b) => ClassC a b where
>   from :: a -> [b]
>   to   :: a -> [b]
>
> data H = H
>
> class ClassA a where toInt :: a -> Int
> class ClassB b where fromInt :: Int -> b
>
> instance ClassB H where fromInt _ = H
>
> data Test = Test { m :: H }
> instance ClassA Test where toInt _ = 0
>
> instance ClassC Test H where
>   from = (:[]) . m
>   to   = (:[]) . m


The constraints in the ClassC a b declaration specify that in all
instances of ClassC, the type a must be in ClassA and the type b must
be in ClassB. This is the case for the "ClassC Test H" instance.

You can also specify that for some particular 'a' the function 'from'
can produce the value of the type [b] for any b in ClassB. The caller
will determine which b it wants. This is similar to your original
intention, as I understand.

> instance ClassA Int where toInt = id
>
> instance ClassB b => ClassC Int b where
>   from x = [fromInt x]
>
> t1:: [H]
> t1 = from (5::Int)



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


Re: [Haskell-cafe] Deduce problem.

2011-11-16 Thread Magicloud Magiclouds
On Thu, Nov 17, 2011 at 1:17 PM, Brandon Allbery  wrote:
> On Wed, Nov 16, 2011 at 23:54, Magicloud Magiclouds
>  wrote:
>>
>> I think this is where I did not understand from the very beginning.
>> If the the declaration was correct, then why cannot b be H?
>> Referring to Data.List.genericLength, I was confused.
>
> Because it doesn't mean that *you* get to decide what it is; it means *the
> caller* gets to decide, and you are obligated to honor the caller's wishes.
>  Returning always an H violates this, because there is no way to prove that
> H is the only possible response.
> --
> brandon s allbery                                      allber...@gmail.com
> wandering unix systems administrator (available)     (412) 475-9364 vm/sms
>
>

Ah, list and single value is a typo problem.

So I think I got what you guys meant, I limited ClassB to only H.
Then how to archive my requirement, that from and to only return items
that instanced ClassB?

-- 
竹密岂妨流水过
山高哪阻野云飞

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


Re: [Haskell-cafe] Deduce problem.

2011-11-16 Thread Brandon Allbery
On Wed, Nov 16, 2011 at 23:54, Magicloud Magiclouds <
magicloud.magiclo...@gmail.com> wrote:

> I think this is where I did not understand from the very beginning.
> If the the declaration was correct, then why cannot b be H?
> Referring to Data.List.genericLength, I was confused.


Because it doesn't mean that *you* get to decide what it is; it means *the
caller* gets to decide, and you are obligated to honor the caller's wishes.
 Returning always an H violates this, because there is no way to prove that
H is the only possible response.

-- 
brandon s allbery  allber...@gmail.com
wandering unix systems administrator (available) (412) 475-9364 vm/sms
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Deduce problem.

2011-11-16 Thread MigMit
Of course, b can be H. The important question is: why can't it be something 
else? ClassC signature implies that b can be anything (of class ClassB) — not 
just H.

Another error is that you declare from as returning a list, but you try to 
implement it as returning a single value.

On 17 Nov 2011, at 08:54, Magicloud Magiclouds wrote:

> I think this is where I did not understand from the very beginning.
> If the the declaration was correct, then why cannot b be H?
> Referring to Data.List.genericLength, I was confused.
> 
> On Thu, Nov 17, 2011 at 12:34 PM, MigMit  wrote:
>> You've declared "from" as forall b. Test -> [b], but you're trying to 
>> implement it as Test -> H.
>> 
>> On 17 Nov 2011, at 07:48, Magicloud Magiclouds wrote:
>> 
>>> Hi,
>>>  Consider I have declarations like this:
>>> class (ClassA a) => ClassC a where
>>>  from :: (ClassB b) => a -> [b]
>>>  to :: (ClassB c) => a -> [c]
>>> 
>>> data H = ...
>>> 
>>> instance ClassB H where
>>>  ...
>>> 
>>> data Test = Test { m :: H }
>>> instance ClassA Test where
>>>  ...
>>> instance ClassC Test where
>>>  from = m
>>>  to = m
>>> 
>>>  Well, I got "could not deduce" error here at "from = m" and "to =
>>> m". `c' is a rigid type variable bound by the type signature for to ::
>>> ClassB c => Test -> [c].
>>>  Referring to some similar questions on internet, I should remove the
>>> (ClassB c) thing. Is this the only solution?
>>> --
>>> 竹密岂妨流水过
>>> 山高哪阻野云飞
>>> 
>>> ___
>>> 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] Deduce problem.

2011-11-16 Thread Magicloud Magiclouds
I think this is where I did not understand from the very beginning.
If the the declaration was correct, then why cannot b be H?
Referring to Data.List.genericLength, I was confused.

On Thu, Nov 17, 2011 at 12:34 PM, MigMit  wrote:
> You've declared "from" as forall b. Test -> [b], but you're trying to 
> implement it as Test -> H.
>
> On 17 Nov 2011, at 07:48, Magicloud Magiclouds wrote:
>
>> Hi,
>>  Consider I have declarations like this:
>> class (ClassA a) => ClassC a where
>>  from :: (ClassB b) => a -> [b]
>>  to :: (ClassB c) => a -> [c]
>>
>> data H = ...
>>
>> instance ClassB H where
>>  ...
>>
>> data Test = Test { m :: H }
>> instance ClassA Test where
>>  ...
>> instance ClassC Test where
>>  from = m
>>  to = m
>>
>>  Well, I got "could not deduce" error here at "from = m" and "to =
>> m". `c' is a rigid type variable bound by the type signature for to ::
>> ClassB c => Test -> [c].
>>  Referring to some similar questions on internet, I should remove the
>> (ClassB c) thing. Is this the only solution?
>> --
>> 竹密岂妨流水过
>> 山高哪阻野云飞
>>
>> ___
>> 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] Deduce problem.

2011-11-16 Thread MigMit
You've declared "from" as forall b. Test -> [b], but you're trying to implement 
it as Test -> H.

On 17 Nov 2011, at 07:48, Magicloud Magiclouds wrote:

> Hi,
>  Consider I have declarations like this:
> class (ClassA a) => ClassC a where
>  from :: (ClassB b) => a -> [b]
>  to :: (ClassB c) => a -> [c]
> 
> data H = ...
> 
> instance ClassB H where
>  ...
> 
> data Test = Test { m :: H }
> instance ClassA Test where
>  ...
> instance ClassC Test where
>  from = m
>  to = m
> 
>  Well, I got "could not deduce" error here at "from = m" and "to =
> m". `c' is a rigid type variable bound by the type signature for to ::
> ClassB c => Test -> [c].
>  Referring to some similar questions on internet, I should remove the
> (ClassB c) thing. Is this the only solution?
> -- 
> 竹密岂妨流水过
> 山高哪阻野云飞
> 
> ___
> 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] Deduce problem.

2011-11-16 Thread Magicloud Magiclouds
On Thu, Nov 17, 2011 at 11:48 AM, Magicloud Magiclouds
 wrote:
> Hi,
>  Consider I have declarations like this:
> class (ClassA a) => ClassC a where
>  from :: (ClassB b) => a -> [b]
>  to :: (ClassB c) => a -> [c]
>
> data H = ...
>
> instance ClassB H where
>  ...
>
> data Test = Test { m :: H }
> instance ClassA Test where
>  ...
> instance ClassC Test where
>  from = m
>  to = m
>
>  Well, I got "could not deduce" error here at "from = m" and "to =
> m". `c' is a rigid type variable bound by the type signature for to ::
> ClassB c => Test -> [c].
>  Referring to some similar questions on internet, I should remove the
> (ClassB c) thing. Is this the only solution?
> --
> 竹密岂妨流水过
> 山高哪阻野云飞
>

I was wrong, forall b. did not help

-- 
竹密岂妨流水过
山高哪阻野云飞

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