defining "info" for "ESC i".

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] []