diff options
| -rw-r--r-- | Annex/UUID.hs | 2 | ||||
| -rw-r--r-- | Backend/SHA.hs | 2 | ||||
| -rw-r--r-- | Config.hs | 4 | ||||
| -rw-r--r-- | Git/Command.hs | 2 | ||||
| -rw-r--r-- | Utility/INotify.hs | 2 | ||||
| -rw-r--r-- | Utility/Process.hs | 18 |
6 files changed, 21 insertions, 9 deletions
diff --git a/Annex/UUID.hs b/Annex/UUID.hs index 13cee865d..09862f9fc 100644 --- a/Annex/UUID.hs +++ b/Annex/UUID.hs @@ -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 diff --git a/Backend/SHA.hs b/Backend/SHA.hs index 04b3e362a..bb400a768 100644 --- a/Backend/SHA.hs +++ b/Backend/SHA.hs @@ -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]) diff --git a/Git/Command.hs b/Git/Command.hs index d7c983064..cd6c98d33 100644 --- a/Git/Command.hs +++ b/Git/Command.hs @@ -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. -} diff --git a/Utility/INotify.hs b/Utility/INotify.hs index 66c0ab23d..6af022819 100644 --- a/Utility/INotify.hs +++ b/Utility/INotify.hs @@ -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 diff --git a/Utility/Process.hs b/Utility/Process.hs index 9b57c3b7a..3b293df4f 100644 --- a/Utility/Process.hs +++ b/Utility/Process.hs @@ -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 [] |