Add a test, that fails on Windows

.ghci

@@ -0,0 +1 @@
+:set -isrc -itest -idist/build/autogen -DUNIX

.travis.yml

@@ -0,0 +1,6 @@
+language: haskell
+
+install:
+    - cabal update
+    - cabal install hspec-shouldbe
+    - cabal install

silently.cabal

@@ -1,6 +1,6 @@
 name: silently
 version: 1.1.5
-cabal-version: >= 1.2
+cabal-version: >= 1.8
 build-type: Simple
 license: BSD3
 license-file: LICENSE
@@ -20,17 +20,90 @@ extra-source-files:
   src/unix/System/IO/Silently.hs
   src/other/System/IO/Silently.hs
 
+source-repository head
+  type: git
+  location: https://github.com/trystan/silently
+
 Library
-  build-depends: base >=4 && <=5, directory -any
+  build-depends:
+      base >=4 && <=5
+    , directory
+    , deepseq
   exposed-modules: System.IO.Silently
   exposed: True
   buildable: True
 
+  hs-source-dirs:
+      src
+
+  if os(windows)
+    cpp-options: -DWINDOWS
+  if os(linux) || os(osx) || os(freebsd) || os(openbsd) || os(netbsd)
+    cpp-options: -DUNIX
+
+test-suite spec-windows
+  main-is:
+      Spec.hs
+  type:
+      exitcode-stdio-1.0
+  ghc-options:
+      -Wall -threaded
+      -- FIXME: use -Werror
+      -- -Wall -Werror -threaded
+  hs-source-dirs:
+      src
+    , test
+
   if os(windows)
-    hs-source-dirs: src/windows
+    cpp-options: -DWINDOWS
   else
-    if os(linux) || os(osx) || os(freebsd) || os(openbsd) || os(netbsd)
-      hs-source-dirs: src/unix
-    else
-      hs-source-dirs: src/other
+    buildable: False
+
+  build-depends:
+      base
+    , hspec-shouldbe
+    , directory
+    , deepseq
+
+test-suite spec-unix
+  main-is:
+      Spec.hs
+  type:
+      exitcode-stdio-1.0
+  ghc-options:
+      -Wall -threaded
+      -- FIXME: use -Werror
+      -- -Wall -Werror -threaded
+  hs-source-dirs:
+      src
+    , test
+
+  if os(linux) || os(osx) || os(freebsd) || os(openbsd) || os(netbsd)
+    cpp-options: -DUNIX
+  else
+    buildable: False
+
+  build-depends:
+      base
+    , hspec-shouldbe
+    , directory
+    , deepseq
+
+test-suite spec-generic
+  main-is:
+      Spec.hs
+  type:
+      exitcode-stdio-1.0
+  ghc-options:
+      -Wall -threaded
+      -- FIXME: use -Werror
+      -- -Wall -Werror -threaded
+  hs-source-dirs:
+      src
+    , test
 
+  build-depends:
+      base
+    , hspec-shouldbe
+    , directory
+    , deepseq

src/windows/System/IO/Silently.hs → src/System/IO/Silently.hs

@@ -1,4 +1,4 @@
-
+{-# LANGUAGE CPP #-}
 -- | Need to prevent output to the terminal, a file, or stderr? Need to capture it and use it for
 -- your own means? Now you can, with 'silence' and 'capture'.
 
@@ -8,28 +8,50 @@ module System.IO.Silently (
 ) where
 
 import GHC.IO.Handle (hDuplicate, hDuplicateTo)
-import System.IO (Handle, stdout, hClose, openTempFile, openFile, IOMode(..))
+import System.IO
+import System.IO.Error
 import Control.Exception (bracket)
+import Control.DeepSeq
 import System.Directory (removeFile,getTemporaryDirectory)
 
+mNullDevice :: Maybe FilePath
+#ifdef WINDOWS
+mNullDevice = Just "NUL"
+#elif UNIX
+mNullDevice = Just "/dev/null"
+#else
+mNullDevice = Nothing
+#endif
+
 -- | Run an IO action while preventing all output to stdout.
 silence :: IO a -> IO a
 silence = hSilence [stdout]
 
 -- | Run an IO action while preventing all output to the given handles.
 hSilence :: [Handle] -> IO a -> IO a
-hSilence handles action = bracket (openFile "NUL" AppendMode)
+hSilence handles action = case mNullDevice of
+  Just nullDevice -> bracket (openFile nullDevice AppendMode)
                              hClose
                              prepareAndRun
+
+  Nothing -> do
+    tmpDir <- getTempOrCurrentDirectory
+    bracket (openTempFile tmpDir "silence")
+                               cleanup
+                               (prepareAndRun . snd)
+
  where
+  cleanup (tmpFile,tmpHandle) = do
+    hClose tmpHandle
+    removeFile tmpFile
   prepareAndRun tmpHandle = go handles
     where
       go [] = action
       go hs = goBracket go tmpHandle hs
 
 
 getTempOrCurrentDirectory :: IO String
-getTempOrCurrentDirectory = getTemporaryDirectory `Prelude.catch` (\ex -> return ".")
+getTempOrCurrentDirectory = getTemporaryDirectory `catchIOError` (\_ -> return ".")
 
 -- | Run an IO action while preventing and capturing all output to stdout.
 -- This will, as a side effect, create and delete a temp file in the temp directory or current directory if there is no temp directory.
@@ -43,24 +65,21 @@ hCapture handles action = do
   tmpDir <- getTempOrCurrentDirectory
   bracket (openTempFile tmpDir "capture")
                              cleanup
-                             prepareAndRun
+                             (prepareAndRun . snd)
  where
   cleanup (tmpFile,tmpHandle) = do
     hClose tmpHandle
     removeFile tmpFile
-  prepareAndRun (tmpFile,tmpHandle) = go handles
+  prepareAndRun tmpHandle = go handles
     where
       go [] = do
               a <- action
-              hClose tmpHandle
-              str <- readFile tmpFile
-              forceList str
-              return (str,a)
+              mapM_ hFlush handles
+              hSeek tmpHandle AbsoluteSeek 0
+              str <- hGetContents tmpHandle
+              str `deepseq` return (str,a)
       go hs = goBracket go tmpHandle hs
 
-forceList [] = return ()
-forceList (x:xs) = forceList xs
-
 goBracket :: ([Handle] -> IO a) -> Handle -> [Handle] -> IO a
 goBracket go tmpHandle (h:hs) = bracket (do old <- hDuplicate h
                                             hDuplicateTo tmpHandle h

test/Spec.hs

@@ -0,0 +1,29 @@
+module Main (main) where
+
+import           Test.Hspec.ShouldBe
+
+import           System.IO
+import           System.IO.Silently
+import           System.Directory
+
+import           Control.Exception
+
+main :: IO ()
+main = hspec spec
+
+spec :: Spec
+spec = do
+
+  describe "hSilence" $ do
+    it "prevents output to a given handle" $ let file = "test/foo.txt" in do
+      h <- openFile file ReadWriteMode
+      hSilence [h] $ do
+        hPutStrLn h "foo bar baz"
+        hFlush h
+      hSeek h AbsoluteSeek 0
+      hGetContents h `shouldReturn` ""
+      `finally` removeFile file
+
+  describe "capture" $ do
+    it "captures stdout" $ do
+      capture (putStr "foo" >> return 23) `shouldReturn` ("foo", 23 :: Int)