X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=inline;f=Text%2FShow%2FFunctions.hs;h=c66d2e3156cefcd0e4c5fb42c3d1bb985b341a46;hb=7dfe4a22aa6a2c598b1496c661c7d532aaafa94f;hp=d0e2207c4467cb27122f5f3fd20f623d27a6bf99;hpb=22e69fd9a80574ea154b78b7d0dec49f384b8aad;p=ghc-base.git

diff --git a/Text/Show/Functions.hs b/Text/Show/Functions.hs
index d0e2207..c66d2e3 100644
--- a/Text/Show/Functions.hs
+++ b/Text/Show/Functions.hs
@@ -1,3 +1,5 @@
+-- This module deliberately declares orphan instances:
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Text.Show.Functions
@@ -22,4 +24,12 @@ import Prelude
 #ifndef __NHC__
 instance Show (a -> b) where
 	showsPrec _ _ = showString "<function>"
+#else
+instance (Show a,Show b) => Show (a->b) where
+  showsPrec d a = showString "<<function>>"
+
+  showsType a = showChar '(' . showsType value  . showString " -> " .
+                               showsType result . showChar ')'
+                where (value,result) = getTypes undefined
+                      getTypes x = (x,a x)
 #endif