From aecb9bc1e4bbb923636c2937704a21cd98418abf Mon Sep 17 00:00:00 2001
From: Kazu Yamamoto <kazu@iij.ad.jp>
Date: Fri, 18 Apr 2014 15:41:32 +0900
Subject: [PATCH] implementing suppressStdout/err.

---
 Language/Haskell/GhcMod/GhcPkg.hs |  4 +--
 Language/Haskell/GhcMod/Lint.hs   | 16 +-----------
 Language/Haskell/GhcMod/Utils.hs  | 41 +++++++++++++++++++++++++++++++
 ghc-mod.cabal                     |  3 ++-
 4 files changed, 46 insertions(+), 18 deletions(-)
 create mode 100644 Language/Haskell/GhcMod/Utils.hs

diff --git a/Language/Haskell/GhcMod/GhcPkg.hs b/Language/Haskell/GhcMod/GhcPkg.hs
index 03fe885..993e5c5 100644
--- a/Language/Haskell/GhcMod/GhcPkg.hs
+++ b/Language/Haskell/GhcMod/GhcPkg.hs
@@ -18,6 +18,7 @@ import Data.Char (isSpace,isAlphaNum)
 import Data.List (isPrefixOf, intercalate)
 import Data.Maybe (listToMaybe, maybeToList)
 import Language.Haskell.GhcMod.Types
+import Language.Haskell.GhcMod.Utils
 import System.FilePath ((</>))
 import System.Process (readProcess)
 import Text.ParserCombinators.ReadP
@@ -65,8 +66,7 @@ ghcPkgList dbs = map fst3 <$> ghcPkgListEx dbs
 
 ghcPkgListEx :: [GhcPkgDb] -> IO [Package]
 ghcPkgListEx dbs = do
-    output <- readProcess "ghc-pkg" opts ""
---    hPutStrLn stderr output
+    output <- suppressStderr $ readProcess "ghc-pkg" opts ""
     return $ parseGhcPkgOutput $ lines output
   where
     opts = ["list", "-v"] ++ ghcPkgDbStackOpts dbs
diff --git a/Language/Haskell/GhcMod/Lint.hs b/Language/Haskell/GhcMod/Lint.hs
index 959ae72..faca6eb 100644
--- a/Language/Haskell/GhcMod/Lint.hs
+++ b/Language/Haskell/GhcMod/Lint.hs
@@ -1,13 +1,10 @@
 module Language.Haskell.GhcMod.Lint where
 
 import Control.Applicative ((<$>))
-import Control.Exception (finally)
 import Data.List (intercalate)
-import GHC.IO.Handle (hDuplicate, hDuplicateTo)
 import Language.Haskell.GhcMod.Types
+import Language.Haskell.GhcMod.Utils
 import Language.Haskell.HLint (hlint)
-import System.Directory (getTemporaryDirectory, removeFile)
-import System.IO (hClose, openTempFile, stdout)
 
 -- | Checking syntax of a target file using hlint.
 --   Warnings and errors are returned.
@@ -26,14 +23,3 @@ lint :: [String]
      -> FilePath    -- ^ A target file.
      -> IO [String]
 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
diff --git a/Language/Haskell/GhcMod/Utils.hs b/Language/Haskell/GhcMod/Utils.hs
new file mode 100644
index 0000000..cd9f0ba
--- /dev/null
+++ b/Language/Haskell/GhcMod/Utils.hs
@@ -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
+
diff --git a/ghc-mod.cabal b/ghc-mod.cabal
index 7405921..3e609ce 100644
--- a/ghc-mod.cabal
+++ b/ghc-mod.cabal
@@ -56,14 +56,15 @@ Library
                         Language.Haskell.GhcMod.ErrMsg
                         Language.Haskell.GhcMod.Flag
                         Language.Haskell.GhcMod.GHCApi
-                        Language.Haskell.GhcMod.GhcPkg
                         Language.Haskell.GhcMod.GHCChoice
                         Language.Haskell.GhcMod.Gap
+                        Language.Haskell.GhcMod.GhcPkg
                         Language.Haskell.GhcMod.Info
                         Language.Haskell.GhcMod.Lang
                         Language.Haskell.GhcMod.Lint
                         Language.Haskell.GhcMod.List
                         Language.Haskell.GhcMod.PkgDoc
+                        Language.Haskell.GhcMod.Utils
                         Language.Haskell.GhcMod.Types
   Build-Depends:        base >= 4.0 && < 5
                       , containers