yogsototh/haskell-turtle-library
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Finally fixed the issues with system commands. Fixes #72. Fixes #82

Browse source
This commit is contained in:
Gabriel Gonzalez 2015-07-23 19:23:20 -07:00
parent 2dbfb45eec
commit 4f907f177a
1 changed files with 21 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

33
src/Turtle/Prelude.hs
View file

@ -235,7 +235,7 @@ import System.Environment (
import System.Directory (Permissions) import System.Directory (Permissions)
import qualified System.Directory as Directory import qualified System.Directory as Directory
import System.Exit (ExitCode(..), exitWith) import System.Exit (ExitCode(..), exitWith)
import System.IO (Handle) import System.IO (Handle, hClose, hFlush)
import qualified System.IO as IO import qualified System.IO as IO
import System.IO.Temp (withTempDirectory, withTempFile) import System.IO.Temp (withTempDirectory, withTempFile)
import qualified System.Process as Process import qualified System.Process as Process
@ -334,9 +334,12 @@ system p s = liftIO (do
, Process.std_err = Process.Inherit , Process.std_err = Process.Inherit
} }
(Just hIn, Nothing, Nothing, ph) <- liftIO (Process.createProcess p') (Just hIn, Nothing, Nothing, ph) <- liftIO (Process.createProcess p')
let feedIn = sh (do let feedIn = do
txt <- s sh (do
liftIO (Text.hPutStrLn hIn txt) ) txt <- s
liftIO (Text.hPutStrLn hIn txt) )
hFlush hIn
hClose hIn
withAsync feedIn (\a -> liftIO (Process.waitForProcess ph) <* wait a) ) withAsync feedIn (\a -> liftIO (Process.waitForProcess ph) <* wait a) )
systemStrict systemStrict
@ -354,9 +357,12 @@ systemStrict p s = liftIO (do
, Process.std_err = Process.Inherit , Process.std_err = Process.Inherit
} }
(Just hIn, Just hOut, Nothing, ph) <- liftIO (Process.createProcess p') (Just hIn, Just hOut, Nothing, ph) <- liftIO (Process.createProcess p')
let feedIn = sh (do let feedIn = do
txt <- s sh (do
liftIO (Text.hPutStrLn hIn txt) ) txt <- s
liftIO (Text.hPutStrLn hIn txt) )
hFlush hIn
hClose hIn
concurrently concurrently
(withAsync feedIn (\a -> liftIO (Process.waitForProcess ph) <* wait a)) (withAsync feedIn (\a -> liftIO (Process.waitForProcess ph) <* wait a))
(Text.hGetContents hOut) ) (Text.hGetContents hOut) )
@ -405,12 +411,15 @@ stream p s = do
, Process.std_out = Process.CreatePipe , Process.std_out = Process.CreatePipe
, Process.std_err = Process.Inherit , Process.std_err = Process.Inherit
} }
(Just hIn, Just hOut, Nothing, _) <- liftIO (Process.createProcess p') (Just hIn, Just hOut, Nothing, ph) <- liftIO (Process.createProcess p')
let feedIn = sh (do let feedIn = do
txt <- s sh (do
liftIO (Text.hPutStrLn hIn txt) ) txt <- s
liftIO (Text.hPutStrLn hIn txt) )
hFlush hIn
hClose hIn
a <- using (fork feedIn) a <- using (fork feedIn)
inhandle hOut <|> (liftIO (wait a) *> empty) inhandle hOut <|> (liftIO (Process.waitForProcess ph *> wait a) *> empty)
-- | Print to @stdout@ -- | Print to @stdout@
echo :: MonadIO io => Text -> io () echo :: MonadIO io => Text -> io ()