Ticket #3691: wiki.hs

File wiki.hs, 2.0 KB (added by arsenm, 5 years ago)

Slightly modified test case from wiki

Line 
1{-# LANGUAGE EmptyDataDecls,
2             MultiParamTypeClasses,
3             FunctionalDependencies,
4             OverlappingInstances,
5             FlexibleInstances,
6             UndecidableInstances #-}
7module Main where
8
9import Prelude hiding (print)
10
11class Print a where
12    print :: a -> IO ()
13
14{- the following does not work:
15instance Show a => Print a where
16    print x = putStrLn (show x)
17instance        Print a where
18    print x = putStrLn "No show method"
19
20error:
21    Duplicate instance declarations:
22      instance (Show a) => Print a -- Defined at /tmp/wiki.hs:7:0
23      instance Print a -- Defined at /tmp/wiki.hs:9:0
24-}
25
26class Print' flag a where
27    print' :: flag -> a -> IO ()
28
29instance (ShowPred a flag, Print' flag a) => Print a where
30    print = print' (undefined::flag)
31
32
33-- overlapping instances are used only for ShowPred
34class ShowPred a flag | a->flag where {}
35
36                                  -- Used only if the other
37                                  -- instances don't apply
38instance TypeCast flag HFalse => ShowPred a flag
39
40instance ShowPred Int  HTrue   -- These instances should be
41instance ShowPred Bool HTrue   -- the same as Show's
42instance ShowPred a flag => ShowPred [a] flag
43--  ...etc...
44
45
46data HTrue    -- Just two
47data HFalse   -- distinct types
48
49instance Show a => Print' HTrue a where
50   print' _ x = putStrLn (show x)
51instance Print' HFalse a where
52   print' _ x = putStrLn "No show method"
53
54test1 = print [True,False] -- [True,False]
55test2 = print id           -- No show method
56
57
58
59
60-- see http://okmij.org/ftp/Haskell/typecast.html
61class TypeCast   a b   | a -> b, b->a   where typeCast   :: a -> b
62class TypeCast'  t a b | t a -> b, t b -> a where typeCast'  :: t->a->b
63class TypeCast'' t a b | t a -> b, t b -> a where typeCast'' :: t->a->b
64instance TypeCast'  () a b => TypeCast a b where typeCast x = typeCast' () x
65instance TypeCast'' t a b => TypeCast' t a b where typeCast' = typeCast''
66instance TypeCast'' () a a where typeCast'' _ x  = x
67
68