1 files changed, 42 insertions, 7 deletions

diff --git a/src/Remote/KRPC.hs b/src/Remote/KRPC.hs
index 485327e1..71faa3f3 100644
--- a/src/Remote/KRPC.hs
+++ b/src/Remote/KRPC.hs
@@ -84,12 +84,13 @@
 --
 --   For protocol details see 'Remote.KRPC.Protocol' module.
 --
-{-# LANGUAGE OverloadedStrings  #-}
-{-# LANGUAGE FlexibleContexts   #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE ExplicitForAll     #-}
-{-# LANGUAGE KindSignatures     #-}
-{-# LANGUAGE ViewPatterns       #-}
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE ViewPatterns        #-}
+{-# LANGUAGE FlexibleContexts    #-}
+{-# LANGUAGE DeriveDataTypeable  #-}
+{-# LANGUAGE ExplicitForAll      #-}
+{-# LANGUAGE KindSignatures      #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 module Remote.KRPC
        ( -- * Method
          Method(..)
@@ -116,6 +117,7 @@ import Data.BEncode
 import Data.ByteString.Char8 as BC
 import Data.List as L
 import Data.Map  as M
+import Data.Monoid
 import Data.Typeable
 import Network
 
@@ -154,7 +156,40 @@ data Method param result = Method {
   , methodVals   :: [ValName]
   }
 
--- TODO ppMethod
+instance (Typeable a, Typeable b) => Show (Method a b) where
+  showsPrec _ = showsMethod
+
+showsMethod
+  :: forall a. forall b.
+     Typeable a => Typeable b
+  => Method a b -> ShowS
+showsMethod Method {..} =
+    showString (BC.unpack methodName) <>
+    showString " :: " <>
+    showsTuple methodParams paramsTy <>
+    showString " -> " <>
+    showsTuple methodVals valuesTy
+  where
+    paramsTy = typeOf (error "KRPC.showsMethod: impossible" :: a)
+    valuesTy = typeOf (error "KRPC.showsMethod: impossible" :: b)
+
+    showsTuple ns ty
+      = showChar '('
+     <> mconcat (L.intersperse (showString ", ") $
+                                L.zipWith showsTyArgName ns (detuple ty))
+     <> showChar ')'
+
+    showsTyArgName ns ty
+      = showString (BC.unpack ns)
+     <> showString " :: "
+     <> showString (show ty)
+
+    detuple tyRep
+        | L.null args = [tyRep]
+        |  otherwise  = args
+      where
+        args = typeRepArgs tyRep
+
 
 -- | Identity procedure signature. Could be used for echo
 -- servers. Implemented as: