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,
|
{- 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
|
||||||
|
|
|
@ -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:_)
|
||||||
|
|
|
@ -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])
|
||||||
|
|
|
@ -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. -}
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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 []
|
||||||
|
|
Loading…
Reference in a new issue