better readProcess
This commit is contained in:
parent
1db7d27a45
commit
9fc94d780b
6 changed files with 21 additions and 9 deletions
|
@ -32,7 +32,7 @@ configkey = annexConfig "uuid"
|
|||
{- Generates a UUID. There is a library for this, but it's not packaged,
|
||||
- so use the command line tool. -}
|
||||
genUUID :: IO UUID
|
||||
genUUID = gen . lines <$> readProcess command params []
|
||||
genUUID = gen . lines <$> readProcess command params
|
||||
where
|
||||
gen [] = error $ "no output from " ++ command
|
||||
gen (l:_) = toUUID l
|
||||
|
|
|
@ -54,7 +54,7 @@ shaN shasize file filesize = do
|
|||
case shaCommand shasize filesize of
|
||||
Left sha -> liftIO $ sha <$> L.readFile file
|
||||
Right command -> liftIO $ parse command . lines <$>
|
||||
readProcess command (toCommand [File file]) ""
|
||||
readProcess command (toCommand [File file])
|
||||
where
|
||||
parse command [] = bad command
|
||||
parse command (l:_)
|
||||
|
|
|
@ -56,7 +56,7 @@ remoteCost r def = do
|
|||
cmd <- getRemoteConfig r "cost-command" ""
|
||||
(fromMaybe def . readish) <$>
|
||||
if not $ null cmd
|
||||
then liftIO $ readProcess "sh" ["-c", cmd] ""
|
||||
then liftIO $ readProcess "sh" ["-c", cmd]
|
||||
else getRemoteConfig r "cost" ""
|
||||
|
||||
cheapRemoteCost :: Int
|
||||
|
@ -116,4 +116,4 @@ getHttpHeaders = do
|
|||
cmd <- getConfig (annexConfig "http-headers-command") ""
|
||||
if null cmd
|
||||
then fromRepo $ Git.Config.getList "annex.http-headers"
|
||||
else lines <$> liftIO (readProcess "sh" ["-c", cmd] "")
|
||||
else lines <$> liftIO (readProcess "sh" ["-c", cmd])
|
||||
|
|
|
@ -52,7 +52,7 @@ pipeRead params repo = assertLocal repo $
|
|||
- strictly. -}
|
||||
pipeWriteRead :: [CommandParam] -> String -> Repo -> IO String
|
||||
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
|
||||
- parameter), and splits it. -}
|
||||
|
|
|
@ -160,7 +160,7 @@ tooManyWatches hook dir = do
|
|||
|
||||
querySysctl :: Read a => [CommandParam] -> IO (Maybe a)
|
||||
querySysctl ps = do
|
||||
v <- catchMaybeIO $ readProcess "sysctl" (toCommand ps) []
|
||||
v <- catchMaybeIO $ readProcess "sysctl" (toCommand ps)
|
||||
case v of
|
||||
Nothing -> return Nothing
|
||||
Just s -> return $ parsesysctl s
|
||||
|
|
|
@ -22,6 +22,7 @@ module Utility.Process (
|
|||
withBothHandles,
|
||||
createProcess,
|
||||
runInteractiveProcess,
|
||||
writeReadProcess,
|
||||
readProcess
|
||||
) where
|
||||
|
||||
|
@ -192,11 +193,22 @@ runInteractiveProcess f args c e = do
|
|||
}
|
||||
System.Process.runInteractiveProcess f args c e
|
||||
|
||||
readProcess
|
||||
{- I think this is a more descriptive name than System.Process.readProcess. -}
|
||||
writeReadProcess
|
||||
:: FilePath
|
||||
-> [String]
|
||||
-> String
|
||||
-> IO String
|
||||
readProcess f args input = do
|
||||
debugProcess $ (proc f args) { std_out = CreatePipe }
|
||||
writeReadProcess f args input = do
|
||||
debugProcess $ (proc f args) { std_out = CreatePipe, std_in = CreatePipe }
|
||||
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 []
|
||||
|
|
Loading…
Reference in a new issue