defining "info" for "ESC i".

GHCMod.hs

@@ -28,6 +28,7 @@ usage =    "ghc-mod version 0.5.0\n"
         ++ "\t ghc-mod [-l] browse <module> [<module> ...]\n"
         ++ "\t ghc-mod check <HaskellFile>\n"
         ++ "\t ghc-mod type <HaskellFile> <expression>\n"
+        ++ "\t ghc-mod info <HaskellFile> <expression>\n"
         ++ "\t ghc-mod [-h opt] lint <HaskellFile>\n"
         ++ "\t ghc-mod boot\n"
         ++ "\t ghc-mod help\n"
@@ -75,6 +76,7 @@ main = flip catches handlers $ do
       "list"   -> listModules opt
       "check"  -> withFile (checkSyntax opt) (safelist cmdArg 1)
       "type"   -> withFile (typeExpr opt (safelist cmdArg 2)) (safelist cmdArg 1)
+      "info"   -> withFile (infoExpr opt (safelist cmdArg 2)) (safelist cmdArg 1)
       "lint"   -> withFile (lintSyntax opt)  (safelist cmdArg 1)
       "lang"   -> listLanguages opt
       "boot"   -> do

Info.hs

@@ -1,10 +1,16 @@
 module Info where
 
-import Control.Applicative
+import Control.Applicative hiding (empty)
+import Data.Maybe
 import GHC
 import Outputable
 import PprTyThing
 import Types
+import NameSet
+import HscTypes
+import Data.List
+
+----------------------------------------------------------------
 
 typeExpr :: Options -> String -> String -> IO String
 typeExpr _ expr file = (++ "\n") <$> typeOf file expr
@@ -17,8 +23,50 @@ typeOf fileName expr = withGHC $ do
     setContextFromTarget
     pretty <$> exprType expr
   where
-    setContextFromTarget = do
-        ms <- depanal [] False
-        mdl <- findModule (ms_mod_name (head ms)) Nothing
-        setContext [mdl] []
     pretty = showSDocForUser neverQualify . pprTypeForUser False
+
+----------------------------------------------------------------
+
+infoExpr :: Options -> String -> String -> IO String
+infoExpr _ expr file = (++ "\n") <$> info file expr
+
+info :: String -> String -> IO String
+info fileName expr = withGHC $ do
+    initSession []
+    setTargetFile fileName
+    load LoadAllTargets
+    setContextFromTarget
+    infoThing expr
+  where
+    -- ghc/InteractiveUI.hs
+    infoThing str = do
+        names <- parseName str
+        mb_stuffs <- mapM getInfo names
+        let filtered = filterOutChildren (\(t,_f,_i) -> t) (catMaybes mb_stuffs)
+        unqual <- getPrintUnqual
+        return $ showSDocForUser unqual $ vcat (intersperse (text "") $ map (pprInfo False) filtered)
+
+-- ghc/InteractiveUI.hs
+filterOutChildren :: (a -> TyThing) -> [a] -> [a]
+filterOutChildren get_thing xs
+  = [x | x <- xs, not (getName (get_thing x) `elemNameSet` implicits)]
+  where
+      implicits = mkNameSet [getName t | x <- xs, t <- implicitTyThings (get_thing x)]
+
+pprInfo :: PrintExplicitForalls -> (TyThing, Fixity, [GHC.Instance]) -> SDoc
+pprInfo pefas (thing, fixity, insts)
+  =  pprTyThingInContextLoc pefas thing
+  $$ show_fixity fixity
+  $$ vcat (map pprInstance insts)
+  where
+    show_fixity fix
+        | fix == defaultFixity = empty
+        | otherwise            = ppr fix <+> ppr (getName thing)
+
+----------------------------------------------------------------
+
+setContextFromTarget :: Ghc ()
+setContextFromTarget = do
+    ms <- depanal [] False
+    mdl <- findModule (ms_mod_name (head ms)) Nothing
+    setContext [mdl] []

elisp/ghc-info.el

@@ -10,14 +10,35 @@
 
 (require 'ghc-func)
 
-(defun ghc-show-type ()
+(defun ghc-show-type (&optional ask)
-  (interactive)
+  (interactive "P")
   (if (not (ghc-which ghc-module-command))
       (message "%s not found" ghc-module-command)
-    (let ((expr (thing-at-point 'symbol))
+    (let* ((expr0 (thing-at-point 'symbol))
-	  (file (buffer-name)))
+	   (expr (if ask (ghc-read-expression expr0) expr0))
+	   (file (buffer-name)))
       (with-temp-buffer
 	(call-process ghc-module-command nil t nil "type" file expr)
 	(message (buffer-substring (point-min) (1- (point-max))))))))
 
+(defun ghc-show-info (&optional ask)
+  (interactive "P")
+  (if (not (ghc-which ghc-module-command))
+      (message "%s not found" ghc-module-command)
+    (let* ((expr0 (thing-at-point 'symbol))
+	   (expr (if ask (ghc-read-expression expr0) expr0))
+	   (file (buffer-name))
+	   (buf (get-buffer-create ghc-error-buffer-name)))
+      (with-current-buffer buf
+        (erase-buffer)
+	(insert
+	 (with-temp-buffer
+	   (call-process ghc-module-command nil t nil "info" file expr)
+	   (buffer-substring (point-min) (1- (point-max))))))
+      (display-buffer buf))))
+
+(defun ghc-read-expression (default)
+  (let ((prompt (format "Expression (%s): " default)))
+    (read-string prompt default nil)))
+
 (provide 'ghc-info)

elisp/ghc.el

@@ -41,7 +41,8 @@
 (defvar ghc-help-key        "\e?")
 (defvar ghc-insert-key      "\et")
 (defvar ghc-sort-key        "\es")
-(defvar ghc-type-key        "\e\C-t")
+(defvar ghc-type-key        "\ek")
+(defvar ghc-info-key        "\ei")
 (defvar ghc-check-key       "\C-x\C-s")
 (defvar ghc-toggle-key      "\C-c\C-c")
 
@@ -58,6 +59,7 @@
     (define-key haskell-mode-map ghc-completion-key  'ghc-complete)
     (define-key haskell-mode-map ghc-document-key    'ghc-browse-document)
     (define-key haskell-mode-map ghc-type-key        'ghc-show-type)
+    (define-key haskell-mode-map ghc-info-key        'ghc-show-info)
     (define-key haskell-mode-map ghc-import-key      'ghc-import-module)
     (define-key haskell-mode-map ghc-previous-key    'flymake-goto-prev-error)
     (define-key haskell-mode-map ghc-next-key        'flymake-goto-next-error)