Newcomers question

I'm trying: instance Num b => Num (a -> b) where fromInteger = pure . Prelude.fromInteger negate = fmap Prelude.negate (+) = liftA2 (Prelude.+) (*) = liftA2 (Prelude.*) abs = fmap Prelude.abs signum = fmap Prelude.signum but the compiler rejects it with: src\Main.hs:24:9: Could not deduce (Show (a -> b), Eq (a -> b)) from the context (Num b) arising from the superclasses of an instance declaration at src\Main.hs:24:9-29 Possible fix: add (Show (a -> b), Eq (a -> b)) to the context of the instance declaration or add an instance declaration for (Show (a -> b), Eq (a -> b)) In the instance declaration for `Num (a -> b)' Could someone please explain this to me? I thought that it might be that it couldn't work out the functions necessary for (a->b) to be in the classes Show and Eq - so I tried adding definitions for == ans show, but it made no difference. Thanks

On Sat, 31 Oct 2009, b1g3ar5 wrote:
I'm trying:
instance Num b => Num (a -> b) where fromInteger = pure . Prelude.fromInteger negate = fmap Prelude.negate (+) = liftA2 (Prelude.+) (*) = liftA2 (Prelude.*) abs = fmap Prelude.abs signum = fmap Prelude.signum
but the compiler rejects it with:
src\Main.hs:24:9: Could not deduce (Show (a -> b), Eq (a -> b)) from the context (Num b) arising from the superclasses of an instance declaration at src\Main.hs:24:9-29 Possible fix: add (Show (a -> b), Eq (a -> b)) to the context of the instance declaration or add an instance declaration for (Show (a -> b), Eq (a -> b)) In the instance declaration for `Num (a -> b)'
Could someone please explain this to me?
I thought that it might be that it couldn't work out the functions necessary for (a->b) to be in the classes Show and Eq - so I tried adding definitions for == ans show, but it made no difference.
You have to define instances for Show and Eq, that is methods 'show' and (==), because the Num class has these classes as superclasses. This has been criticised a lot and is e.g. not the case in NumericPrelude. However, I would not seriously define a Num instance for functions: http://www.haskell.org/haskellwiki/Num_instance_for_functions

For some reason, Show and Eq are superclasses of Num (despite Num not
actually using any of their methods), meaning that the compiler forces
you to write instances of Eq and Show before it even lets you write a
Num instance. I don't think anybody likes this, but I think we're
stuck with it for the foreseeable future.
On Sat, Oct 31, 2009 at 7:31 PM, b1g3ar5
I'm trying:
instance Num b => Num (a -> b) where fromInteger = pure . Prelude.fromInteger negate = fmap Prelude.negate (+) = liftA2 (Prelude.+) (*) = liftA2 (Prelude.*) abs = fmap Prelude.abs signum = fmap Prelude.signum
but the compiler rejects it with:
src\Main.hs:24:9: Could not deduce (Show (a -> b), Eq (a -> b)) from the context (Num b) arising from the superclasses of an instance declaration at src\Main.hs:24:9-29 Possible fix: add (Show (a -> b), Eq (a -> b)) to the context of the instance declaration or add an instance declaration for (Show (a -> b), Eq (a -> b)) In the instance declaration for `Num (a -> b)'
Could someone please explain this to me?
I thought that it might be that it couldn't work out the functions necessary for (a->b) to be in the classes Show and Eq - so I tried adding definitions for == ans show, but it made no difference.
Thanks
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

OK, I understand that now but I've got a supplimentary question.
If I put:
instance Eq b => Eq (a -> b) where
(==) = liftA2 (Prelude.==)
to do the Eq part I get another error:
Couldn't match expected type `Bool'
against inferred type `a -> Bool'
In the expression: liftA2 (==)
In the definition of `==': == = liftA2 (==)
In the instance declaration for `Eq (a -> b)'
Now can someone please explain this?
I'm hoping that when I've understood this stuff I'll have made a small
step to understanding Haskell.
Thanks.
On 31 Oct, 23:38, Daniel Peebles
For some reason, Show and Eq are superclasses of Num (despite Num not actually using any of their methods), meaning that the compiler forces you to write instances of Eq and Show before it even lets you write a Num instance. I don't think anybody likes this, but I think we're stuck with it for the foreseeable future.
On Sat, Oct 31, 2009 at 7:31 PM, b1g3ar5
wrote: I'm trying:
instance Num b => Num (a -> b) where fromInteger = pure . Prelude.fromInteger negate = fmap Prelude.negate (+) = liftA2 (Prelude.+) (*) = liftA2 (Prelude.*) abs = fmap Prelude.abs signum = fmap Prelude.signum
but the compiler rejects it with:
src\Main.hs:24:9: Could not deduce (Show (a -> b), Eq (a -> b)) from the context (Num b) arising from the superclasses of an instance declaration at src\Main.hs:24:9-29 Possible fix: add (Show (a -> b), Eq (a -> b)) to the context of the instance declaration or add an instance declaration for (Show (a -> b), Eq (a -> b)) In the instance declaration for `Num (a -> b)'
Could someone please explain this to me?
I thought that it might be that it couldn't work out the functions necessary for (a->b) to be in the classes Show and Eq - so I tried adding definitions for == ans show, but it made no difference.
Thanks
_______________________________________________ Haskell-Cafe mailing list Haskell-C...@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
_______________________________________________ Haskell-Cafe mailing list Haskell-C...@haskell.orghttp://www.haskell.org/mailman/listinfo/haskell-cafe

The type of liftA2 :: Applicative f =>(a -> b -> c) -> f a -> f b -> f
c. Thus, the type of liftA2 (==) :: (Eq b, Applicative f) => f b -> f
b -> f Bool. In your case, f :: a -> b, so liftA2 (==) :: (Eq b) => (a
-> b) -> (a -> b) -> (a -> Bool). (==) takes two arguments, so you're
left with the type (liftA2 (==)) x y :: a -> Bool. This contradicts
the class definition of Eq, which says that the type of (==) after
giving it two arguments must be Bool, not a -> Bool.
I hope that's clear enough. Busting out GHCi and using :t to find the
types of a lot of these expressions can be really helpful.
Alex
On Sun, Nov 1, 2009 at 8:09 AM, b1g3ar5
OK, I understand that now but I've got a supplimentary question.
If I put:
instance Eq b => Eq (a -> b) where (==) = liftA2 (Prelude.==)
to do the Eq part I get another error:
Couldn't match expected type `Bool' against inferred type `a -> Bool' In the expression: liftA2 (==) In the definition of `==': == = liftA2 (==) In the instance declaration for `Eq (a -> b)'
Now can someone please explain this?
I'm hoping that when I've understood this stuff I'll have made a small step to understanding Haskell.
Thanks.
On 31 Oct, 23:38, Daniel Peebles
wrote: For some reason, Show and Eq are superclasses of Num (despite Num not actually using any of their methods), meaning that the compiler forces you to write instances of Eq and Show before it even lets you write a Num instance. I don't think anybody likes this, but I think we're stuck with it for the foreseeable future.
On Sat, Oct 31, 2009 at 7:31 PM, b1g3ar5
wrote: I'm trying:
instance Num b => Num (a -> b) where fromInteger = pure . Prelude.fromInteger negate = fmap Prelude.negate (+) = liftA2 (Prelude.+) (*) = liftA2 (Prelude.*) abs = fmap Prelude.abs signum = fmap Prelude.signum
but the compiler rejects it with:
src\Main.hs:24:9: Could not deduce (Show (a -> b), Eq (a -> b)) from the context (Num b) arising from the superclasses of an instance declaration at src\Main.hs:24:9-29 Possible fix: add (Show (a -> b), Eq (a -> b)) to the context of the instance declaration or add an instance declaration for (Show (a -> b), Eq (a -> b)) In the instance declaration for `Num (a -> b)'
Could someone please explain this to me?
I thought that it might be that it couldn't work out the functions necessary for (a->b) to be in the classes Show and Eq - so I tried adding definitions for == ans show, but it made no difference.
Thanks
_______________________________________________ Haskell-Cafe mailing list Haskell-C...@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
_______________________________________________ Haskell-Cafe mailing list Haskell-C...@haskell.orghttp://www.haskell.org/mailman/listinfo/haskell-cafe
Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

On Sun, Nov 1, 2009 at 11:09 AM, b1g3ar5
OK, I understand that now but I've got a supplimentary question.
If I put:
instance Eq b => Eq (a -> b) where (==) = liftA2 (Prelude.==)
You don't need the "Prelude." here.
to do the Eq part I get another error:
Couldn't match expected type `Bool' against inferred type `a -> Bool' In the expression: liftA2 (==) In the definition of `==': == = liftA2 (==) In the instance declaration for `Eq (a -> b)'
Now can someone please explain this?
The type of liftA2 (==) is forall f b. Applicative f => f b -> f b ->
f Bool. In your case, f is (->) a, so liftA2 (==) :: (a -> b) -> (a ->
b) -> (a -> Bool), which can't be unified with the type for (==).
Personally, I recommend against trying to make (a -> b) an instance of
Num. If you really want to do arithmetic on functions, it's easier to
just do something along these lines:
(.+.),(.-.),(.*.) :: (Applicative f, Num a) => f a -> f a -> f a
(.+.) = liftA2 (+)
(.-.) = liftA2 (-)
(.*.) = liftA2 (*)
--
Dave Menendez
participants (5)
-
Alexander Dunlap
-
b1g3ar5
-
Daniel Peebles
-
David Menendez
-
Henning Thielemann