squelched git-cat-file's error message when file DNE

This seemed much too hard to do. I just wanted to close stderr
when running it.
This commit is contained in:
Joey Hess 2011-06-22 19:48:04 -04:00
parent 1285763015
commit 36109a286e

View file

@ -22,6 +22,9 @@ import Data.String.Utils
import System.Cmd.Utils import System.Cmd.Utils
import Data.Maybe import Data.Maybe
import Data.List import Data.List
import System.IO
import System.Posix.IO
import System.Posix.Process
import Types.BranchState import Types.BranchState
import qualified GitRepo as Git import qualified GitRepo as Git
@ -130,6 +133,15 @@ create = do
liftIO $ Git.runBool g "show-ref" liftIO $ Git.runBool g "show-ref"
[Param "--verify", Param "-q", Param ref] [Param "--verify", Param "-q", Param ref]
{- Commits any staged changes to the branch. -}
commit :: String -> Annex ()
commit message = do
state <- getState
when (branchChanged state) $ do
g <- Annex.gitRepo
withIndex $ liftIO $
GitUnionMerge.commit g message fullname [fullname]
{- Ensures that the branch is up-to-date; should be called before {- Ensures that the branch is up-to-date; should be called before
- data is read from it. Runs only once per git-annex run. -} - data is read from it. Runs only once per git-annex run. -}
update :: Annex () update :: Annex ()
@ -190,14 +202,23 @@ get file = do
setCache file content setCache file content
return content return content
where where
cat g = Git.pipeRead g [Param "cat-file", Param "blob", catfile] cat g = cmdOutput "git" $ toCommand $ Git.gitCommandLine g
catfile = Param $ ':':file [Param "cat-file", Param "blob", Param $ ':':file]
{- Commits any staged changes to the branch. -} {- Runs a command, returning its output, ignoring nonzero exit
commit :: String -> Annex () - status, and discarding stderr. -}
commit message = do cmdOutput :: FilePath -> [String] -> IO String
state <- getState cmdOutput cmd params = do
when (branchChanged state) $ do pipepair <- createPipe
g <- Annex.gitRepo let callfunc _ = do
withIndex $ liftIO $ closeFd (snd pipepair)
GitUnionMerge.commit g message fullname [fullname] h <- fdToHandle (fst pipepair)
x <- hGetContentsStrict h
hClose h
return $! x
pid <- pOpen3Raw Nothing (Just (snd pipepair)) Nothing cmd params
(closeFd (fst pipepair) >> closeFd stdError)
retval <- callfunc $! pid
let rv = seq retval retval
_ <- getProcessStatus True False pid
return rv