[Haskell-cafe] newbie : multi-parameter type classes
Thomas Girod
girodt at gmail.com
Fri Aug 24 05:48:13 EDT 2007
Hi there.
I'm trying to define a generic graph type here and don't understand on one
error I get. Here I come.
module Graph
where
class (Eq n, Eq e) => Topo a n e where
empty :: a
nodes :: a -> [n]
edges :: a -> [e]
data Node n = Node n
deriving (Eq,Show)
data Edge n e = Edge e (Node n) (Node n)
deriving (Show)
instance (Eq e) => Eq (Edge n e) where
(Edge e1 _ _) == (Edge e2 _ _) = e1 == e2
data Graph n e = Graph [Node n] [Edge n e]
deriving (Eq,Show)
instance (Eq n, Eq e) => Topo (Graph n e) (Node n) (Edge n e) where
empty = Graph [] []
nodes (Graph ns _) = ns
edges (Graph _ es) = es
My class Topo (for topography) is supposed to give the basic interface any
graph should have.
My instance is Topo (Graph n e) (Node n) (Edge n e), so the infered types of
the functions should be :
empty :: Graph n e
nodes :: Graph n e -> [Nodes n]
edges :: Graph n e -> [Edge n e]
right ?
When I load the code in GHCi, no errors. But then :
*Graph> let g = Graph [Node 0, Node 1] []
*Graph> nodes g
<interactive>:1:0:
No instance for (Topo (Graph Integer e1) n e)
arising from use of `nodes' at <interactive>:1:0-6
Possible fix:
add an instance declaration for (Topo (Graph Integer e1) n e)
In the expression: nodes g
In the definition of `it': it = nodes g
*Graph>
And I don't understand this. How can he search for an instance of Topo
(Graph integer e1) n e) ?
regards,
Thomas
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/haskell-cafe/attachments/20070824/5a694b66/attachment-0001.htm
More information about the Haskell-Cafe
mailing list