b3ae86651c0b0de91c5da766ee6721e29df7a737
[ghc.git] / testsuite / tests / typecheck / should_compile / tc181.hs
1 {-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
2 {-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies,
3 FlexibleInstances, FlexibleContexts, UndecidableInstances #-}
4
5 -- Example of improvement, due to George Russel
6
7 module Folders where
8
9 data Folder = Folder
10
11 newtype SB x = SB x
12 newtype SS x = SS x
13
14 data NodeArcsHidden = NodeArcsHidden
15
16 class HasSS hasS x | hasS -> x where
17 toSS :: hasS -> SS x
18
19 instance HasSS (SB x) x where
20 toSS (SB x) = (SS x)
21
22 class HMV option graph node where
23 modd :: option -> graph -> node value -> IO ()
24
25 instance HMV NodeArcsHidden graph node
26 => HMV (Maybe NodeArcsHidden) graph node
27 where
28 modd = error "burk"
29
30 gn :: HMV NodeArcsHidden graph node
31 => graph
32 -> SS (graph -> node Int -> IO ())
33 gn graph = fmapSS (\ arcsHidden -> (\ graph node -> modd arcsHidden graph node))
34 (toSS (error "C" :: SB (Maybe NodeArcsHidden)))
35
36 -- The call to modd gives rise to
37 -- HMV option graph node
38 -- The call to toSS gives rise to
39 -- HasSS (SB (Maybe NodeArcsHidden)) x
40 -- where (toSS (error ...)) :: SS x
41 -- and hence arcsHidden :: x
42 --
43 -- Then improvement should give x = Maybe NodeArcsHidden
44 -- and hence option=Maybe NodeArcsHidden
45
46 fmapSS :: (a->b) -> SS a -> SS b
47 fmapSS = error "urk"