better readProcess

This commit is contained in:
Joey Hess 2012-07-19 00:57:40 -04:00
parent 1db7d27a45
commit 9fc94d780b
6 changed files with 21 additions and 9 deletions

View file

@ -32,7 +32,7 @@ configkey = annexConfig "uuid"
{- Generates a UUID. There is a library for this, but it's not packaged, {- Generates a UUID. There is a library for this, but it's not packaged,
- so use the command line tool. -} - so use the command line tool. -}
genUUID :: IO UUID genUUID :: IO UUID
genUUID = gen . lines <$> readProcess command params [] genUUID = gen . lines <$> readProcess command params
where where
gen [] = error $ "no output from " ++ command gen [] = error $ "no output from " ++ command
gen (l:_) = toUUID l gen (l:_) = toUUID l

View file

@ -54,7 +54,7 @@ shaN shasize file filesize = do
case shaCommand shasize filesize of case shaCommand shasize filesize of
Left sha -> liftIO $ sha <$> L.readFile file Left sha -> liftIO $ sha <$> L.readFile file
Right command -> liftIO $ parse command . lines <$> Right command -> liftIO $ parse command . lines <$>
readProcess command (toCommand [File file]) "" readProcess command (toCommand [File file])
where where
parse command [] = bad command parse command [] = bad command
parse command (l:_) parse command (l:_)

View file

@ -56,7 +56,7 @@ remoteCost r def = do
cmd <- getRemoteConfig r "cost-command" "" cmd <- getRemoteConfig r "cost-command" ""
(fromMaybe def . readish) <$> (fromMaybe def . readish) <$>
if not $ null cmd if not $ null cmd
then liftIO $ readProcess "sh" ["-c", cmd] "" then liftIO $ readProcess "sh" ["-c", cmd]
else getRemoteConfig r "cost" "" else getRemoteConfig r "cost" ""
cheapRemoteCost :: Int cheapRemoteCost :: Int
@ -116,4 +116,4 @@ getHttpHeaders = do
cmd <- getConfig (annexConfig "http-headers-command") "" cmd <- getConfig (annexConfig "http-headers-command") ""
if null cmd if null cmd
then fromRepo $ Git.Config.getList "annex.http-headers" then fromRepo $ Git.Config.getList "annex.http-headers"
else lines <$> liftIO (readProcess "sh" ["-c", cmd] "") else lines <$> liftIO (readProcess "sh" ["-c", cmd])

View file

@ -52,7 +52,7 @@ pipeRead params repo = assertLocal repo $
- strictly. -} - strictly. -}
pipeWriteRead :: [CommandParam] -> String -> Repo -> IO String pipeWriteRead :: [CommandParam] -> String -> Repo -> IO String
pipeWriteRead params s repo = assertLocal repo $ pipeWriteRead params s repo = assertLocal repo $
readProcess "git" (toCommand $ gitCommandLine params repo) s writeReadProcess "git" (toCommand $ gitCommandLine params repo) s
{- Reads null terminated output of a git command (as enabled by the -z {- Reads null terminated output of a git command (as enabled by the -z
- parameter), and splits it. -} - parameter), and splits it. -}

View file

@ -160,7 +160,7 @@ tooManyWatches hook dir = do
querySysctl :: Read a => [CommandParam] -> IO (Maybe a) querySysctl :: Read a => [CommandParam] -> IO (Maybe a)
querySysctl ps = do querySysctl ps = do
v <- catchMaybeIO $ readProcess "sysctl" (toCommand ps) [] v <- catchMaybeIO $ readProcess "sysctl" (toCommand ps)
case v of case v of
Nothing -> return Nothing Nothing -> return Nothing
Just s -> return $ parsesysctl s Just s -> return $ parsesysctl s

View file

@ -22,6 +22,7 @@ module Utility.Process (
withBothHandles, withBothHandles,
createProcess, createProcess,
runInteractiveProcess, runInteractiveProcess,
writeReadProcess,
readProcess readProcess
) where ) where
@ -192,11 +193,22 @@ runInteractiveProcess f args c e = do
} }
System.Process.runInteractiveProcess f args c e System.Process.runInteractiveProcess f args c e
readProcess {- I think this is a more descriptive name than System.Process.readProcess. -}
writeReadProcess
:: FilePath :: FilePath
-> [String] -> [String]
-> String -> String
-> IO String -> IO String
readProcess f args input = do writeReadProcess f args input = do
debugProcess $ (proc f args) { std_out = CreatePipe } debugProcess $ (proc f args) { std_out = CreatePipe, std_in = CreatePipe }
System.Process.readProcess f args input System.Process.readProcess f args input
{- Normally, when reading from a process, it does not need to be fed any
- input. -}
readProcess
:: FilePath
-> [String]
-> IO String
readProcess f args = do
debugProcess $ (proc f args) { std_out = CreatePipe }
System.Process.readProcess f args []