silently-1.2.4/0000755000000000000000000000000012040375317011551 5ustar0000000000000000silently-1.2.4/LICENSE0000644000000000000000000000245112040375317012560 0ustar0000000000000000Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. The name of the author may not be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. silently-1.2.4/Setup.lhs0000644000000000000000000000015612040375317013363 0ustar0000000000000000#!/usr/bin/runhaskell > module Main where > import Distribution.Simple > main :: IO () > main = defaultMain silently-1.2.4/silently.cabal0000644000000000000000000000340412040375317014401 0ustar0000000000000000name: silently version: 1.2.4 cabal-version: >= 1.8 build-type: Simple license: BSD3 license-file: LICENSE copyright: (c) Trystan Spangler 2011 maintainer: trystan.s@comcast.net stability: homepage: https://github.com/trystan/silently package-url: https://github.com/trystan/silently bug-reports: https://github.com/trystan/silently/issues synopsis: Prevent or capture writing to stdout and other handles. description: Prevent or capture writing to stdout and other handles. category: author: Trystan Spangler tested-with: GHC ==7.0 source-repository head type: git location: https://github.com/trystan/silently Library build-depends: base >=4 && <=5 , directory , deepseq exposed-modules: System.IO.Silently hs-source-dirs: src if os(windows) cpp-options: -DWINDOWS if os(linux) || os(osx) || os(freebsd) || os(openbsd) || os(netbsd) cpp-options: -DUNIX -- This tests the platform specific implementation. -- -- NOTE: Cabal 1.10 can not deal with conditional (== if-else) options. This -- is why we depend on silently to test the platform specific implementation. -- -- As a consequence we can not use Hspec for testing, as this would result in -- depending on two different versions of silently at the same time! test-suite spec-specific main-is: Spec.hs type: exitcode-stdio-1.0 ghc-options: -Wall -threaded hs-source-dirs: test build-depends: base , silently , directory , nanospec -- This tests the generic implementation, that should work on all platforms. test-suite spec-generic main-is: Spec.hs type: exitcode-stdio-1.0 ghc-options: -Wall -threaded hs-source-dirs: src , test build-depends: base , deepseq , directory , nanospec silently-1.2.4/src/0000755000000000000000000000000012040375317012340 5ustar0000000000000000silently-1.2.4/src/System/0000755000000000000000000000000012040375317013624 5ustar0000000000000000silently-1.2.4/src/System/IO/0000755000000000000000000000000012040375317014133 5ustar0000000000000000silently-1.2.4/src/System/IO/Silently.hs0000644000000000000000000000676512040375317016310 0ustar0000000000000000{-# 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'. module System.IO.Silently ( silence, hSilence, capture, capture_, hCapture, hCapture_, ) where import Prelude import GHC.IO.Handle (hDuplicate, hDuplicateTo) import System.IO import qualified Control.Exception as E 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 = case mNullDevice of Just nullDevice -> E.bracket (openFile nullDevice AppendMode) hClose prepareAndRun Nothing -> do tmpDir <- getTempOrCurrentDirectory E.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 `catchIOError` (\_ -> return ".") where -- NOTE: We can not use `catchIOError` from "System.IO.Error", it is only -- availabel in base >= 4.4. catchIOError :: IO a -> (IOError -> IO a) -> IO a catchIOError = E.catch -- | 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] -- | Like `capture`, but discards the result of given action. capture_ :: IO a -> IO String capture_ = fmap fst . capture -- | Like `hCapture`, but discards the result of given action. hCapture_ :: [Handle] -> IO a -> IO String hCapture_ handles = fmap fst . hCapture handles -- | 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 E.bracket (openTempFile tmpDir "capture") cleanup (prepareAndRun . snd) where cleanup (tmpFile,tmpHandle) = do hClose tmpHandle removeFile tmpFile prepareAndRun tmpHandle = go handles where go [] = do a <- action mapM_ hFlush handles hSeek tmpHandle AbsoluteSeek 0 str <- hGetContents tmpHandle str `deepseq` return (str,a) go hs = goBracket go tmpHandle hs goBracket :: ([Handle] -> IO a) -> Handle -> [Handle] -> IO a goBracket go tmpHandle (h:hs) = E.bracket (do old <- hDuplicate h hDuplicateTo tmpHandle h return old) (\old -> hDuplicateTo old h >> hClose old) (\_ -> go hs) silently-1.2.4/test/0000755000000000000000000000000012040375317012530 5ustar0000000000000000silently-1.2.4/test/Spec.hs0000644000000000000000000000126312040375317013760 0ustar0000000000000000module Main (main) where import Test.Hspec 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 = "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)