NG contains an error.
This commit is contained in:
parent
17b80ccc2f
commit
f50e5229c4
@ -4,6 +4,7 @@ module Language.Haskell.GhcMod.ErrMsg (
|
|||||||
LogReader
|
LogReader
|
||||||
, setLogger
|
, setLogger
|
||||||
, handleErrMsg
|
, handleErrMsg
|
||||||
|
, checkErrorPrefix
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Bag (Bag, bagToList)
|
import Bag (Bag, bagToList)
|
||||||
@ -85,9 +86,12 @@ ppMsg spn sev dflag style msg = prefix ++ cts
|
|||||||
cts = showPage dflag style msg
|
cts = showPage dflag style msg
|
||||||
defaultPrefix
|
defaultPrefix
|
||||||
| dopt Gap.dumpSplicesFlag dflag = ""
|
| dopt Gap.dumpSplicesFlag dflag = ""
|
||||||
| otherwise = "Dummy:0:0:Error:"
|
| otherwise = checkErrorPrefix
|
||||||
prefix = fromMaybe defaultPrefix $ do
|
prefix = fromMaybe defaultPrefix $ do
|
||||||
(line,col,_,_) <- Gap.getSrcSpan spn
|
(line,col,_,_) <- Gap.getSrcSpan spn
|
||||||
file <- normalise <$> Gap.getSrcFile spn
|
file <- normalise <$> Gap.getSrcFile spn
|
||||||
let severityCaption = Gap.showSeverityCaption sev
|
let severityCaption = Gap.showSeverityCaption sev
|
||||||
return $ file ++ ":" ++ show line ++ ":" ++ show col ++ ":" ++ severityCaption
|
return $ file ++ ":" ++ show line ++ ":" ++ show col ++ ":" ++ severityCaption
|
||||||
|
|
||||||
|
checkErrorPrefix :: String
|
||||||
|
checkErrorPrefix = "Dummy:0:0:Error:"
|
||||||
|
@ -1,6 +1,8 @@
|
|||||||
module Language.Haskell.GhcMod.Lint where
|
module Language.Haskell.GhcMod.Lint where
|
||||||
|
|
||||||
import Control.Applicative ((<$>))
|
import Control.Applicative ((<$>))
|
||||||
|
import Control.Exception (handle, SomeException(..))
|
||||||
|
import Language.Haskell.GhcMod.ErrMsg (checkErrorPrefix)
|
||||||
import Language.Haskell.GhcMod.Types
|
import Language.Haskell.GhcMod.Types
|
||||||
import Language.Haskell.HLint (hlint)
|
import Language.Haskell.HLint (hlint)
|
||||||
|
|
||||||
@ -9,7 +11,8 @@ import Language.Haskell.HLint (hlint)
|
|||||||
lintSyntax :: Options
|
lintSyntax :: Options
|
||||||
-> FilePath -- ^ A target file.
|
-> FilePath -- ^ A target file.
|
||||||
-> IO String
|
-> IO String
|
||||||
lintSyntax opt file = pack <$> hlint (file : "--quiet" : hopts)
|
lintSyntax opt file = handle handler $ pack <$> hlint (file : "--quiet" : hopts)
|
||||||
where
|
where
|
||||||
pack = convert opt . map (init . show) -- init drops the last \n.
|
pack = convert opt . map (init . show) -- init drops the last \n.
|
||||||
hopts = hlintOpts opt
|
hopts = hlintOpts opt
|
||||||
|
handler (SomeException e) = return $ checkErrorPrefix ++ show e ++ "\n"
|
||||||
|
@ -72,7 +72,7 @@
|
|||||||
(goto-char (point-max))
|
(goto-char (point-max))
|
||||||
(insert string)
|
(insert string)
|
||||||
(forward-line -1)
|
(forward-line -1)
|
||||||
(when (looking-at "^\\(OK\\|NG\\)$")
|
(when (looking-at "^OK$\\|^NG ")
|
||||||
(if ghc-process-hook (funcall ghc-process-hook))
|
(if ghc-process-hook (funcall ghc-process-hook))
|
||||||
(goto-char (point-min))
|
(goto-char (point-min))
|
||||||
(funcall ghc-process-callback)
|
(funcall ghc-process-callback)
|
||||||
|
@ -103,8 +103,13 @@ main = E.handle cmdHandler $
|
|||||||
where
|
where
|
||||||
-- this is just in case.
|
-- this is just in case.
|
||||||
-- If an error is caught here, it is a bug of GhcMod library.
|
-- If an error is caught here, it is a bug of GhcMod library.
|
||||||
someHandler (SomeException _) = do
|
someHandler (SomeException e) = do
|
||||||
putStrLn "NG"
|
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
|
"type" -> showType opt set arg readLog
|
||||||
"boot" -> bootIt opt set
|
"boot" -> bootIt opt set
|
||||||
"browse" -> browseIt opt set arg
|
"browse" -> browseIt opt set arg
|
||||||
_ -> return ([], False, set)
|
"quit" -> return ("quit", False, set)
|
||||||
liftIO $ putStr ret
|
"" -> return ("quit", False, set)
|
||||||
liftIO $ putStrLn $ if ok then "OK" else "NG"
|
_ -> return ([], True, set)
|
||||||
|
if ok then do
|
||||||
|
liftIO $ putStr ret
|
||||||
|
liftIO $ putStrLn "OK"
|
||||||
|
else do
|
||||||
|
liftIO $ putStrLn $ "NG " ++ replace ret
|
||||||
liftIO $ hFlush stdout
|
liftIO $ hFlush stdout
|
||||||
when ok $ loop opt set' mvar readLog
|
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 :: SourceError -> Ghc (String, Bool, Set FilePath)
|
||||||
handler err = do
|
handler err = do
|
||||||
ret <- handleErrMsg opt err
|
ret <- handleErrMsg opt err
|
||||||
return (ret, False, set)
|
return (ret, True, set)
|
||||||
removeMainTarget = do
|
removeMainTarget = do
|
||||||
mx <- find isMain <$> G.getModuleGraph
|
mx <- find isMain <$> G.getModuleGraph
|
||||||
case mx of
|
case mx of
|
||||||
@ -194,17 +204,13 @@ findSym opt set sym mvar = do
|
|||||||
|
|
||||||
lintStx :: Options -> Set FilePath -> FilePath
|
lintStx :: Options -> Set FilePath -> FilePath
|
||||||
-> Ghc (String, Bool, Set 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
|
ret <-lintSyntax opt' file
|
||||||
return (ret, True, set)
|
return (ret, True, set)
|
||||||
where
|
where
|
||||||
(opts,file) = parseLintOptions optFile
|
(opts,file) = parseLintOptions optFile
|
||||||
hopts = if opts == "" then [] else read opts
|
hopts = if opts == "" then [] else read opts
|
||||||
opt' = opt { hlintOpts = hopts }
|
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"
|
-- >>> parseLintOptions "[\"--ignore=Use camelCase\", \"--ignore=Eta reduce\"] file name"
|
||||||
|
Loading…
Reference in New Issue
Block a user