-- | Running actions with explicit input\/output connected to
-- @`stdin`@\/@`stdout`@.
--
-- This module is inspired by the package <http://hackage.haskell.org/package/silently>.

module System.IO.Fake where



import Control.DeepSeq
import Control.Exception
import GHC.IO.Handle
import System.Directory
import System.IO



-- | Perform an action that with access to a temporary file. The file is removed
-- after the action is completed.
withTempFile
    :: FilePath                     -- ^ Path to directory for temporary file
    -> String                       -- ^ Base name for temporary file
    -> ((FilePath,Handle) -> IO a)  -- ^ Action
    -> IO a
withTempFile :: FilePath -> FilePath -> ((FilePath, Handle) -> IO a) -> IO a
withTempFile FilePath
tmpDir FilePath
base (FilePath, Handle) -> IO a
k = IO (FilePath, Handle)
-> ((FilePath, Handle) -> IO ())
-> ((FilePath, Handle) -> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
    (FilePath -> FilePath -> IO (FilePath, Handle)
openTempFile FilePath
tmpDir FilePath
base)
    (\(FilePath
file,Handle
h) -> Handle -> IO ()
hClose Handle
h IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> IO ()
removeFile FilePath
file)
    (FilePath, Handle) -> IO a
k

-- | Perform an action with a redirected handle
withRedirect
    :: Handle  -- ^ Shadowing handle
    -> Handle  -- ^ Shadowed handle
    -> IO a    -- ^ Action in which the redirect takes place
    -> IO a
withRedirect :: Handle -> Handle -> IO a -> IO a
withRedirect Handle
new Handle
old IO a
act = IO (Handle, BufferMode)
-> ((Handle, BufferMode) -> IO ())
-> ((Handle, BufferMode) -> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
    (do BufferMode
buffering <- Handle -> IO BufferMode
hGetBuffering Handle
old
        Handle
dupH      <- Handle -> IO Handle
hDuplicate Handle
old
        Handle -> Handle -> IO ()
hDuplicateTo Handle
new Handle
old
        (Handle, BufferMode) -> IO (Handle, BufferMode)
forall (m :: * -> *) a. Monad m => a -> m a
return (Handle
dupH,BufferMode
buffering)
    )
    (\(Handle
dupH,BufferMode
buffering) -> do
        Handle -> Handle -> IO ()
hDuplicateTo Handle
dupH Handle
old
        Handle -> BufferMode -> IO ()
hSetBuffering Handle
old BufferMode
buffering
        Handle -> IO ()
hClose Handle
dupH
    )
    (\(Handle, BufferMode)
_ -> IO a
act)

-- | Perform an action with explicit input\/output connected to
-- @`stdin`@\/@`stdout`@
fakeIO
    :: IO a       -- ^ Action
    -> String     -- ^ Input to send to @stdin@
    -> IO String  -- ^ Result from @stdout@
fakeIO :: IO a -> FilePath -> IO FilePath
fakeIO IO a
act FilePath
inp = do
    FilePath
tmpDir <- IO FilePath
getTemporaryDirectory
    FilePath
-> FilePath -> ((FilePath, Handle) -> IO FilePath) -> IO FilePath
forall a.
FilePath -> FilePath -> ((FilePath, Handle) -> IO a) -> IO a
withTempFile FilePath
tmpDir FilePath
"fakeInput" (((FilePath, Handle) -> IO FilePath) -> IO FilePath)
-> ((FilePath, Handle) -> IO FilePath) -> IO FilePath
forall a b. (a -> b) -> a -> b
$ \(FilePath
inpFile,Handle
inpH) ->
      FilePath
-> FilePath -> ((FilePath, Handle) -> IO FilePath) -> IO FilePath
forall a.
FilePath -> FilePath -> ((FilePath, Handle) -> IO a) -> IO a
withTempFile FilePath
tmpDir FilePath
"fakeOutput" (((FilePath, Handle) -> IO FilePath) -> IO FilePath)
-> ((FilePath, Handle) -> IO FilePath) -> IO FilePath
forall a b. (a -> b) -> a -> b
$ \(FilePath
outFile,Handle
outH) -> do
        Handle -> Handle -> IO FilePath -> IO FilePath
forall a. Handle -> Handle -> IO a -> IO a
withRedirect Handle
outH Handle
stdout (IO FilePath -> IO FilePath) -> IO FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$
          Handle -> Handle -> IO FilePath -> IO FilePath
forall a. Handle -> Handle -> IO a -> IO a
withRedirect Handle
inpH Handle
stdin (IO FilePath -> IO FilePath) -> IO FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ do
            Handle -> FilePath -> IO ()
hPutStr Handle
inpH FilePath
inp
            Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
inpH SeekMode
AbsoluteSeek Integer
0
            IO a
act
            Handle -> IO ()
hFlush Handle
stdout
            Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
outH SeekMode
AbsoluteSeek Integer
0
            FilePath
str <- Handle -> IO FilePath
hGetContents Handle
outH
            FilePath
str FilePath -> IO FilePath -> IO FilePath
forall a b. NFData a => a -> b -> b
`deepseq` FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
str