summaryrefslogtreecommitdiff
path: root/Branch.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2011-06-22 19:48:04 -0400
committerGravatar Joey Hess <joey@kitenet.net>2011-06-22 19:48:04 -0400
commit36109a286e867a6a70b5f0194332f78cd64ca277 (patch)
tree3b83d8b60703b575b4dd5d187d393752b2b1fd37 /Branch.hs
parent1285763015bb357297f573031cc3793d17fa702c (diff)
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.
Diffstat (limited to 'Branch.hs')
-rw-r--r--Branch.hs43
1 files changed, 32 insertions, 11 deletions
diff --git a/Branch.hs b/Branch.hs
index e6896aa84..2cd658fe8 100644
--- a/Branch.hs
+++ b/Branch.hs
@@ -22,6 +22,9 @@ import Data.String.Utils
import System.Cmd.Utils
import Data.Maybe
import Data.List
+import System.IO
+import System.Posix.IO
+import System.Posix.Process
import Types.BranchState
import qualified GitRepo as Git
@@ -130,6 +133,15 @@ create = do
liftIO $ Git.runBool g "show-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
- data is read from it. Runs only once per git-annex run. -}
update :: Annex ()
@@ -190,14 +202,23 @@ get file = do
setCache file content
return content
where
- cat g = Git.pipeRead g [Param "cat-file", Param "blob", catfile]
- catfile = Param $ ':':file
-
-{- 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]
+ cat g = cmdOutput "git" $ toCommand $ Git.gitCommandLine g
+ [Param "cat-file", Param "blob", Param $ ':':file]
+
+{- Runs a command, returning its output, ignoring nonzero exit
+ - status, and discarding stderr. -}
+cmdOutput :: FilePath -> [String] -> IO String
+cmdOutput cmd params = do
+ pipepair <- createPipe
+ let callfunc _ = do
+ closeFd (snd pipepair)
+ 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