withLogger handles errors.

Language/Haskell/GhcMod/Check.hs

@@ -5,7 +5,7 @@ module Language.Haskell.GhcMod.Check (
   , expand
   ) where
 
-import Exception (ghandle)
+import Control.Applicative ((<$>))
 import GHC (Ghc)
 import Language.Haskell.GhcMod.ErrMsg
 import Language.Haskell.GhcMod.GHCApi
@@ -23,7 +23,7 @@ checkSyntax :: Options
 checkSyntax _   _      []    = return ""
 checkSyntax opt cradle files = withGHC sessionName $ do
     initializeFlagsWithCradle opt cradle
-    check opt files
+    either id id <$> check opt files
   where
     sessionName = case files of
       [file] -> file
@@ -35,9 +35,9 @@ checkSyntax opt cradle files = withGHC sessionName $ do
 --   Warnings and errors are returned.
 check :: Options
       -> [FilePath]  -- ^ The target files.
-      -> Ghc String
-check opt fileNames = ghandle (handleErrMsg opt) $
-    withLogger opt setAllWaringFlags $ setTargetFiles fileNames
+      -> Ghc (Either String String)
+check opt fileNames = withLogger opt setAllWaringFlags $
+    setTargetFiles fileNames
 
 ----------------------------------------------------------------
 
@@ -49,7 +49,7 @@ expandTemplate :: Options
 expandTemplate _   _      []    = return ""
 expandTemplate opt cradle files = withGHC sessionName $ do
     initializeFlagsWithCradle opt cradle
-    expand opt files
+    either id id <$> expand opt files
   where
     sessionName = case files of
       [file] -> file
@@ -60,7 +60,6 @@ expandTemplate opt cradle files = withGHC sessionName $ do
 -- | Expanding Haskell Template.
 expand :: Options
       -> [FilePath]  -- ^ The target files.
-      -> Ghc String
-expand opt fileNames = ghandle (handleErrMsg opt) $
-    withDynFlags Gap.setDumpSplices $
-    withLogger opt setNoWaringFlags $ setTargetFiles fileNames
+      -> Ghc (Either String String)
+expand opt fileNames = withLogger opt (Gap.setDumpSplices . setNoWaringFlags) $
+    setTargetFiles fileNames

Language/Haskell/GhcMod/ErrMsg.hs

@@ -13,6 +13,7 @@ import CoreMonad (liftIO)
 import Data.IORef (IORef, newIORef, readIORef, writeIORef, modifyIORef)
 import Data.Maybe (fromMaybe)
 import ErrUtils (ErrMsg, errMsgShortDoc, errMsgExtraInfo)
+import Exception (ghandle)
 import GHC (Ghc, DynFlags, SrcSpan, Severity(SevError))
 import qualified GHC as G
 import HscTypes (SourceError, srcErrorMessages)
@@ -50,24 +51,24 @@ appendLogRef df (LogRef ref) _ sev src style msg = do
 
 ----------------------------------------------------------------
 
-withLogger :: Options -> (DynFlags -> DynFlags) -> Ghc () -> Ghc String
-withLogger opt setDF body = do
+withLogger :: Options -> (DynFlags -> DynFlags) -> Ghc () -> Ghc (Either String String)
+withLogger opt setDF body = ghandle (handleErrMsg opt) $ do
     logref <- liftIO $ newLogRef
     withDynFlags (setLogger logref . setDF) $ do
         body
-        liftIO $ readAndClearLogRef opt logref
+        liftIO $ Right <$> readAndClearLogRef opt logref
   where
     setLogger logref df = Gap.setLogAction df $ appendLogRef df logref
 
 ----------------------------------------------------------------
 
 -- | Converting 'SourceError' to 'String'.
-handleErrMsg :: Options -> SourceError -> Ghc String
+handleErrMsg :: Options -> SourceError -> Ghc (Either String String)
 handleErrMsg opt err = do
     dflag <- G.getSessionDynFlags
     style <- getStyle
     let ret = convert opt . errBagToStrList dflag style . srcErrorMessages $ err
-    return ret
+    return (Left ret)
 
 errBagToStrList :: DynFlags -> PprStyle -> Bag ErrMsg -> [String]
 errBagToStrList dflag style = map (ppErrMsg dflag style) . reverse . bagToList

Language/Haskell/GhcMod/Internal.hs

@@ -21,10 +21,10 @@ module Language.Haskell.GhcMod.Internal (
   , getDynamicFlags
   -- * Initializing 'DynFlags'
   , initializeFlagsWithCradle
-  -- * 'Ghc' Monad
+  -- * Targets
   , setTargetFiles
   , addTargetFiles
-  , handleErrMsg
+  -- * Logging
   , withLogger
   , setNoWaringFlags
   , setAllWaringFlags

src/GHCModi.hs

@@ -168,16 +168,12 @@ checkStx :: Options
          -> FilePath
          -> Ghc (String, Bool, Set FilePath)
 checkStx opt set file = do
-    GE.ghandle handler $ do
     (set',add) <- removeMainTarget file set
     let files = if add then [file] else []
-        ret <- withLogger opt setAllWaringFlags $ addTargetFiles files
-        return (ret, True, set')
-  where
-    handler :: SourceError -> Ghc (String, Bool, Set FilePath)
-    handler err = do
-        ret <- handleErrMsg opt err
-        return (ret, True, set)
+    eret <- withLogger opt setAllWaringFlags $ addTargetFiles files
+    case eret of
+        Right ret -> return (ret, True, set')
+        Left ret  -> return (ret, True, set) -- fxime: set
 
 removeMainTarget :: FilePath -> Set FilePath -> Ghc (Set FilePath, Bool)
 removeMainTarget file set = do