type check.

Check.hs

@@ -3,7 +3,6 @@ module Check (checkSyntax) where
 import Bag
 import Control.Applicative
 import Data.IORef
-import DynFlags
 import ErrUtils
 import Exception
 import FastString
@@ -23,28 +22,18 @@ checkSyntax _ file = unlines <$> check file
 
 check :: String -> IO [String]
 check fileName = withGHC $ do
-    ref <- liftIO $ newIORef []
+    ref <- newRef []
-    initSession
+    initSession ["-Wall","-fno-warn-unused-do-bind"]
     setTargetFile fileName
     loadWithLogger (refLogger ref) LoadAllTargets `gcatch` handleParseError ref
     clearWarnings
-    liftIO $ readIORef ref
+    readRef ref
   where
-    -- I don't know why, but parseDynamicFlags must be used.
-    initSession = do
-        dflags <- getSessionDynFlags
-        (dflags',_,_) <- parseDynamicFlags dflags cmdOptions
-        setSessionDynFlags $ setFlags dflags'
-    setTargetFile file = do
-        target <- guessTarget file Nothing
-        setTargets [target]
     handleParseError ref e = do
         liftIO . writeIORef ref $ errBagToStrList . srcErrorMessages $ e
         return Succeeded
-
+    newRef  = liftIO . newIORef
--- I don't know why, but parseDynamicFlags must be used.
+    readRef = liftIO . readIORef
-cmdOptions :: [Located String]
-cmdOptions = map noLoc ["-Wall","-fno-warn-unused-do-bind"]
 
 ----------------------------------------------------------------
 
@@ -59,24 +48,6 @@ errBagToStrList = map showErrMsg . reverse . bagToList
 
 ----------------------------------------------------------------
 
-setFlags :: DynFlags -> DynFlags
-setFlags d = d {
-    importPaths = importPaths d ++ importDirs
-  , packageFlags = ghcPackage : packageFlags d
-  , ghcLink = NoLink
--- GHC.desugarModule does not produces the pattern warnings, why?
---  , hscTarget = HscNothing
-  , hscTarget = HscInterpreted
-  }
-
-importDirs :: [String]
-importDirs = ["..","../..","../../..","../../../../.."]
-
-ghcPackage :: PackageFlag
-ghcPackage = ExposePackage "ghc"
-
-----------------------------------------------------------------
-
 showErrMsg :: ErrMsg -> String
 showErrMsg err = file ++ ":" ++ line ++ ":" ++ col ++ ":" ++ msg ++ "\0" ++ ext
    where

GHCMod.hs

@@ -7,6 +7,7 @@ import Check
 import Control.Applicative
 import Control.Exception
 import Data.Typeable
+import Info
 import Lang
 import Lint
 import List
@@ -26,6 +27,7 @@ usage =    "ghc-mod version 0.4.4\n"
         ++ "\t ghc-mod [-l] lang\n"
         ++ "\t ghc-mod [-l] browse <module> [<module> ...]\n"
         ++ "\t ghc-mod check <HaskellFile>\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"
@@ -72,6 +74,7 @@ main = flip catches handlers $ do
       "browse" -> concat <$> mapM (browseModule opt) (tail cmdArg)
       "list"   -> listModules opt
       "check"  -> withFile (checkSyntax opt) (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

@@ -0,0 +1,24 @@
+module Info where
+
+import Control.Applicative
+import GHC
+import Outputable
+import PprTyThing
+import Types
+
+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
+    pretty <$> exprType expr
+  where
+    setContextFromTarget = do
+        [mdlsum,_] <- depanal [] False
+        mdl <- findModule (ms_mod_name mdlsum) Nothing
+        setContext [mdl] []
+    pretty = showSDocForUser neverQualify . pprTypeForUser False

Types.hs

@@ -1,19 +1,57 @@
 module Types where
 
+import Control.Monad
+import DynFlags
 import Exception
 import GHC
 import GHC.Paths (libdir)
 
+----------------------------------------------------------------
+
 data Options = Options {
     convert   :: [String] -> String
   , hlintOpts :: [String]
   }
 
-withGHC :: Ghc [String] -> IO [String]
+withGHC :: (MonadPlus m) => Ghc (m a) -> IO (m a)
 withGHC body = ghandle ignore $ runGhc (Just libdir) body
   where
-    ignore :: SomeException -> IO [String]
+    ignore :: (MonadPlus m) => SomeException -> IO (m a)
-    ignore _ = return []
+    ignore _ = return mzero
+
+----------------------------------------------------------------
 
 initSession0 :: Ghc [PackageId]
 initSession0 = getSessionDynFlags >>= setSessionDynFlags
+
+initSession :: [String] -> Ghc [PackageId]
+initSession cmdOpts = do
+    dflags <- getSessionDynFlags
+    let opts = map noLoc cmdOpts
+    (dflags',_,_) <- parseDynamicFlags dflags opts
+    setSessionDynFlags $ setFlags dflags'
+
+----------------------------------------------------------------
+
+setFlags :: DynFlags -> DynFlags
+setFlags d = d {
+    importPaths = importPaths d ++ importDirs
+  , packageFlags = ghcPackage : packageFlags d
+  , ghcLink = NoLink
+-- GHC.desugarModule does not produces the pattern warnings, why?
+--  , hscTarget = HscNothing
+  , hscTarget = HscInterpreted
+  }
+
+importDirs :: [String]
+importDirs = ["..","../..","../../..","../../../../.."]
+
+ghcPackage :: PackageFlag
+ghcPackage = ExposePackage "ghc"
+
+----------------------------------------------------------------
+
+setTargetFile :: (GhcMonad m) => String -> m ()
+setTargetFile file = do
+    target <- guessTarget file Nothing
+    setTargets [target]

ghc-mod.cabal

@@ -23,7 +23,7 @@ Data-Files:             Makefile ghc.el ghc-func.el ghc-doc.el ghc-comp.el
                         ghc-flymake.el ghc-command.el
 Executable ghc-mod
   Main-Is:              GHCMod.hs
-  Other-Modules:        List Browse Check Lang Lint Types
+  Other-Modules:        List Browse Check Info Lang Lint Types
   if impl(ghc >= 6.12)
     GHC-Options:        -Wall -fno-warn-unused-do-bind
   else