hasufell/ghc-mod
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Remove redundant typed hole warnings

Browse Source
This commit is contained in:
Alejandro Serrano 2014-08-15 09:41:02 +02:00
parent 7612229cc0
commit 6b62117381
1 changed files with 9 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
Language/Haskell/GhcMod/Logger.hs
View File

@ -9,7 +9,7 @@ module Language.Haskell.GhcMod.Logger (
import Bag (Bag, bagToList, emptyBag, consBag, filterBag, unionBags) import Bag (Bag, bagToList, emptyBag, consBag, filterBag, unionBags)
import Control.Applicative ((<$>)) import Control.Applicative ((<$>))
import Data.IORef (IORef, newIORef, readIORef, writeIORef, modifyIORef) import Data.IORef (IORef, newIORef, readIORef, writeIORef, modifyIORef)
import Data.List (isPrefixOf, find, nub) import Data.List (isPrefixOf, find, nub, isInfixOf)
import Data.Maybe (fromMaybe, isJust) import Data.Maybe (fromMaybe, isJust)
import ErrUtils (ErrMsg, WarnMsg, errMsgShortDoc, errMsgExtraInfo, mkPlainWarnMsg) import ErrUtils (ErrMsg, WarnMsg, errMsgShortDoc, errMsgExtraInfo, mkPlainWarnMsg)
import Exception (ghandle) import Exception (ghandle)
@ -167,11 +167,16 @@ sourceErrorBag err = return $ Left (srcErrorMessages err)
mergeErrors :: DynFlags -> PprStyle -> Bag ErrMsg -> Bag ErrMsg -> (Bag ErrMsg, Bag ErrMsg) mergeErrors :: DynFlags -> PprStyle -> Bag ErrMsg -> Bag ErrMsg -> (Bag ErrMsg, Bag ErrMsg)
mergeErrors dflag style b1 b2 = mergeErrors dflag style b1 b2 =
let b1Msgs = map (ppWarnMsg dflag style) (bagToList b1) let b1Msgs = map (\err1 -> let m = ppWarnMsg dflag style err1 in (m, head $ lines m))
mustBeB2 = \err2 -> let msg2 = ppWarnMsg dflag style err2 (bagToList b1)
in not $ msg2 `elem` b1Msgs mustBeB2 = \err2 -> let msg2 = ppWarnMsg dflag style err2
line2 = head $ lines msg2
in not . isJust $ find (\(msg1, line1) -> msg1 == msg2 || (line1 == line2 && isHoleMsg line1)) b1Msgs
in (b1, filterBag mustBeB2 b2) in (b1, filterBag mustBeB2 b2)
isHoleMsg :: String -> Bool
isHoleMsg = isInfixOf "Found hole"
---------------------------------------------------------------- ----------------------------------------------------------------
ppErrMsg :: DynFlags -> PprStyle -> ErrMsg -> String ppErrMsg :: DynFlags -> PprStyle -> ErrMsg -> String