[Haskell] Problem with constructing instances for a class Pair
Frank
frank at geoinfo.tuwien.ac.at
Fri Dec 23 16:02:28 EST 2005
i want the operations on pairs to work for lists
applying to each pair in the list.
i prefer to achieve this with overloading, using classes and instances
i cannot get from the code for the ordinary case:
class P a where
outl :: a b c -> b
...
data P1 p q = P1 p q deriving (Show, Eq, Ord)
-- a pair like constructor
instance P P1 where
outl (P1 p q) = p
to code for the mapped case:
instance P [P1] where ....
gives
-- - Kind error: `P1' is not applied to enough type arguments
-- - In the instance declaration for `P [P1]'
no other combination of parameters i can think of works for an
instance of class P for lists.
what do i not see? any help appreciated!
andrew frank
the remainder is the code i have tried:
-}
module PairTest where
class P a where
outl :: a b c -> b
outr :: a b c -> c
make :: b -> c -> a b c
data P1 p q = P1 p q deriving (Show, Eq, Ord)
type P2 = (,)
instance P P2 where
outl = fst
outr = snd
make = (,)
instance P P1 where
outl (P1 p q) = p
outr (P1 p q) = q
make = P1
p1list :: [P1 Int Bool]
p1list = [P1 3 True, P1 4 False]
qlist = fmap outr p1list -- or map
--------------can this be done as overloading of outl, outr for lists?
outlPl = fmap outl
plist = outlPl p1list
--instance P [P1] where
-- outl = fmap outl
-- - Kind error: `P1' is not applied to enough type arguments
-- - In the instance declaration for `P [P1]'
--instance P [P1 p q] where
-- outl = fmap outl
-- Kind error: Expecting kind `* -> * -> *', but `[P1 p q]' has kind `*'
-- In the instance declaration for `P [P1 p q]'
class P3 a b c where
outl3 :: a b c -> b
--instance P3 [P1 p q]
-- - Kind error: Expecting kind `* -> * -> *', but `[P1 p q]' has kind
`*'
-- - In the instance declaration for `P3 [P1 p q]'
Andrew U. Frank
Professor, Head of Department
Geoinformation and Cartography E127 phone: +43 1 588 01 12710
TU Vienna secr. +43 1 588 01 12700
Gusshausstrasse 27-29 fax +43 1 588 01 12799
A-1040 Vienna Austria cellular phone +43 676 41925 72
http://www.geoinfo.tuwien.ac.at/persons/frank/frank.html
skype:AndrewUFrank
More information about the Haskell
mailing list