Ghc -> GhcMod: Browse, Check

Language/Haskell/GhcMod.hs

@@ -14,7 +14,7 @@ module Language.Haskell.GhcMod (
   , Expression
   -- * 'IO' utilities
   , bootInfo
-  , browseModule
+  , browse
   , checkSyntax
   , lintSyntax
   , expandTemplate

Language/Haskell/GhcMod/Boot.hs

@@ -20,7 +20,7 @@ boot = do
     mods  <- modules
     langs <- liftIO $ listLanguages opt
     flags <- liftIO $ listFlags opt
-    pre   <- concat <$> mapM (toGhcMod . browse opt) preBrowsedModules
+    pre   <- concat <$> mapM browse preBrowsedModules
     return $ mods ++ langs ++ flags ++ pre
 
 preBrowsedModules :: [String]

Language/Haskell/GhcMod/Browse.hs

@@ -1,6 +1,5 @@
 module Language.Haskell.GhcMod.Browse (
-    browseModule
-  , browse
+    browse
   , browseAll)
   where
 
@@ -16,6 +15,7 @@ import qualified GHC as G
 import Language.Haskell.GhcMod.Doc (showPage, showOneLine, styleUnqualified)
 import Language.Haskell.GhcMod.GHCApi
 import Language.Haskell.GhcMod.Gap
+import Language.Haskell.GhcMod.Monad
 import Language.Haskell.GhcMod.Types
 import Name (getOccString)
 import Outputable (ppr, Outputable)
@@ -27,28 +27,17 @@ import Type (dropForAlls, splitFunTy_maybe, mkFunTy, isPredTy)
 -- | Getting functions, classes, etc from a module.
 --   If 'detailed' is 'True', their types are also obtained.
 --   If 'operators' is 'True', operators are also returned.
-browseModule :: Options
-             -> Cradle
-             -> ModuleString -- ^ A module name. (e.g. \"Data.List\")
-             -> IO String
-browseModule opt cradle pkgmdl = withGHC' $ do
-    initializeFlagsWithCradle opt cradle
-    browse opt pkgmdl
-
--- | Getting functions, classes, etc from a module.
---   If 'detailed' is 'True', their types are also obtained.
---   If 'operators' is 'True', operators are also returned.
-browse :: Options
-       -> ModuleString -- ^ A module name. (e.g. \"Data.List\")
-       -> Ghc String
-browse opt pkgmdl = do
+browse :: ModuleString -- ^ A module name. (e.g. \"Data.List\")
+       -> GhcMod String
+browse pkgmdl = do
+    opt <- options
     convert opt . sort <$> (getModule >>= listExports)
   where
     (mpkg,mdl) = splitPkgMdl pkgmdl
     mdlname = G.mkModuleName mdl
     mpkgid = mkFastString <$> mpkg
     listExports Nothing       = return []
-    listExports (Just mdinfo) = processExports opt mdinfo
+    listExports (Just mdinfo) = processExports mdinfo
     -- findModule works only for package modules, moreover,
     -- you cannot load a package module. On the other hand,
     -- to browse a local module you need to load it first.
@@ -73,12 +62,14 @@ splitPkgMdl pkgmdl = case break (==':') pkgmdl of
     (mdl,"")    -> (Nothing,mdl)
     (pkg,_:mdl) -> (Just pkg,mdl)
 
-processExports :: Options -> ModuleInfo -> Ghc [String]
-processExports opt minfo = mapM (showExport opt minfo) $ removeOps $ G.modInfoExports minfo
-  where
+processExports :: ModuleInfo -> GhcMod [String]
+processExports minfo = do
+  opt <- options
+  let
     removeOps
       | operators opt = id
       | otherwise = filter (isAlpha . head . getOccString)
+  mapM (toGhcMod . showExport opt minfo) $ removeOps $ G.modInfoExports minfo
 
 showExport :: Options -> ModuleInfo -> Name -> Ghc String
 showExport opt minfo e = do

Language/Haskell/GhcMod/Check.hs

@@ -10,20 +10,18 @@ import GHC (Ghc)
 import Language.Haskell.GhcMod.GHCApi
 import qualified Language.Haskell.GhcMod.Gap as Gap
 import Language.Haskell.GhcMod.Logger
+import Language.Haskell.GhcMod.Monad
 import Language.Haskell.GhcMod.Types
 
 ----------------------------------------------------------------
 
 -- | Checking syntax of a target file using GHC.
 --   Warnings and errors are returned.
-checkSyntax :: Options
-            -> Cradle
-            -> [FilePath]  -- ^ The target files.
-            -> IO String
-checkSyntax _   _      []    = return ""
-checkSyntax opt cradle files = withGHC sessionName $ do
-    initializeFlagsWithCradle opt cradle
-    either id id <$> check opt files
+checkSyntax :: [FilePath]  -- ^ The target files.
+            -> GhcMod String
+checkSyntax [] = return ""
+checkSyntax files = withErrorHandler sessionName $ do
+    either id id <$> check files
   where
     sessionName = case files of
       [file] -> file
@@ -33,10 +31,11 @@ checkSyntax opt cradle files = withGHC sessionName $ do
 
 -- | Checking syntax of a target file using GHC.
 --   Warnings and errors are returned.
-check :: Options
-      -> [FilePath]  -- ^ The target files.
-      -> Ghc (Either String String)
-check opt fileNames = withLogger opt setAllWaringFlags $
+check :: [FilePath]  -- ^ The target files.
+      -> GhcMod (Either String String)
+check fileNames = do
+  opt <- options
+  toGhcMod $ withLogger opt setAllWaringFlags $ do
     setTargetFiles fileNames
 
 ----------------------------------------------------------------

Language/Haskell/GhcMod/Monad.hs

@@ -7,6 +7,7 @@ module Language.Haskell.GhcMod.Monad (
  , GhcModState(..)
  , runGhcMod'
  , runGhcMod
+ , withErrorHandler
  , toGhcMod
  , options
  , module Control.Monad.Reader.Class
@@ -47,6 +48,10 @@ import Control.Monad.Reader.Class
 import Control.Monad.Writer.Class
 import Control.Monad.State.Class
 
+import System.IO (hPutStr, hPrint, stderr)
+import System.Exit (exitSuccess)
+
+
 data GhcModEnv = GhcModEnv {
       gmGhcSession :: !(IORef HscEnv)
     , gmOptions    :: Options
@@ -84,16 +89,29 @@ runGhcMod' r s a = do
   (a', s',w) <- runRWST (unGhcMod $ initGhcMonad (Just libdir) >> a) r s
   return (a',(s',w))
 
+
 runGhcMod :: Options -> GhcMod a -> IO a
-runGhcMod opt a = do
+runGhcMod opt action = do
     session <- newIORef (error "empty session")
     cradle <- findCradle
     let env = GhcModEnv { gmGhcSession = session
                         , gmOptions = opt
                         , gmCradle = cradle }
-    fst <$> runGhcMod' env defaultState (a' cradle)
- where
-    a' cradle = (toGhcMod $ initializeFlagsWithCradle opt cradle) >> a
+    (a,(_,_)) <- runGhcMod' env defaultState $ do
+        dflags <- getSessionDynFlags
+        defaultCleanupHandler dflags $ do
+            toGhcMod $ initializeFlagsWithCradle opt cradle
+            action
+    return a
+
+withErrorHandler :: String -> GhcMod a -> GhcMod a
+withErrorHandler label = ghandle ignore
+  where
+    ignore :: SomeException -> GhcMod a
+    ignore e = liftIO $ do
+        hPutStr stderr $ label ++ ":0:0:Error:"
+        hPrint stderr e
+        exitSuccess
 
 toGhcMod :: Ghc a -> GhcMod a
 toGhcMod a = do