split out Git/Command.hs

Annex/Branch.hs

@@ -24,6 +24,7 @@ import Annex.Exception
 import Annex.BranchState
 import Annex.Journal
 import qualified Git
+import qualified Git.Command
 import qualified Git.Ref
 import qualified Git.Branch
 import qualified Git.UnionMerge
@@ -67,7 +68,7 @@ getBranch :: Annex (Git.Ref)
 getBranch = maybe (hasOrigin >>= go >>= use) (return) =<< branchsha
 	where
 		go True = do
-			inRepo $ Git.run "branch"
+			inRepo $ Git.Command.run "branch"
 				[Param $ show name, Param $ show originname]
 			fromMaybe (error $ "failed to create " ++ show name)
 				<$> branchsha
@@ -221,7 +222,7 @@ commitBranch branchref message parents = do
 {- Lists all files on the branch. There may be duplicates in the list. -}
 files :: Annex [FilePath]
 files = withIndexUpdate $ do
-	bfiles <- inRepo $ Git.pipeNullSplit
+	bfiles <- inRepo $ Git.Command.pipeNullSplit
 		[Params "ls-tree --name-only -r -z", Param $ show fullname]
 	jfiles <- getJournalledFiles
 	return $ jfiles ++ bfiles

CmdLine.hs

@@ -20,6 +20,7 @@ import Common.Annex
 import qualified Annex
 import qualified Annex.Queue
 import qualified Git
+import qualified Git.Command
 import Annex.Content
 import Command
 
@@ -101,5 +102,5 @@ startup = return True
 shutdown :: Annex Bool
 shutdown = do
 	saveState
-	liftIO Git.reap -- zombies from long-running git processes
+	liftIO Git.Command.reap -- zombies from long-running git processes
 	return True

Command/Sync.hs

@@ -10,7 +10,7 @@ module Command.Sync where
 import Common.Annex
 import Command
 import qualified Annex.Branch
-import qualified Git
+import qualified Git.Command
 import qualified Git.Config
 
 import qualified Data.ByteString.Lazy.Char8 as L
@@ -28,7 +28,8 @@ commit = do
 	next $ next $ do
 		showOutput
 		-- Commit will fail when the tree is clean, so ignore failure.
-		_ <- inRepo $ Git.runBool "commit" [Param "-a", Param "-m", Param "sync"]
+		_ <- inRepo $ Git.Command.runBool "commit"
+			[Param "-a", Param "-m", Param "sync"]
 		return True
 
 pull :: CommandStart
@@ -38,7 +39,7 @@ pull = do
 	next $ next $ do
 		showOutput
 		checkRemote remote
-		inRepo $ Git.runBool "pull" [Param remote]
+		inRepo $ Git.Command.runBool "pull" [Param remote]
 
 push :: CommandStart
 push = do
@@ -47,7 +48,7 @@ push = do
 	next $ next $ do
 		Annex.Branch.update
 		showOutput
-		inRepo $ Git.runBool "push" [Param remote, matchingbranches]
+		inRepo $ Git.Command.runBool "push" [Param remote, matchingbranches]
 	where
 		-- git push may be configured to not push matching
 		-- branches; this should ensure it always does.
@@ -61,7 +62,7 @@ defaultRemote = do
 
 currentBranch :: Annex String
 currentBranch = last . split "/" . L.unpack . head . L.lines <$>
-	inRepo (Git.pipeRead [Param "symbolic-ref", Param "HEAD"])
+	inRepo (Git.Command.pipeRead [Param "symbolic-ref", Param "HEAD"])
 
 checkRemote :: String -> Annex ()
 checkRemote remote = do

Command/Unannex.hs

@@ -13,7 +13,7 @@ import qualified Annex
 import Utility.FileMode
 import Logs.Location
 import Annex.Content
-import qualified Git
+import qualified Git.Command
 import qualified Git.LsFiles as LsFiles
 
 def :: [Command]
@@ -34,14 +34,14 @@ cleanup :: FilePath -> Key -> CommandCleanup
 cleanup file key = do
 	liftIO $ removeFile file
 	-- git rm deletes empty directory without --cached
-	inRepo $ Git.run "rm" [Params "--cached --quiet --", File file]
+	inRepo $ Git.Command.run "rm" [Params "--cached --quiet --", File file]
 	
 	-- If the file was already committed, it is now staged for removal.
 	-- Commit that removal now, to avoid later confusing the
 	-- pre-commit hook if this file is later added back to
 	-- git as a normal, non-annexed file.
 	whenM (not . null <$> inRepo (LsFiles.staged [file])) $ do
-		inRepo $ Git.run "commit" [
+		inRepo $ Git.Command.run "commit" [
 			Param "-m", Param "content removed from git annex",
 			Param "--", File file]
 

Command/Uninit.hs

@@ -12,6 +12,7 @@ import qualified Data.ByteString.Lazy.Char8 as B
 import Common.Annex
 import Command
 import qualified Git
+import qualified Git.Command
 import qualified Annex
 import qualified Command.Unannex
 import Init
@@ -29,7 +30,7 @@ check = do
 		"cannot uninit when the " ++ show b ++ " branch is checked out"
 	where
 		current_branch = Git.Ref . head . lines . B.unpack <$> revhead
-		revhead = inRepo $ Git.pipeRead 
+		revhead = inRepo $ Git.Command.pipeRead 
 			[Params "rev-parse --abbrev-ref HEAD"]
 
 seek :: [CommandSeek]
@@ -57,5 +58,6 @@ cleanup = do
 	liftIO $ removeDirectoryRecursive annexdir
 	-- avoid normal shutdown
 	saveState
-	inRepo $ Git.run "branch" [Param "-D", Param $ show Annex.Branch.name]
+	inRepo $ Git.Command.run "branch"
+		[Param "-D", Param $ show Annex.Branch.name]
 	liftIO exitSuccess

Command/Unused.hs

@@ -20,6 +20,7 @@ import Utility.TempFile
 import Logs.Location
 import qualified Annex
 import qualified Git
+import qualified Git.Command
 import qualified Git.Ref
 import qualified Git.LsFiles as LsFiles
 import qualified Git.LsTree as LsTree
@@ -148,7 +149,7 @@ unusedKeys = do
 excludeReferenced :: [Key] -> Annex [Key]
 excludeReferenced [] = return [] -- optimisation
 excludeReferenced l = do
-	c <- inRepo $ Git.pipeRead [Param "show-ref"]
+	c <- inRepo $ Git.Command.pipeRead [Param "show-ref"]
 	removewith (getKeysReferenced : map getKeysReferencedInGit (refs c))
 		(S.fromList l)
 	where

Config.hs

@@ -10,6 +10,7 @@ module Config where
 import Common.Annex
 import qualified Git
 import qualified Git.Config
+import qualified Git.Command
 import qualified Annex
 
 type ConfigKey = String
@@ -17,7 +18,7 @@ type ConfigKey = String
 {- Changes a git config setting in both internal state and .git/config -}
 setConfig :: ConfigKey -> String -> Annex ()
 setConfig k value = do
-	inRepo $ Git.run "config" [Param k, Param value]
+	inRepo $ Git.Command.run "config" [Param k, Param value]
 	-- re-read git config and update the repo's state
 	newg <- inRepo Git.Config.read
 	Annex.changeState $ \s -> s { Annex.repo = newg }

Git.hs

@@ -23,22 +23,12 @@ module Git (
 	workTree,
 	gitDir,
 	configTrue,
-	gitCommandLine,
-	run,
-	runBool,
-	pipeRead,
-	pipeWrite,
-	pipeWriteRead,
-	pipeNullSplit,
-	pipeNullSplitB,
 	attributes,
-	reap,
 	assertLocal,
 ) where
 
 import qualified Data.Map as M
 import Data.Char
-import qualified Data.ByteString.Lazy.Char8 as L
 import Network.URI (uriPath, uriScheme)
 
 import Common
@@ -121,74 +111,6 @@ workTree Repo { location = Url u } = uriPath u
 workTree Repo { location = Dir d } = d
 workTree Repo { location = Unknown } = undefined
 
-{- 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
-
 {- Checks if a string from git config is a true value. -}
 configTrue :: String -> Bool
 configTrue s = map toLower s == "true"

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. -}

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)

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. -}

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

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. -}

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. -}

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
 

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. -}

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

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 ()
 

Remote/Bup.hs

@@ -15,6 +15,7 @@ import System.Process
 import Common.Annex
 import Types.Remote
 import qualified Git
+import qualified Git.Command
 import qualified Git.Config
 import qualified Git.Construct
 import Config
@@ -148,7 +149,7 @@ checkPresent r bupr k
 		ok <- onBupRemote bupr boolSystem "git" params
 		return $ Right ok
 	| otherwise = liftIO $ catchMsgIO $
-		boolSystem "git" $ Git.gitCommandLine params bupr
+		boolSystem "git" $ Git.Command.gitCommandLine params bupr
 	where
 		params = 
 			[ Params "show-ref --quiet --verify"
@@ -168,7 +169,7 @@ storeBupUUID u buprepo = do
 			r' <- Git.Config.read r
 			let olduuid = Git.Config.get "annex.uuid" "" r'
 			when (olduuid == "") $
-				Git.run "config"
+				Git.Command.run "config"
 					[Param "annex.uuid", Param v] r'
 	where
 		v = fromUUID u

Remote/Git.hs

@@ -16,6 +16,7 @@ import Utility.RsyncFile
 import Annex.Ssh
 import Types.Remote
 import qualified Git
+import qualified Git.Command
 import qualified Git.Config
 import qualified Git.Construct
 import qualified Annex
@@ -176,7 +177,7 @@ onLocal r a = do
 		-- for anything onLocal is used to do.
 		Annex.BranchState.disableUpdate
 		ret <- a
-		liftIO Git.reap
+		liftIO Git.Command.reap
 		return ret
 
 keyUrls :: Git.Repo -> Key -> [String]

Remote/Helper/Special.hs

@@ -12,6 +12,7 @@ import qualified Data.Map as M
 import Common.Annex
 import Types.Remote
 import qualified Git
+import qualified Git.Command
 import qualified Git.Construct
 
 {- Special remotes don't have a configured url, so Git.Repo does not
@@ -33,7 +34,7 @@ gitConfigSpecialRemote u c k v = do
 	set ("annex-"++k) v
 	set ("annex-uuid") (fromUUID u)
 	where
-		set a b = inRepo $ Git.run "config"
+		set a b = inRepo $ Git.Command.run "config"
 			[Param (configsetting a), Param b]
 		remotename = fromJust (M.lookup "name" c)
 		configsetting s = "remote." ++ remotename ++ "." ++ s

Upgrade/V2.hs

@@ -9,6 +9,7 @@ module Upgrade.V2 where
 
 import Common.Annex
 import qualified Git
+import qualified Git.Command
 import qualified Git.Ref
 import qualified Annex.Branch
 import Logs.Location
@@ -53,7 +54,7 @@ upgrade = do
 	showProgress
 
 	when e $ do
-		inRepo $ Git.run "rm" [Param "-r", Param "-f", Param "-q", File old]
+		inRepo $ Git.Command.run "rm" [Param "-r", Param "-f", Param "-q", File old]
 		unless bare $ inRepo gitAttributesUnWrite
 	showProgress
 
@@ -104,7 +105,8 @@ push = do
 			Annex.Branch.update -- just in case
 			showAction "pushing new git-annex branch to origin"
 			showOutput
-			inRepo $ Git.run "push" [Param "origin", Param $ show Annex.Branch.name]
+			inRepo $ Git.Command.run "push"
+				[Param "origin", Param $ show Annex.Branch.name]
 		_ -> do
 			-- no origin exists, so just let the user
 			-- know about the new branch
@@ -127,7 +129,7 @@ gitAttributesUnWrite repo = do
 		c <- readFileStrict attributes
 		liftIO $ viaTmp writeFile attributes $ unlines $
 			filter (`notElem` attrLines) $ lines c
-		Git.run "add" [File attributes] repo
+		Git.Command.run "add" [File attributes] repo
 
 stateDir :: FilePath
 stateDir = addTrailingPathSeparator ".git-annex"