split out Git/Command.hs

10 files changed, 91 insertions, 0 deletions

diff --git a/Git/Branch.hs b/Git/Branch.hs
index 3e08e19c2..cce56dcfa 100644
--- a/Git/Branch.hs
+++ b/Git/Branch.hs
@@ -12,6 +12,7 @@ import qualified Data.ByteString.Lazy.Char8 as L
 import Common
 import Git
 import Git.Sha
+import Git.Command
 
 {- Checks if the second branch has any commits not present on the first
  - branch. -}
diff --git a/Git/CatFile.hs b/Git/CatFile.hs
index 44c2a9f5e..2cef9d5b3 100644
--- a/Git/CatFile.hs
+++ b/Git/CatFile.hs
@@ -21,6 +21,7 @@ import qualified Data.ByteString.Lazy.Char8 as L
 
 import Git
 import Git.Sha
+import Git.Command
 import Utility.SafeCommand
 
 type CatFileHandle = (PipeHandle, Handle, Handle)
diff --git a/Git/CheckAttr.hs b/Git/CheckAttr.hs
index e9269b1ed..1ea38beea 100644
--- a/Git/CheckAttr.hs
+++ b/Git/CheckAttr.hs
@@ -11,6 +11,7 @@ import System.Exit
 
 import Common
 import Git
+import Git.Command
 import qualified Git.Filename
 
 {- Efficiently looks up a gitattributes value for each file in a list. -}
diff --git a/Git/Command.hs b/Git/Command.hs
new file mode 100644
index 000000000..2350bb0ca
--- /dev/null
+++ b/Git/Command.hs
@@ -0,0 +1,82 @@
+{- running git commands
+ -
+ - Copyright 2010, 2011 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Git.Command where
+
+import qualified Data.ByteString.Lazy.Char8 as L
+
+import Common
+import Git
+import Git.Types
+
+{- Constructs a git command line operating on the specified repo. -}
+gitCommandLine :: [CommandParam] -> Repo -> [CommandParam]
+gitCommandLine params repo@(Repo { location = Dir _ } ) =
+	-- force use of specified repo via --git-dir and --work-tree
+	[ Param ("--git-dir=" ++ gitDir repo)
+	, Param ("--work-tree=" ++ workTree repo)
+	] ++ params
+gitCommandLine _ repo = assertLocal repo $ error "internal"
+
+{- Runs git in the specified repo. -}
+runBool :: String -> [CommandParam] -> Repo -> IO Bool
+runBool subcommand params repo = assertLocal repo $
+	boolSystem "git" $ gitCommandLine (Param subcommand : params) repo
+
+{- Runs git in the specified repo, throwing an error if it fails. -}
+run :: String -> [CommandParam] -> Repo -> IO ()
+run subcommand params repo = assertLocal repo $
+	runBool subcommand params repo
+		>>! error $ "git " ++ show params ++ " failed"
+
+{- Runs a git subcommand and returns its output, lazily. 
+ -
+ - Note that this leaves the git process running, and so zombies will
+ - result unless reap is called.
+ -}
+pipeRead :: [CommandParam] -> Repo -> IO L.ByteString
+pipeRead params repo = assertLocal repo $ do
+	(_, h) <- hPipeFrom "git" $ toCommand $ gitCommandLine params repo
+	hSetBinaryMode h True
+	L.hGetContents h
+
+{- Runs a git subcommand, feeding it input.
+ - You should call either getProcessStatus or forceSuccess on the PipeHandle. -}
+pipeWrite :: [CommandParam] -> L.ByteString -> Repo -> IO PipeHandle
+pipeWrite params s repo = assertLocal repo $ do
+	(p, h) <- hPipeTo "git" (toCommand $ gitCommandLine params repo)
+	L.hPut h s
+	hClose h
+	return p
+
+{- Runs a git subcommand, feeding it input, and returning its output.
+ - You should call either getProcessStatus or forceSuccess on the PipeHandle. -}
+pipeWriteRead :: [CommandParam] -> L.ByteString -> Repo -> IO (PipeHandle, L.ByteString)
+pipeWriteRead params s repo = assertLocal repo $ do
+	(p, from, to) <- hPipeBoth "git" (toCommand $ gitCommandLine params repo)
+	hSetBinaryMode from True
+	L.hPut to s
+	hClose to
+	c <- L.hGetContents from
+	return (p, c)
+
+{- Reads null terminated output of a git command (as enabled by the -z 
+ - parameter), and splits it. -}
+pipeNullSplit :: [CommandParam] -> Repo -> IO [String]
+pipeNullSplit params repo = map L.unpack <$> pipeNullSplitB params repo
+
+{- For when Strings are not needed. -}
+pipeNullSplitB ::[CommandParam] -> Repo -> IO [L.ByteString]
+pipeNullSplitB params repo = filter (not . L.null) . L.split '\0' <$>
+	pipeRead params repo
+
+{- Reaps any zombie git processes. -}
+reap :: IO ()
+reap = do
+	-- throws an exception when there are no child processes
+	r <- catchDefaultIO (getAnyProcessStatus False True) Nothing
+	maybe (return ()) (const reap) r
diff --git a/Git/HashObject.hs b/Git/HashObject.hs
index 60822f3f0..f5e6d50cd 100644
--- a/Git/HashObject.hs
+++ b/Git/HashObject.hs
@@ -9,6 +9,7 @@ module Git.HashObject where
 
 import Common
 import Git
+import Git.Command
 
 {- Injects a set of files into git, returning the shas of the objects
  - and an IO action to call ones the the shas have been used. -}
diff --git a/Git/LsFiles.hs b/Git/LsFiles.hs
index 85215fe04..0c71ed884 100644
--- a/Git/LsFiles.hs
+++ b/Git/LsFiles.hs
@@ -16,6 +16,7 @@ module Git.LsFiles (
 ) where
 
 import Git
+import Git.Command
 import Utility.SafeCommand
 
 {- Scans for files that are checked into git at the specified locations. -}
diff --git a/Git/LsTree.hs b/Git/LsTree.hs
index 342a125eb..919e9af83 100644
--- a/Git/LsTree.hs
+++ b/Git/LsTree.hs
@@ -17,6 +17,7 @@ import System.Posix.Types
 import qualified Data.ByteString.Lazy.Char8 as L
 
 import Git
+import Git.Command
 import qualified Git.Filename
 import Utility.SafeCommand
 
diff --git a/Git/Queue.hs b/Git/Queue.hs
index 70c766d04..73470b1f0 100644
--- a/Git/Queue.hs
+++ b/Git/Queue.hs
@@ -22,6 +22,7 @@ import Control.Monad (forM_)
 import Utility.SafeCommand
 
 import Git
+import Git.Command
 
 {- An action to perform in a git repository. The file to act on
  - is not included, and must be able to be appended after the params. -}
diff --git a/Git/Ref.hs b/Git/Ref.hs
index 3b550cf5b..117ead8f2 100644
--- a/Git/Ref.hs
+++ b/Git/Ref.hs
@@ -11,6 +11,7 @@ import qualified Data.ByteString.Lazy.Char8 as L
 
 import Common
 import Git
+import Git.Command
 
 {- Converts a fully qualified git ref into a user-visible version. -}
 describe :: Ref -> String
diff --git a/Git/UnionMerge.hs b/Git/UnionMerge.hs
index a623e1ceb..a9a51007f 100644
--- a/Git/UnionMerge.hs
+++ b/Git/UnionMerge.hs
@@ -22,6 +22,7 @@ import Common
 import Git
 import Git.Sha
 import Git.CatFile
+import Git.Command
 
 type Streamer = (String -> IO ()) -> IO ()