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:
parent
1285763015
commit
36109a286e
1 changed files with 31 additions and 10 deletions
41
Branch.hs
41
Branch.hs
|
@ -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
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue