[Haskell-cafe] Re: [Haskell] help with some basic code that doesn't work

Cale Gibbard cgibbard at gmail.com
Mon Feb 7 18:50:29 EST 2005


Delete

data Maybe Dir = Just Dir | Nothing

as it is unnecessary "Maybe a" is defined already for any type "a"
(and doesn't make sense, Dir occuring before the = sign would indicate
that it is a type variable, but it is uppercase), and also change

data Dir = Left | Right | Up | Down
data Piece = Vertical | Horizontal | CodeA | CodeB

to

data Dir = Left | Right | Up | Down deriving Eq
data Piece = Vertical | Horizontal | CodeA | CodeB deriving Eq

Equality isn't defined by default on user-defined datatypes, so that
you can add your own definition. In this case your type is pretty
simple, so you can use the derived instance of Eq, so that (==) and
(/=) get defined for Dir and Piece.

You should also add the line
import Prelude hiding (Left, Right)
as these are the names of the data constructors for the Either type,
and you will get ambiguity errors if you don't rename them or hide the
ones in the Prelude.

Lastly, you should probably rename your 'fst' to 'frst' or some such,
so that it doesn't overlap with the Prelude function of the same name.

hope this helps,
 - Cale


On Mon, 7 Feb 2005 20:36:55 +0000, pablo daniel rey
<listas at pablodanielrey.com.ar> wrote:
> hello
> i'm new to haskell so i'm sorry if this is a stupid question, but i'm having problems with some basic code.
> the code :
>
> data Maybe Dir = Just Dir | Nothing
> data Dir = Left | Right | Up | Down
> data Piece = Vertical | Horizontal | CodeA | CodeB
>
> flow = [(Horizontal, Left, Left),
>      (Horizontal, Right, Right),
>      (Vertical, Down, Down),
>      (Vertical, Up, Up), ................ etc ]
>
> fst :: (a,b,c) -> a
> fst (x,y,z) = x
>
> scnd :: (a,b,c) -> b
> scnd (x,y,z) = y
>
> third :: (a,b,c) -> c
> third (x,y,z) = z
>
> element :: [(Piece, Dir, Dir)] -> Maybe Dir
> element [] = Nothing
> element xs = Just (third (head xs))
>
> chgDir :: Piece -> Dir -> Maybe Dir
> chgDir p d = element (filter (\x -> p == (fst x)) (filter (\x -> d == (scnd x)) flow))
>
> the error i get :
>
> Instances of (Eq Dir, Eq Piece) required for definition of chgDir
>
> i don't know what's happening.
> help!!!
> thanks in advance
> _______________________________________________
> Haskell mailing list
> Haskell at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell
>


More information about the Haskell-Cafe mailing list