in the show instance for Exception, print the type of dynamic exceptions

Unfortunately this requires some recursve module hackery to get at
the show instance for Typeable.

diff --git a/Data/Dynamic.hs-boot b/Data/Dynamic.hs-boot
index 822ef67..63c81b9 100644 (file)
--- a/Data/Dynamic.hs-boot
+++ b/Data/Dynamic.hs-boot
@@ -1,3 +1,5 @@
 {-# OPTIONS -fno-implicit-prelude #-}
 module Data.Dynamic where
+import {-# SOURCE #-} Data.Typeable (TypeRep)
 data Dynamic
+dynTypeRep :: Dynamic -> TypeRep

diff --git a/Data/Typeable.hs-boot b/Data/Typeable.hs-boot
new file mode 100644 (file)
index 0000000..4250e56
--- /dev/null
+++ b/Data/Typeable.hs-boot
@@ -0,0 +1,3 @@
+{-# OPTIONS -fno-implicit-prelude #-}
+module Data.Typeable where
+data TypeRep

diff --git a/GHC/Dynamic.hs b/GHC/Dynamic.hs
new file mode 100644 (file)
index 0000000..e86b027
--- /dev/null
+++ b/GHC/Dynamic.hs
@@ -0,0 +1,11 @@
+{-# OPTIONS -fno-implicit-prelude #-}
+module GHC.Dynamic (
+       Dynamic, TypeRep, dynTypeRep, showsTypeRep
+  ) where
+
+import Data.Dynamic    ( Dynamic, dynTypeRep )
+import Data.Typeable   ( TypeRep )
+import GHC.Show ( ShowS, shows )
+
+showsTypeRep :: TypeRep -> ShowS
+showsTypeRep = shows

diff --git a/GHC/Dynamic.hs-boot b/GHC/Dynamic.hs-boot
new file mode 100644 (file)
index 0000000..a926421
--- /dev/null
+++ b/GHC/Dynamic.hs-boot
@@ -0,0 +1,10 @@
+{-# OPTIONS -fno-implicit-prelude #-}
+module GHC.Dynamic (
+       Dynamic, TypeRep, dynTypeRep, showsTypeRep
+  ) where
+
+import {-# SOURCE #-} Data.Dynamic     ( Dynamic, dynTypeRep )
+import {-# SOURCE #-} Data.Typeable    ( TypeRep )
+import GHC.Show                ( ShowS )
+
+showsTypeRep :: TypeRep -> ShowS

diff --git a/GHC/IOBase.lhs b/GHC/IOBase.lhs
index 78a334d..27f7dab 100644 (file)
--- a/GHC/IOBase.lhs
+++ b/GHC/IOBase.lhs
@@ -55,7 +55,7 @@ import GHC.List
 import GHC.Read
 
 #ifndef __HADDOCK__
-import {-# SOURCE #-} Data.Dynamic
+import {-# SOURCE #-} GHC.Dynamic
 #endif
 
 -- ---------------------------------------------------------------------------
@@ -743,7 +743,7 @@ instance Show Exception where
   showsPrec _ (RecConError err)                 = showString err
   showsPrec _ (RecUpdError err)                 = showString err
   showsPrec _ (AssertionFailed err)      = showString err
-  showsPrec _ (DynException _err)        = showString "unknown exception"
+  showsPrec _ (DynException err)         = showString "exception :: " . showsTypeRep (dynTypeRep err)
   showsPrec _ (AsyncException e)        = shows e
   showsPrec _ (BlockedOnDeadMVar)       = showString "thread blocked indefinitely"
   showsPrec _ (BlockedIndefinitely)     = showString "thread blocked indefinitely"