summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Annex/Branch.hs5
-rw-r--r--CmdLine.hs3
-rw-r--r--Command/Sync.hs11
-rw-r--r--Command/Unannex.hs6
-rw-r--r--Command/Uninit.hs6
-rw-r--r--Command/Unused.hs3
-rw-r--r--Config.hs3
-rw-r--r--Git.hs78
-rw-r--r--Git/Branch.hs1
-rw-r--r--Git/CatFile.hs1
-rw-r--r--Git/CheckAttr.hs1
-rw-r--r--Git/Command.hs82
-rw-r--r--Git/HashObject.hs1
-rw-r--r--Git/LsFiles.hs1
-rw-r--r--Git/LsTree.hs1
-rw-r--r--Git/Queue.hs1
-rw-r--r--Git/Ref.hs1
-rw-r--r--Git/UnionMerge.hs1
-rw-r--r--Remote/Bup.hs5
-rw-r--r--Remote/Git.hs3
-rw-r--r--Remote/Helper/Special.hs3
-rw-r--r--Upgrade/V2.hs8
22 files changed, 125 insertions, 100 deletions
diff --git a/Annex/Branch.hs b/Annex/Branch.hs
index a22a4adcf..af1878479 100644
--- a/Annex/Branch.hs
+++ b/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
diff --git a/CmdLine.hs b/CmdLine.hs
index 672969c30..ebcca25aa 100644
--- a/CmdLine.hs
+++ b/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
diff --git a/Command/Sync.hs b/Command/Sync.hs
index 987eb6138..a25bcad8c 100644
--- a/Command/Sync.hs
+++ b/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
diff --git a/Command/Unannex.hs b/Command/Unannex.hs
index bed857b06..8a511bf4d 100644
--- a/Command/Unannex.hs
+++ b/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]
diff --git a/Command/Uninit.hs b/Command/Uninit.hs
index 48f5b1ac1..fc6f0cc27 100644
--- a/Command/Uninit.hs
+++ b/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
diff --git a/Command/Unused.hs b/Command/Unused.hs
index cd1cd1602..8a70ff335 100644
--- a/Command/Unused.hs
+++ b/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
diff --git a/Config.hs b/Config.hs
index 07c9eedad..4cc4c1866 100644
--- a/Config.hs
+++ b/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 }
diff --git a/Git.hs b/Git.hs
index a3f2ad74c..9420810a6 100644
--- a/Git.hs
+++ b/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"
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 ()
diff --git a/Remote/Bup.hs b/Remote/Bup.hs
index 4d63d88e1..8bd484b7d 100644
--- a/Remote/Bup.hs
+++ b/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
diff --git a/Remote/Git.hs b/Remote/Git.hs
index d848a21b3..f27d17084 100644
--- a/Remote/Git.hs
+++ b/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]
diff --git a/Remote/Helper/Special.hs b/Remote/Helper/Special.hs
index c374a16aa..3f6c9c155 100644
--- a/Remote/Helper/Special.hs
+++ b/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
diff --git a/Upgrade/V2.hs b/Upgrade/V2.hs
index 3440d504b..ffc2f6002 100644
--- a/Upgrade/V2.hs
+++ b/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"
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-10 20:01:25 +0000