implementing suppressStdout/err.
This commit is contained in:
parent
5006d836e1
commit
aecb9bc1e4
@ -18,6 +18,7 @@ import Data.Char (isSpace,isAlphaNum)
|
|||||||
import Data.List (isPrefixOf, intercalate)
|
import Data.List (isPrefixOf, intercalate)
|
||||||
import Data.Maybe (listToMaybe, maybeToList)
|
import Data.Maybe (listToMaybe, maybeToList)
|
||||||
import Language.Haskell.GhcMod.Types
|
import Language.Haskell.GhcMod.Types
|
||||||
|
import Language.Haskell.GhcMod.Utils
|
||||||
import System.FilePath ((</>))
|
import System.FilePath ((</>))
|
||||||
import System.Process (readProcess)
|
import System.Process (readProcess)
|
||||||
import Text.ParserCombinators.ReadP
|
import Text.ParserCombinators.ReadP
|
||||||
@ -65,8 +66,7 @@ ghcPkgList dbs = map fst3 <$> ghcPkgListEx dbs
|
|||||||
|
|
||||||
ghcPkgListEx :: [GhcPkgDb] -> IO [Package]
|
ghcPkgListEx :: [GhcPkgDb] -> IO [Package]
|
||||||
ghcPkgListEx dbs = do
|
ghcPkgListEx dbs = do
|
||||||
output <- readProcess "ghc-pkg" opts ""
|
output <- suppressStderr $ readProcess "ghc-pkg" opts ""
|
||||||
-- hPutStrLn stderr output
|
|
||||||
return $ parseGhcPkgOutput $ lines output
|
return $ parseGhcPkgOutput $ lines output
|
||||||
where
|
where
|
||||||
opts = ["list", "-v"] ++ ghcPkgDbStackOpts dbs
|
opts = ["list", "-v"] ++ ghcPkgDbStackOpts dbs
|
||||||
|
@ -1,13 +1,10 @@
|
|||||||
module Language.Haskell.GhcMod.Lint where
|
module Language.Haskell.GhcMod.Lint where
|
||||||
|
|
||||||
import Control.Applicative ((<$>))
|
import Control.Applicative ((<$>))
|
||||||
import Control.Exception (finally)
|
|
||||||
import Data.List (intercalate)
|
import Data.List (intercalate)
|
||||||
import GHC.IO.Handle (hDuplicate, hDuplicateTo)
|
|
||||||
import Language.Haskell.GhcMod.Types
|
import Language.Haskell.GhcMod.Types
|
||||||
|
import Language.Haskell.GhcMod.Utils
|
||||||
import Language.Haskell.HLint (hlint)
|
import Language.Haskell.HLint (hlint)
|
||||||
import System.Directory (getTemporaryDirectory, removeFile)
|
|
||||||
import System.IO (hClose, openTempFile, stdout)
|
|
||||||
|
|
||||||
-- | Checking syntax of a target file using hlint.
|
-- | Checking syntax of a target file using hlint.
|
||||||
-- Warnings and errors are returned.
|
-- Warnings and errors are returned.
|
||||||
@ -26,14 +23,3 @@ lint :: [String]
|
|||||||
-> FilePath -- ^ A target file.
|
-> FilePath -- ^ A target file.
|
||||||
-> IO [String]
|
-> IO [String]
|
||||||
lint hopts file = map show <$> suppressStdout (hlint (file : hopts))
|
lint hopts file = map show <$> suppressStdout (hlint (file : hopts))
|
||||||
|
|
||||||
suppressStdout :: IO a -> IO a
|
|
||||||
suppressStdout f = do
|
|
||||||
tmpdir <- getTemporaryDirectory
|
|
||||||
(path, handle) <- openTempFile tmpdir "ghc-mod-hlint"
|
|
||||||
dup <- hDuplicate stdout
|
|
||||||
hDuplicateTo handle stdout
|
|
||||||
hClose handle
|
|
||||||
f `finally` do
|
|
||||||
hDuplicateTo dup stdout
|
|
||||||
removeFile path
|
|
||||||
|
41
Language/Haskell/GhcMod/Utils.hs
Normal file
41
Language/Haskell/GhcMod/Utils.hs
Normal file
@ -0,0 +1,41 @@
|
|||||||
|
{-# LANGUAGE CPP #-}
|
||||||
|
|
||||||
|
module Language.Haskell.GhcMod.Utils (
|
||||||
|
suppressStdout
|
||||||
|
, suppressStderr
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Control.Exception (finally)
|
||||||
|
import GHC.IO.Handle (hDuplicate, hDuplicateTo)
|
||||||
|
import GHC.IO.Handle.Types (Handle)
|
||||||
|
import System.IO (hClose, stdout, stderr)
|
||||||
|
#ifdef WINDOWS
|
||||||
|
import System.Directory (getTemporaryDirectory, removeFile)
|
||||||
|
import System.IO (openTempFile)
|
||||||
|
#else
|
||||||
|
import System.IO (openFile, IOMode(..))
|
||||||
|
#endif
|
||||||
|
|
||||||
|
suppressStdout :: IO a -> IO a
|
||||||
|
suppressStdout = suppress stdout
|
||||||
|
|
||||||
|
suppressStderr :: IO a -> IO a
|
||||||
|
suppressStderr = suppress stderr
|
||||||
|
|
||||||
|
suppress :: GHC.IO.Handle.Types.Handle -> IO a -> IO a
|
||||||
|
suppress std f = do
|
||||||
|
#ifdef WINDOWS
|
||||||
|
tmpdir <- getTemporaryDirectory
|
||||||
|
(path, handle) <- openTempFile tmpdir "ghc-mod"
|
||||||
|
#else
|
||||||
|
handle <- openFile "/dev/null" WriteMode
|
||||||
|
#endif
|
||||||
|
dup <- hDuplicate std
|
||||||
|
hDuplicateTo handle std
|
||||||
|
hClose handle
|
||||||
|
f `finally` do
|
||||||
|
hDuplicateTo dup std
|
||||||
|
#ifdef WINDOWS
|
||||||
|
removeFile path
|
||||||
|
#endif
|
||||||
|
|
@ -56,14 +56,15 @@ Library
|
|||||||
Language.Haskell.GhcMod.ErrMsg
|
Language.Haskell.GhcMod.ErrMsg
|
||||||
Language.Haskell.GhcMod.Flag
|
Language.Haskell.GhcMod.Flag
|
||||||
Language.Haskell.GhcMod.GHCApi
|
Language.Haskell.GhcMod.GHCApi
|
||||||
Language.Haskell.GhcMod.GhcPkg
|
|
||||||
Language.Haskell.GhcMod.GHCChoice
|
Language.Haskell.GhcMod.GHCChoice
|
||||||
Language.Haskell.GhcMod.Gap
|
Language.Haskell.GhcMod.Gap
|
||||||
|
Language.Haskell.GhcMod.GhcPkg
|
||||||
Language.Haskell.GhcMod.Info
|
Language.Haskell.GhcMod.Info
|
||||||
Language.Haskell.GhcMod.Lang
|
Language.Haskell.GhcMod.Lang
|
||||||
Language.Haskell.GhcMod.Lint
|
Language.Haskell.GhcMod.Lint
|
||||||
Language.Haskell.GhcMod.List
|
Language.Haskell.GhcMod.List
|
||||||
Language.Haskell.GhcMod.PkgDoc
|
Language.Haskell.GhcMod.PkgDoc
|
||||||
|
Language.Haskell.GhcMod.Utils
|
||||||
Language.Haskell.GhcMod.Types
|
Language.Haskell.GhcMod.Types
|
||||||
Build-Depends: base >= 4.0 && < 5
|
Build-Depends: base >= 4.0 && < 5
|
||||||
, containers
|
, containers
|
||||||
|
Loading…
Reference in New Issue
Block a user