NG contains an error.

This commit is contained in:
Kazu Yamamoto 2014-04-25 11:08:29 +09:00
parent 17b80ccc2f
commit f50e5229c4
4 changed files with 27 additions and 14 deletions

View File

@ -4,6 +4,7 @@ module Language.Haskell.GhcMod.ErrMsg (
LogReader
, setLogger
, handleErrMsg
, checkErrorPrefix
) where
import Bag (Bag, bagToList)
@ -85,9 +86,12 @@ ppMsg spn sev dflag style msg = prefix ++ cts
cts = showPage dflag style msg
defaultPrefix
| dopt Gap.dumpSplicesFlag dflag = ""
| otherwise = "Dummy:0:0:Error:"
| otherwise = checkErrorPrefix
prefix = fromMaybe defaultPrefix $ do
(line,col,_,_) <- Gap.getSrcSpan spn
file <- normalise <$> Gap.getSrcFile spn
let severityCaption = Gap.showSeverityCaption sev
return $ file ++ ":" ++ show line ++ ":" ++ show col ++ ":" ++ severityCaption
checkErrorPrefix :: String
checkErrorPrefix = "Dummy:0:0:Error:"

View File

@ -1,6 +1,8 @@
module Language.Haskell.GhcMod.Lint where
import Control.Applicative ((<$>))
import Control.Exception (handle, SomeException(..))
import Language.Haskell.GhcMod.ErrMsg (checkErrorPrefix)
import Language.Haskell.GhcMod.Types
import Language.Haskell.HLint (hlint)
@ -9,7 +11,8 @@ import Language.Haskell.HLint (hlint)
lintSyntax :: Options
-> FilePath -- ^ A target file.
-> IO String
lintSyntax opt file = pack <$> hlint (file : "--quiet" : hopts)
lintSyntax opt file = handle handler $ pack <$> hlint (file : "--quiet" : hopts)
where
pack = convert opt . map (init . show) -- init drops the last \n.
hopts = hlintOpts opt
handler (SomeException e) = return $ checkErrorPrefix ++ show e ++ "\n"

View File

@ -72,7 +72,7 @@
(goto-char (point-max))
(insert string)
(forward-line -1)
(when (looking-at "^\\(OK\\|NG\\)$")
(when (looking-at "^OK$\\|^NG ")
(if ghc-process-hook (funcall ghc-process-hook))
(goto-char (point-min))
(funcall ghc-process-callback)

View File

@ -103,8 +103,13 @@ main = E.handle cmdHandler $
where
-- this is just in case.
-- If an error is caught here, it is a bug of GhcMod library.
someHandler (SomeException _) = do
putStrLn "NG"
someHandler (SomeException e) = do
putStrLn $ "NG " ++ replace (show e)
replace :: String -> String
replace [] = []
replace ('\n':xs) = ';' : replace xs
replace (x:xs) = x : replace xs
----------------------------------------------------------------
@ -138,9 +143,14 @@ loop opt set mvar readLog = do
"type" -> showType opt set arg readLog
"boot" -> bootIt opt set
"browse" -> browseIt opt set arg
_ -> return ([], False, set)
"quit" -> return ("quit", False, set)
"" -> return ("quit", False, set)
_ -> return ([], True, set)
if ok then do
liftIO $ putStr ret
liftIO $ putStrLn $ if ok then "OK" else "NG"
liftIO $ putStrLn "OK"
else do
liftIO $ putStrLn $ "NG " ++ replace ret
liftIO $ hFlush stdout
when ok $ loop opt set' mvar readLog
@ -167,7 +177,7 @@ checkStx opt set file readLog = do
handler :: SourceError -> Ghc (String, Bool, Set FilePath)
handler err = do
ret <- handleErrMsg opt err
return (ret, False, set)
return (ret, True, set)
removeMainTarget = do
mx <- find isMain <$> G.getModuleGraph
case mx of
@ -194,17 +204,13 @@ findSym opt set sym mvar = do
lintStx :: Options -> Set FilePath -> FilePath
-> Ghc (String, Bool, Set FilePath)
lintStx opt set optFile = liftIO $ E.handle handler $ do
lintStx opt set optFile = liftIO $ do
ret <-lintSyntax opt' file
return (ret, True, set)
where
(opts,file) = parseLintOptions optFile
hopts = if opts == "" then [] else read opts
opt' = opt { hlintOpts = hopts }
-- let's continue the session
handler (SomeException e) = do
print e
return ("", True, set)
-- |
-- >>> parseLintOptions "[\"--ignore=Use camelCase\", \"--ignore=Eta reduce\"] file name"