Fix some warnings (ghc 8)

This commit is contained in:
Daniel Gröber 2016-02-14 12:35:57 +01:00
parent be6ba3f875
commit d3f66500ed
3 changed files with 12 additions and 14 deletions

View File

@ -62,27 +62,27 @@ import Language.Haskell.GhcMod.Gap
import Prelude import Prelude
debugLogAction :: (String -> IO ()) -> GmLogAction debugLogAction :: (String -> IO ()) -> GmLogAction
debugLogAction putErr dflags severity srcSpan style msg debugLogAction putErr dflags severity srcSpan style' msg
= case severity of = case severity of
SevOutput -> printSDoc putErr msg style SevOutput -> printSDoc putErr msg style'
#if __GLASGOW_HASKELL__ >= 706 #if __GLASGOW_HASKELL__ >= 706
SevDump -> printSDoc putErr (msg Outputable.$$ blankLine) style SevDump -> printSDoc putErr (msg Outputable.$$ blankLine) style'
#endif #endif
#if __GLASGOW_HASKELL__ >= 708 #if __GLASGOW_HASKELL__ >= 708
SevInteractive -> let SevInteractive -> let
putStrSDoc = debugLogActionHPutStrDoc dflags putErr putStrSDoc = debugLogActionHPutStrDoc dflags putErr
in in
putStrSDoc msg style putStrSDoc msg style'
#endif #endif
SevInfo -> printErrs putErr msg style SevInfo -> printErrs putErr msg style'
SevFatal -> printErrs putErr msg style SevFatal -> printErrs putErr msg style'
_ -> do putErr "\n" _ -> do putErr "\n"
#if __GLASGOW_HASKELL__ >= 706 #if __GLASGOW_HASKELL__ >= 706
printErrs putErr (mkLocMessage severity srcSpan msg) style printErrs putErr (mkLocMessage severity srcSpan msg) style'
#else #else
printErrs putErr (mkLocMessage srcSpan msg) style printErrs putErr (mkLocMessage srcSpan msg) style'
#endif #endif
-- careful (#2302): printErrs prints in UTF-8, -- careful (#2302): printErrs prints in UTF-8,
-- whereas converting to string first and using -- whereas converting to string first and using

View File

@ -139,16 +139,14 @@ ppErrMsg err = do
st = Gap.mkErrStyle' dflags unqual st = Gap.mkErrStyle' dflags unqual
#if __GLASGOW_HASKELL__ >= 800 #if __GLASGOW_HASKELL__ >= 800
return $ showPage dflags st msg return $ showPage dflags st msg
where
msg = pprLocErrMsg err
#else #else
let ext = showPage dflags st (errMsgExtraInfo err) let ext = showPage dflags st (errMsgExtraInfo err)
m <- ppMsg st spn SevError msg m <- ppMsg st spn SevError msg
return $ m ++ (if null ext then "" else "\n" ++ ext) return $ m ++ (if null ext then "" else "\n" ++ ext)
#endif
where where
spn = Gap.errorMsgSpan err spn = Gap.errorMsgSpan err
#if __GLASGOW_HASKELL__ >= 800
msg = pprLocErrMsg err
#else
msg = errMsgShortDoc err msg = errMsgShortDoc err
#endif #endif

View File

@ -75,12 +75,12 @@ findExecutablesInStackBinPath exe StackEnv {..} =
findExecutablesInDirectories' :: [FilePath] -> String -> IO [FilePath] findExecutablesInDirectories' :: [FilePath] -> String -> IO [FilePath]
findExecutablesInDirectories' path binary = findExecutablesInDirectories' path binary =
U.findFilesWith' isExecutable path (binary <.> exeExtension) U.findFilesWith' isExecutable path (binary <.> exeExtension')
where isExecutable file = do where isExecutable file = do
perms <- getPermissions file perms <- getPermissions file
return $ executable perms return $ executable perms
exeExtension = if isWindows then "exe" else "" exeExtension' = if isWindows then "exe" else ""
readStack :: (IOish m, GmOut m, GmLog m) => [String] -> MaybeT m String readStack :: (IOish m, GmOut m, GmLog m) => [String] -> MaybeT m String
readStack args = do readStack args = do