NG contains an error.
This commit is contained in:
parent
17b80ccc2f
commit
f50e5229c4
@ -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:"
|
||||
|
@ -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"
|
||||
|
@ -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)
|
||||
|
@ -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)
|
||||
liftIO $ putStr ret
|
||||
liftIO $ putStrLn $ if ok then "OK" else "NG"
|
||||
"quit" -> return ("quit", False, set)
|
||||
"" -> return ("quit", False, set)
|
||||
_ -> return ([], True, set)
|
||||
if ok then do
|
||||
liftIO $ putStr ret
|
||||
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"
|
||||
|
Loading…
Reference in New Issue
Block a user