1 files changed, 46 insertions, 0 deletions
diff --git a/testsuite/tests/typecheck/should_compile/tc181.hs b/testsuite/tests/typecheck/should_compile/tc181.hs
new file mode 100644
index 0000000000..6ccf6b90de
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/tc181.hs
@@ -0,0 +1,46 @@
+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies,
+             FlexibleInstances, FlexibleContexts, UndecidableInstances #-}
+
+-- Example of improvement, due to George Russel
+
+module Folders where
+
+data Folder = Folder 
+
+newtype SB x = SB x
+newtype SS x = SS x 
+
+data NodeArcsHidden = NodeArcsHidden
+
+class HasSS hasS x | hasS -> x where
+   toSS :: hasS -> SS x
+
+instance HasSS (SB x) x where
+   toSS (SB x) = (SS x)
+
+class HMV option graph node where
+   modd :: option -> graph -> node value -> IO ()
+
+instance HMV NodeArcsHidden graph node 
+      => HMV (Maybe NodeArcsHidden) graph node 
+  where
+   modd = error "burk"
+
+gn :: HMV NodeArcsHidden graph node 
+   => graph 
+   -> SS (graph -> node Int -> IO ())
+gn graph = fmapSS (\ arcsHidden -> (\ graph node -> modd arcsHidden graph node))
+	          (toSS (error "C" :: SB (Maybe NodeArcsHidden)))
+
+-- The call to modd gives rise to
+--	HMV option graph node
+-- The call to toSS gives rise to
+--	HasSS (SB (Maybe NodeArcsHidden)) x  
+-- where (toSS (error ...)) :: SS x
+-- and hence arcsHidden :: x
+--
+-- Then improvement should give x = Maybe NodeArcsHidden
+-- and hence option=Maybe NodeArcsHidden
+   
+fmapSS :: (a->b) -> SS a -> SS b
+fmapSS = error "urk"