diff options
Diffstat (limited to 'Git/Command.hs')
| -rw-r--r-- | Git/Command.hs | 70 |
1 files changed, 39 insertions, 31 deletions
diff --git a/Git/Command.hs b/Git/Command.hs index eb20af2..894f6ae 100644 --- a/Git/Command.hs +++ b/Git/Command.hs @@ -1,6 +1,6 @@ {- running git commands - - - Copyright 2010-2013 Joey Hess <id@joeyh.name> + - Copyright 2010-2020 Joey Hess <id@joeyh.name> - - Licensed under the GNU AGPL version 3 or higher. -} @@ -39,19 +39,23 @@ runBool params repo = assertLocal repo $ run :: [CommandParam] -> Repo -> IO () run params repo = assertLocal repo $ unlessM (runBool params repo) $ - error $ "git " ++ show params ++ " failed" + giveup $ "git " ++ show params ++ " failed" {- Runs git and forces it to be quiet, throwing an error if it fails. -} runQuiet :: [CommandParam] -> Repo -> IO () -runQuiet params repo = withQuietOutput createProcessSuccess $ - (proc "git" $ toCommand $ gitCommandLine (params) repo) - { env = gitEnv repo } +runQuiet params repo = withNullHandle $ \nullh -> + let p = (proc "git" $ toCommand $ gitCommandLine (params) repo) + { env = gitEnv repo + , std_out = UseHandle nullh + , std_err = UseHandle nullh + } + in withCreateProcess p $ \_ _ _ -> forceSuccessProcess p {- Runs a git command and returns its output, lazily. - - Also returns an action that should be used when the output is all - read, that will wait on the command, and - - return True if it succeeded. Failure to wait will result in zombies. + - return True if it succeeded. -} pipeReadLazy :: [CommandParam] -> Repo -> IO (L.ByteString, IO Bool) pipeReadLazy params repo = assertLocal repo $ do @@ -66,33 +70,47 @@ pipeReadLazy params repo = assertLocal repo $ do - Nonzero exit status is ignored. -} pipeReadStrict :: [CommandParam] -> Repo -> IO S.ByteString -pipeReadStrict = pipeReadStrict' S.hGetContents - -{- The reader action must be strict. -} -pipeReadStrict' :: (Handle -> IO a) -> [CommandParam] -> Repo -> IO a -pipeReadStrict' reader params repo = assertLocal repo $ - withHandle StdoutHandle (createProcessChecked ignoreFailureProcess) p $ \h -> do - output <- reader h - hClose h - return output +pipeReadStrict = pipeReadStrict' id + +pipeReadStrict' :: (CreateProcess -> CreateProcess) -> [CommandParam] -> Repo -> IO S.ByteString +pipeReadStrict' fp params repo = assertLocal repo $ withCreateProcess p go where - p = gitCreateProcess params repo + p = fp (gitCreateProcess params repo) { std_out = CreatePipe } + + go _ (Just outh) _ pid = do + output <- S.hGetContents outh + hClose outh + void $ waitForProcess pid + return output + go _ _ _ _ = error "internal" {- Runs a git command, feeding it an input, and returning its output, - which is expected to be fairly small, since it's all read into memory - strictly. -} -pipeWriteRead :: [CommandParam] -> Maybe (Handle -> IO ()) -> Repo -> IO String +pipeWriteRead :: [CommandParam] -> Maybe (Handle -> IO ()) -> Repo -> IO S.ByteString pipeWriteRead params writer repo = assertLocal repo $ writeReadProcessEnv "git" (toCommand $ gitCommandLine params repo) - (gitEnv repo) writer (Just adjusthandle) + (gitEnv repo) writer' where + writer' = case writer of + Nothing -> Nothing + Just a -> Just $ \h -> do + adjusthandle h + a h adjusthandle h = hSetNewlineMode h noNewlineTranslation {- Runs a git command, feeding it input on a handle with an action. -} pipeWrite :: [CommandParam] -> Repo -> (Handle -> IO ()) -> IO () -pipeWrite params repo = assertLocal repo $ - withHandle StdinHandle createProcessSuccess $ - gitCreateProcess params repo +pipeWrite params repo feeder = assertLocal repo $ + let p = (gitCreateProcess params repo) + { std_in = CreatePipe } + in withCreateProcess p (go p) + where + go p (Just hin) _ _ pid = do + feeder hin + hClose hin + forceSuccessProcess p pid + go _ _ _ _ _ = error "internal" {- Reads null terminated output of a git command (as enabled by the -z - parameter), and splits it. -} @@ -114,16 +132,6 @@ pipeNullSplitStrict params repo = do s <- pipeReadStrict params repo return $ filter (not . S.null) $ S.split 0 s -pipeNullSplitZombie :: [CommandParam] -> Repo -> IO [L.ByteString] -pipeNullSplitZombie params repo = leaveZombie <$> pipeNullSplit params repo - -pipeNullSplitZombie' :: [CommandParam] -> Repo -> IO [S.ByteString] -pipeNullSplitZombie' params repo = leaveZombie <$> pipeNullSplit' params repo - -{- Doesn't run the cleanup action. A zombie results. -} -leaveZombie :: (a, IO Bool) -> a -leaveZombie = fst - {- Runs a git command as a coprocess. -} gitCoProcessStart :: Bool -> [CommandParam] -> Repo -> IO CoProcess.CoProcessHandle gitCoProcessStart restartable params repo = CoProcess.start numrestarts "git" |