Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP

Loading…

Add a test, that fails on Windows #10

Merged
merged 8 commits into from

2 participants

@sol
sol commented

This fails on Windows with:

openFile: permission denied (Permission denied)

Sounds like #6.

@sol
sol commented

@trystan Do you know, what the original fix for #6 was?

@trystan
Owner

I made it write to the current rather than temp directory and I forced the file contents to be evaluated before closing the handles.

@trystan
Owner

@sol, are you running as an admin?

@sol

@trystan Not sure, let me check.

@sol

@trystan If I interpret the output of net user correctly, than yes, I tried it with an account that has super user privileges.

@sol

The issue seems to be that readFile is invoked, while the file is still open. One solution would be to let goBracket return before reading the file (that works, I tried it). But I ended up using hSeek + hGetContents instead of readFile.

@sol sol referenced this pull request from a commit
Commit has since been removed from the repository and is no longer available.
@sol

@trystan I need this on Hackage soon. Is it ok with you if I push a release?

@trystan trystan merged commit 99fff46 into from
@trystan
Owner

@sol I just pushed it out to Hackage.

@sol

Thanks for that.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Commits on Jun 8, 2012
  1. @sol
  2. @sol

    Add basic test for capture

    sol authored
Commits on Jun 23, 2012
  1. @sol
  2. @sol

    Use deepseq

    sol authored
  3. @sol

    Get rid of some warnings

    sol authored
  4. @sol
  5. @sol

    Fix file-locking issue on windows

    sol authored
  6. @sol

    Fix a warning

    sol authored
This page is out of date. Refresh to see the latest.
View
1  .ghci
@@ -0,0 +1 @@
+:set -isrc -itest -idist/build/autogen -DUNIX
View
6 .travis.yml
@@ -0,0 +1,6 @@
+language: haskell
+
+install:
+ - cabal update
+ - cabal install hspec-shouldbe
+ - cabal install
View
87 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
View
45 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,20 +8,42 @@ 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
@@ -29,7 +51,7 @@ hSilence handles action = bracket (openFile "NUL" AppendMode)
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
View
76 src/other/System/IO/Silently.hs
@@ -1,76 +0,0 @@
-
--- | 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'.
-
-module System.IO.Silently (
- silence, hSilence,
- capture, hCapture
-) where
-
-import GHC.IO.Handle (hDuplicate, hDuplicateTo)
-import System.IO (Handle, stdout, hClose, openTempFile)
-import Control.Exception (bracket)
-import System.Directory (removeFile,getTemporaryDirectory)
-
--- | Run an IO action while preventing all output to stdout.
--- This will, as a side effect, create and delete a temp file in the current directory.
-silence :: IO a -> IO a
-silence = hSilence [stdout]
-
--- | Run an IO action while preventing all output to the given handles.
--- This will, as a side effect, create and delete a temp file in the current directory.
-hSilence :: [Handle] -> IO a -> IO a
-hSilence handles action = do
- tmpDir <- getTempOrCurrentDirectory
- bracket (openTempFile tmpDir "silence")
- cleanup
- prepareAndRun
- 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 ".")
-
--- | 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.
-capture :: IO a -> IO (String, a)
-capture = hCapture [stdout]
-
--- | Run an IO action while preventing and capturing all output to the given handles.
--- 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.
-hCapture :: [Handle] -> IO a -> IO (String, a)
-hCapture handles action = do
- tmpDir <- getTempOrCurrentDirectory
- bracket (openTempFile tmpDir "capture")
- cleanup
- prepareAndRun
- where
- cleanup (tmpFile,tmpHandle) = do
- hClose tmpHandle
- removeFile tmpFile
- prepareAndRun (tmpFile,tmpHandle) = go handles
- where
- go [] = do
- a <- action
- hClose tmpHandle
- str <- readFile tmpFile
- forceList str
- 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
- return old)
- (\old -> hDuplicateTo old h >> hClose old)
- (\_ -> go hs)
View
65 src/unix/System/IO/Silently.hs
@@ -1,65 +0,0 @@
-
--- | 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'.
-
-module System.IO.Silently (
- silence, hSilence,
- capture, hCapture
-) where
-
-import GHC.IO.Handle (hDuplicate, hDuplicateTo)
-import System.IO (Handle, stdout, hClose, openTempFile, openFile, IOMode(..))
-import Control.Exception (bracket)
-import System.Directory (removeFile,getTemporaryDirectory)
-
--- | 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 "/dev/null" AppendMode)
- hClose
- prepareAndRun
- where
- prepareAndRun tmpHandle = go handles
- where
- go [] = action
- go hs = goBracket go tmpHandle hs
-
-
-getTempOrCurrentDirectory :: IO String
-getTempOrCurrentDirectory = getTemporaryDirectory `Prelude.catch` (\ex -> 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.
-capture :: IO a -> IO (String, a)
-capture = hCapture [stdout]
-
--- | Run an IO action while preventing and capturing all output to the given handles.
--- 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.
-hCapture :: [Handle] -> IO a -> IO (String, a)
-hCapture handles action = do
- tmpDir <- getTempOrCurrentDirectory
- bracket (openTempFile tmpDir "capture")
- cleanup
- prepareAndRun
- where
- cleanup (tmpFile,tmpHandle) = do
- hClose tmpHandle
- removeFile tmpFile
- prepareAndRun (tmpFile,tmpHandle) = go handles
- where
- go [] = do
- a <- action
- hClose tmpHandle
- str <- readFile tmpFile
- return (str,a)
- go hs = goBracket go tmpHandle hs
-
-goBracket :: ([Handle] -> IO a) -> Handle -> [Handle] -> IO a
-goBracket go tmpHandle (h:hs) = bracket (do old <- hDuplicate h
- hDuplicateTo tmpHandle h
- return old)
- (\old -> hDuplicateTo old h >> hClose old)
- (\_ -> go hs)
View
29 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)
Something went wrong with that request. Please try again.