summaryrefslogtreecommitdiff
path: root/Git
diff options
context:
space:
mode:
Diffstat (limited to 'Git')
-rw-r--r--Git/Branch.hs7
-rw-r--r--Git/BuildVersion.hs2
-rw-r--r--Git/CatFile.hs4
-rw-r--r--Git/Command.hs4
-rw-r--r--Git/Config.hs24
-rw-r--r--Git/Construct.hs38
-rw-r--r--Git/CurrentRepo.hs6
-rw-r--r--Git/Destroyer.hs1
-rw-r--r--Git/DiffTreeItem.hs2
-rw-r--r--Git/FilePath.hs5
-rw-r--r--Git/Filename.hs6
-rw-r--r--Git/Fsck.hs2
-rw-r--r--Git/Index.hs2
-rw-r--r--Git/LsFiles.hs85
-rw-r--r--Git/LsTree.hs31
-rw-r--r--Git/Objects.hs2
-rw-r--r--Git/Ref.hs5
-rw-r--r--Git/RefLog.hs22
-rw-r--r--Git/Remote.hs2
-rw-r--r--Git/Repair.hs23
-rw-r--r--Git/Sha.hs2
-rw-r--r--Git/Types.hs2
-rw-r--r--Git/UpdateIndex.hs2
-rw-r--r--Git/Url.hs2
-rw-r--r--Git/Version.hs4
25 files changed, 186 insertions, 99 deletions
diff --git a/Git/Branch.hs b/Git/Branch.hs
index 5c6135d..a2225dc 100644
--- a/Git/Branch.hs
+++ b/Git/Branch.hs
@@ -1,6 +1,6 @@
{- git branch stuff
-
- - Copyright 2011 Joey Hess <joey@kitenet.net>
+ - Copyright 2011 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@@ -37,15 +37,12 @@ current r = do
{- The current branch, which may not really exist yet. -}
currentUnsafe :: Repo -> IO (Maybe Git.Ref)
currentUnsafe r = parse . firstLine
- <$> pipeReadStrict [Param "symbolic-ref", Param $ fromRef Git.Ref.headRef] r
+ <$> pipeReadStrict [Param "symbolic-ref", Param "-q", Param $ fromRef Git.Ref.headRef] r
where
parse l
| null l = Nothing
| otherwise = Just $ Git.Ref l
-currentSha :: Repo -> IO (Maybe Git.Sha)
-currentSha r = maybe (pure Nothing) (`Git.Ref.sha` r) =<< current r
-
{- Checks if the second branch has any commits not present on the first
- branch. -}
changed :: Branch -> Branch -> Repo -> IO Bool
diff --git a/Git/BuildVersion.hs b/Git/BuildVersion.hs
index 832ee8a..50e4a3a 100644
--- a/Git/BuildVersion.hs
+++ b/Git/BuildVersion.hs
@@ -1,6 +1,6 @@
{- git build version
-
- - Copyright 2011 Joey Hess <joey@kitenet.net>
+ - Copyright 2011 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
diff --git a/Git/CatFile.hs b/Git/CatFile.hs
index d0bcef4..c63a064 100644
--- a/Git/CatFile.hs
+++ b/Git/CatFile.hs
@@ -1,6 +1,6 @@
{- git cat-file interface
-
- - Copyright 2011, 2013 Joey Hess <joey@kitenet.net>
+ - Copyright 2011, 2013 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@@ -110,4 +110,4 @@ catTree h treeref = go <$> catObjectDetails h treeref
parsemodefile b =
let (modestr, file) = separate (== ' ') (decodeBS b)
in (file, readmode modestr)
- readmode = fst . fromMaybe (0, undefined) . headMaybe . readOct
+ readmode = fromMaybe 0 . fmap fst . headMaybe . readOct
diff --git a/Git/Command.hs b/Git/Command.hs
index c61cc9f..02e3e5a 100644
--- a/Git/Command.hs
+++ b/Git/Command.hs
@@ -1,6 +1,6 @@
{- running git commands
-
- - Copyright 2010-2013 Joey Hess <joey@kitenet.net>
+ - Copyright 2010-2013 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@@ -16,7 +16,7 @@ import qualified Utility.CoProcess as CoProcess
{- Constructs a git command line operating on the specified repo. -}
gitCommandLine :: [CommandParam] -> Repo -> [CommandParam]
-gitCommandLine params r@(Repo { location = l@(Local _ _ ) }) =
+gitCommandLine params r@(Repo { location = l@(Local { } ) }) =
setdir : settree ++ gitGlobalOpts r ++ params
where
setdir = Param $ "--git-dir=" ++ gitdir l
diff --git a/Git/Config.hs b/Git/Config.hs
index 32c0dd1..3d62395 100644
--- a/Git/Config.hs
+++ b/Git/Config.hs
@@ -1,6 +1,6 @@
{- git repository configuration handling
-
- - Copyright 2010-2012 Joey Hess <joey@kitenet.net>
+ - Copyright 2010-2012 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@@ -14,6 +14,7 @@ import Common
import Git
import Git.Types
import qualified Git.Construct
+import qualified Git.Command
import Utility.UserInfo
{- Returns a single git config setting, or a default value if not set. -}
@@ -66,10 +67,9 @@ global = do
home <- myHomeDir
ifM (doesFileExist $ home </> ".gitconfig")
( do
- repo <- Git.Construct.fromUnknown
- repo' <- withHandle StdoutHandle createProcessSuccess p $
- hRead repo
- return $ Just repo'
+ repo <- withHandle StdoutHandle createProcessSuccess p $
+ hRead (Git.Construct.fromUnknown)
+ return $ Just repo
, return Nothing
)
where
@@ -194,3 +194,17 @@ changeFile f k v = boolSystem "git"
, Param k
, Param v
]
+
+{- Unsets a git config setting, in both the git repo,
+ - and the cached config in the Repo.
+ -
+ - If unsetting the config fails, including in a read-only repo, or
+ - when the config is not set, returns Nothing.
+ -}
+unset :: String -> Repo -> IO (Maybe Repo)
+unset k r = ifM (Git.Command.runBool ps r)
+ ( return $ Just $ r { config = M.delete k (config r) }
+ , return Nothing
+ )
+ where
+ ps = [Param "config", Param "--unset-all", Param k]
diff --git a/Git/Construct.hs b/Git/Construct.hs
index 3c6013a..03dd29f 100644
--- a/Git/Construct.hs
+++ b/Git/Construct.hs
@@ -1,6 +1,6 @@
{- Construction of Git Repo objects
-
- - Copyright 2010-2012 Joey Hess <joey@kitenet.net>
+ - Copyright 2010-2012 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@@ -19,8 +19,8 @@ module Git.Construct (
fromRemotes,
fromRemoteLocation,
repoAbsPath,
- newFrom,
checkForRepo,
+ newFrom,
) where
#ifndef mingw32_HOST_OS
@@ -45,10 +45,10 @@ fromCwd = getCurrentDirectory >>= seekUp
seekUp dir = do
r <- checkForRepo dir
case r of
- Nothing -> case parentDir dir of
+ Nothing -> case upFrom dir of
Nothing -> return Nothing
Just d -> seekUp d
- Just loc -> Just <$> newFrom loc
+ Just loc -> pure $ Just $ newFrom loc
{- Local Repo constructor, accepts a relative or absolute path. -}
fromPath :: FilePath -> IO Repo
@@ -58,24 +58,29 @@ fromPath dir = fromAbsPath =<< absPath dir
- specified. -}
fromAbsPath :: FilePath -> IO Repo
fromAbsPath dir
- | absoluteGitPath dir = ifM (doesDirectoryExist dir') ( ret dir' , hunt )
+ | absoluteGitPath dir = hunt
| otherwise =
error $ "internal error, " ++ dir ++ " is not absolute"
where
- ret = newFrom . LocalUnknown
- {- Git always looks for "dir.git" in preference to
- - to "dir", even if dir ends in a "/". -}
+ ret = pure . newFrom . LocalUnknown
canondir = dropTrailingPathSeparator dir
- dir' = canondir ++ ".git"
{- When dir == "foo/.git", git looks for "foo/.git/.git",
- and failing that, uses "foo" as the repository. -}
hunt
| (pathSeparator:".git") `isSuffixOf` canondir =
ifM (doesDirectoryExist $ dir </> ".git")
( ret dir
- , ret $ takeDirectory canondir
+ , ret (takeDirectory canondir)
)
- | otherwise = ret dir
+ | otherwise = ifM (doesDirectoryExist dir)
+ ( ret dir
+ -- git falls back to dir.git when dir doesn't
+ -- exist, as long as dir didn't end with a
+ -- path separator
+ , if dir == canondir
+ then ret (dir ++ ".git")
+ else ret dir
+ )
{- Remote Repo constructor. Throws exception on invalid url.
-
@@ -90,13 +95,13 @@ fromUrl url
fromUrlStrict :: String -> IO Repo
fromUrlStrict url
| startswith "file://" url = fromAbsPath $ unEscapeString $ uriPath u
- | otherwise = newFrom $ Url u
+ | otherwise = pure $ newFrom $ Url u
where
u = fromMaybe bad $ parseURI url
bad = error $ "bad url " ++ url
{- Creates a repo that has an unknown location. -}
-fromUnknown :: IO Repo
+fromUnknown :: Repo
fromUnknown = newFrom Unknown
{- Converts a local Repo into a remote repo, using the reference repo
@@ -153,7 +158,7 @@ fromRemoteLocation s repo = gen $ parseRemoteLocation s repo
fromRemotePath :: FilePath -> Repo -> IO Repo
fromRemotePath dir repo = do
dir' <- expandTilde dir
- fromAbsPath $ repoPath repo </> dir'
+ fromPath $ repoPath repo </> dir'
{- Git remotes can have a directory that is specified relative
- to the user's home directory, or that contains tilde expansions.
@@ -223,8 +228,8 @@ checkForRepo dir =
gitdirprefix = "gitdir: "
gitSignature file = doesFileExist $ dir </> file
-newFrom :: RepoLocation -> IO Repo
-newFrom l = return Repo
+newFrom :: RepoLocation -> Repo
+newFrom l = Repo
{ location = l
, config = M.empty
, fullconfig = M.empty
@@ -234,4 +239,3 @@ newFrom l = return Repo
, gitGlobalOpts = []
}
-
diff --git a/Git/CurrentRepo.hs b/Git/CurrentRepo.hs
index f611f7a..dab4ad2 100644
--- a/Git/CurrentRepo.hs
+++ b/Git/CurrentRepo.hs
@@ -1,6 +1,6 @@
{- The current git repository.
-
- - Copyright 2012 Joey Hess <joey@kitenet.net>
+ - Copyright 2012 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@@ -50,8 +50,8 @@ get = do
configure (Just d) _ = do
absd <- absPath d
curr <- getCurrentDirectory
- r <- newFrom $ Local { gitdir = absd, worktree = Just curr }
- Git.Config.read r
+ Git.Config.read $ newFrom $
+ Local { gitdir = absd, worktree = Just curr }
configure Nothing Nothing = error "Not in a git repository."
addworktree w r = changelocation r $
diff --git a/Git/Destroyer.hs b/Git/Destroyer.hs
index 2ac4dae..e923796 100644
--- a/Git/Destroyer.hs
+++ b/Git/Destroyer.hs
@@ -21,7 +21,6 @@ import Utility.Tmp
import qualified Data.ByteString as B
import Data.Word
-import System.PosixCompat.Types
{- Ways to damange a git repository. -}
data Damage
diff --git a/Git/DiffTreeItem.hs b/Git/DiffTreeItem.hs
index 2389b69..859f590 100644
--- a/Git/DiffTreeItem.hs
+++ b/Git/DiffTreeItem.hs
@@ -1,6 +1,6 @@
{- git diff-tree item
-
- - Copyright 2012 Joey Hess <joey@kitenet.net>
+ - Copyright 2012 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
diff --git a/Git/FilePath.hs b/Git/FilePath.hs
index 42eb081..edc3c0f 100644
--- a/Git/FilePath.hs
+++ b/Git/FilePath.hs
@@ -5,7 +5,7 @@
- top of the repository even when run in a subdirectory. Adding some
- types helps keep that straight.
-
- - Copyright 2012-2013 Joey Hess <joey@kitenet.net>
+ - Copyright 2012-2013 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@@ -39,8 +39,7 @@ fromTopFilePath p repo = absPathFrom (repoPath repo) (getTopFilePath p)
{- The input FilePath can be absolute, or relative to the CWD. -}
toTopFilePath :: FilePath -> Git.Repo -> IO TopFilePath
-toTopFilePath file repo = TopFilePath <$>
- relPathDirToFile (repoPath repo) <$> absPath file
+toTopFilePath file repo = TopFilePath <$> relPathDirToFile (repoPath repo) file
{- The input FilePath must already be relative to the top of the git
- repository -}
diff --git a/Git/Filename.hs b/Git/Filename.hs
index 5e076d3..ee84d48 100644
--- a/Git/Filename.hs
+++ b/Git/Filename.hs
@@ -1,7 +1,7 @@
{- Some git commands output encoded filenames, in a rather annoyingly complex
- C-style encoding.
-
- - Copyright 2010, 2011 Joey Hess <joey@kitenet.net>
+ - Copyright 2010, 2011 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@@ -24,5 +24,5 @@ encode :: FilePath -> String
encode s = "\"" ++ encode_c s ++ "\""
{- for quickcheck -}
-prop_idempotent_deencode :: String -> Bool
-prop_idempotent_deencode s = s == decode (encode s)
+prop_isomorphic_deencode :: String -> Bool
+prop_isomorphic_deencode s = s == decode (encode s)
diff --git a/Git/Fsck.hs b/Git/Fsck.hs
index c6002f6..f3e6db9 100644
--- a/Git/Fsck.hs
+++ b/Git/Fsck.hs
@@ -1,6 +1,6 @@
{- git fsck interface
-
- - Copyright 2013 Joey Hess <joey@kitenet.net>
+ - Copyright 2013 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
diff --git a/Git/Index.hs b/Git/Index.hs
index 7145bb9..551fd98 100644
--- a/Git/Index.hs
+++ b/Git/Index.hs
@@ -1,6 +1,6 @@
{- git index file stuff
-
- - Copyright 2011 Joey Hess <joey@kitenet.net>
+ - Copyright 2011 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
diff --git a/Git/LsFiles.hs b/Git/LsFiles.hs
index 2aa05ba..f945838 100644
--- a/Git/LsFiles.hs
+++ b/Git/LsFiles.hs
@@ -1,6 +1,6 @@
{- git ls-files interface
-
- - Copyright 2010,2012 Joey Hess <joey@kitenet.net>
+ - Copyright 2010,2012 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@@ -35,14 +35,23 @@ import System.Posix.Types
{- Scans for files that are checked into git at the specified locations. -}
inRepo :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
-inRepo l = pipeNullSplit $ Params "ls-files --cached -z --" : map File l
+inRepo l = pipeNullSplit $
+ Param "ls-files" :
+ Param "--cached" :
+ Param "-z" :
+ Param "--" :
+ map File l
{- Scans for files at the specified locations that are not checked into git. -}
notInRepo :: Bool -> [FilePath] -> Repo -> IO ([FilePath], IO Bool)
notInRepo include_ignored l repo = pipeNullSplit params repo
where
- params = [Params "ls-files --others"] ++ exclude ++
- [Params "-z --"] ++ map File l
+ params = concat
+ [ [ Param "ls-files", Param "--others"]
+ , exclude
+ , [ Param "-z", Param "--" ]
+ , map File l
+ ]
exclude
| include_ignored = []
| otherwise = [Param "--exclude-standard"]
@@ -50,28 +59,51 @@ notInRepo include_ignored l repo = pipeNullSplit params repo
{- Finds all files in the specified locations, whether checked into git or
- not. -}
allFiles :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
-allFiles l = pipeNullSplit $ Params "ls-files --cached --others -z --" : map File l
+allFiles l = pipeNullSplit $
+ Param "ls-files" :
+ Param "--cached" :
+ Param "--others" :
+ Param "-z" :
+ Param "--" :
+ map File l
{- Returns a list of files in the specified locations that have been
- deleted. -}
deleted :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
deleted l repo = pipeNullSplit params repo
where
- params = [Params "ls-files --deleted -z --"] ++ map File l
+ params =
+ Param "ls-files" :
+ Param "--deleted" :
+ Param "-z" :
+ Param "--" :
+ map File l
{- Returns a list of files in the specified locations that have been
- modified. -}
modified :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
modified l repo = pipeNullSplit params repo
where
- params = [Params "ls-files --modified -z --"] ++ map File l
+ params =
+ Param "ls-files" :
+ Param "--modified" :
+ Param "-z" :
+ Param "--" :
+ map File l
{- Files that have been modified or are not checked into git (and are not
- ignored). -}
modifiedOthers :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
modifiedOthers l repo = pipeNullSplit params repo
where
- params = [Params "ls-files --modified --others --exclude-standard -z --"] ++ map File l
+ params =
+ Param "ls-files" :
+ Param "--modified" :
+ Param "--others" :
+ Param "--exclude-standard" :
+ Param "-z" :
+ Param "--" :
+ map File l
{- Returns a list of all files that are staged for commit. -}
staged :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
@@ -85,7 +117,7 @@ stagedNotDeleted = staged' [Param "--diff-filter=ACMRT"]
staged' :: [CommandParam] -> [FilePath] -> Repo -> IO ([FilePath], IO Bool)
staged' ps l = pipeNullSplit $ prefix ++ ps ++ suffix
where
- prefix = [Params "diff --cached --name-only -z"]
+ prefix = [Param "diff", Param "--cached", Param "--name-only", Param "-z"]
suffix = Param "--" : map File l
type StagedDetails = (FilePath, Maybe Sha, Maybe FileMode)
@@ -93,7 +125,7 @@ type StagedDetails = (FilePath, Maybe Sha, Maybe FileMode)
{- Returns details about files that are staged in the index,
- as well as files not yet in git. Skips ignored files. -}
stagedOthersDetails :: [FilePath] -> Repo -> IO ([StagedDetails], IO Bool)
-stagedOthersDetails = stagedDetails' [Params "--others --exclude-standard"]
+stagedOthersDetails = stagedDetails' [Param "--others", Param "--exclude-standard"]
{- Returns details about all files that are staged in the index. -}
stagedDetails :: [FilePath] -> Repo -> IO ([StagedDetails], IO Bool)
@@ -106,7 +138,7 @@ stagedDetails' ps l repo = do
(ls, cleanup) <- pipeNullSplit params repo
return (map parse ls, cleanup)
where
- params = Params "ls-files --stage -z" : ps ++
+ params = Param "ls-files" : Param "--stage" : Param "-z" : ps ++
Param "--" : map File l
parse s
| null file = (s, Nothing, Nothing)
@@ -131,11 +163,16 @@ typeChanged' ps l repo = do
(fs, cleanup) <- pipeNullSplit (prefix ++ ps ++ suffix) repo
-- git diff returns filenames relative to the top of the git repo;
-- convert to filenames relative to the cwd, like git ls-files.
- let top = repoPath repo
+ top <- absPath (repoPath repo)
currdir <- getCurrentDirectory
- return (map (\f -> relPathDirToFile currdir $ top </> f) fs, cleanup)
+ return (map (\f -> relPathDirToFileAbs currdir $ top </> f) fs, cleanup)
where
- prefix = [Params "diff --name-only --diff-filter=T -z"]
+ prefix =
+ [ Param "diff"
+ , Param "--name-only"
+ , Param "--diff-filter=T"
+ , Param "-z"
+ ]
suffix = Param "--" : (if null l then [File "."] else map File l)
{- A item in conflict has two possible values.
@@ -166,7 +203,12 @@ unmerged l repo = do
(fs, cleanup) <- pipeNullSplit params repo
return (reduceUnmerged [] $ catMaybes $ map parseUnmerged fs, cleanup)
where
- params = Params "ls-files --unmerged -z --" : map File l
+ params =
+ Param "ls-files" :
+ Param "--unmerged" :
+ Param "-z" :
+ Param "--" :
+ map File l
data InternalUnmerged = InternalUnmerged
{ isus :: Bool
@@ -181,12 +223,13 @@ parseUnmerged s
| otherwise = case words metadata of
(rawblobtype:rawsha:rawstage:_) -> do
stage <- readish rawstage :: Maybe Int
- unless (stage == 2 || stage == 3) $
- fail undefined -- skip stage 1
- blobtype <- readBlobType rawblobtype
- sha <- extractSha rawsha
- return $ InternalUnmerged (stage == 2) file
- (Just blobtype) (Just sha)
+ if stage /= 2 && stage /= 3
+ then Nothing
+ else do
+ blobtype <- readBlobType rawblobtype
+ sha <- extractSha rawsha
+ return $ InternalUnmerged (stage == 2) file
+ (Just blobtype) (Just sha)
_ -> Nothing
where
(metadata, file) = separate (== '\t') s
diff --git a/Git/LsTree.hs b/Git/LsTree.hs
index ca5e323..1ed6247 100644
--- a/Git/LsTree.hs
+++ b/Git/LsTree.hs
@@ -1,6 +1,6 @@
{- git ls-tree interface
-
- - Copyright 2011 Joey Hess <joey@kitenet.net>
+ - Copyright 2011 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@@ -13,10 +13,6 @@ module Git.LsTree (
parseLsTree
) where
-import Numeric
-import Control.Applicative
-import System.Posix.Types
-
import Common
import Git
import Git.Command
@@ -24,6 +20,9 @@ import Git.Sha
import Git.FilePath
import qualified Git.Filename
+import Numeric
+import System.Posix.Types
+
data TreeItem = TreeItem
{ mode :: FileMode
, typeobj :: String
@@ -35,16 +34,30 @@ data TreeItem = TreeItem
- with lazy output. -}
lsTree :: Ref -> Repo -> IO [TreeItem]
lsTree t repo = map parseLsTree
- <$> pipeNullSplitZombie (lsTreeParams t) repo
+ <$> pipeNullSplitZombie (lsTreeParams t []) repo
-lsTreeParams :: Ref -> [CommandParam]
-lsTreeParams t = [ Params "ls-tree --full-tree -z -r --", File $ fromRef t ]
+lsTreeParams :: Ref -> [CommandParam] -> [CommandParam]
+lsTreeParams r ps =
+ [ Param "ls-tree"
+ , Param "--full-tree"
+ , Param "-z"
+ , Param "-r"
+ ] ++ ps ++
+ [ Param "--"
+ , File $ fromRef r
+ ]
{- Lists specified files in a tree. -}
lsTreeFiles :: Ref -> [FilePath] -> Repo -> IO [TreeItem]
lsTreeFiles t fs repo = map parseLsTree <$> pipeNullSplitStrict ps repo
where
- ps = [Params "ls-tree --full-tree -z --", File $ fromRef t] ++ map File fs
+ ps =
+ [ Param "ls-tree"
+ , Param "--full-tree"
+ , Param "-z"
+ , Param "--"
+ , File $ fromRef t
+ ] ++ map File fs
{- Parses a line of ls-tree output.
- (The --long format is not currently supported.) -}
diff --git a/Git/Objects.hs b/Git/Objects.hs
index dadd4f5..bda220b 100644
--- a/Git/Objects.hs
+++ b/Git/Objects.hs
@@ -1,6 +1,6 @@
{- .git/objects
-
- - Copyright 2013 Joey Hess <joey@kitenet.net>
+ - Copyright 2013 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
diff --git a/Git/Ref.hs b/Git/Ref.hs
index 3d0c68f..6bc47d5 100644
--- a/Git/Ref.hs
+++ b/Git/Ref.hs
@@ -1,6 +1,6 @@
{- git ref stuff
-
- - Copyright 2011-2013 Joey Hess <joey@kitenet.net>
+ - Copyright 2011-2013 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@@ -88,6 +88,9 @@ sha branch repo = process <$> showref repo
process [] = Nothing
process s = Just $ Ref $ firstLine s
+headSha :: Repo -> IO (Maybe Sha)
+headSha = sha headRef
+
{- List of (shas, branches) matching a given ref or refs. -}
matching :: [Ref] -> Repo -> IO [(Sha, Branch)]
matching refs repo = matching' (map fromRef refs) repo
diff --git a/Git/RefLog.hs b/Git/RefLog.hs
index 98c9d66..57f35e9 100644
--- a/Git/RefLog.hs
+++ b/Git/RefLog.hs
@@ -1,6 +1,6 @@
{- git reflog interface
-
- - Copyright 2013 Joey Hess <joey@kitenet.net>
+ - Copyright 2013 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@@ -14,9 +14,17 @@ import Git.Sha
{- Gets the reflog for a given branch. -}
get :: Branch -> Repo -> IO [Sha]
-get b = mapMaybe extractSha . lines <$$> pipeReadStrict
- [ Param "log"
- , Param "-g"
- , Param "--format=%H"
- , Param (fromRef b)
- ]
+get b = getMulti [b]
+
+{- Gets reflogs for multiple branches. -}
+getMulti :: [Branch] -> Repo -> IO [Sha]
+getMulti bs = get' (map (Param . fromRef) bs)
+
+get' :: [CommandParam] -> Repo -> IO [Sha]
+get' ps = mapMaybe extractSha . lines <$$> pipeReadStrict ps'
+ where
+ ps' = catMaybes
+ [ Just $ Param "log"
+ , Just $ Param "-g"
+ , Just $ Param "--format=%H"
+ ] ++ ps
diff --git a/Git/Remote.hs b/Git/Remote.hs
index 156e308..717b540 100644
--- a/Git/Remote.hs
+++ b/Git/Remote.hs
@@ -1,6 +1,6 @@
{- git remote stuff
-
- - Copyright 2012 Joey Hess <joey@kitenet.net>
+ - Copyright 2012 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
diff --git a/Git/Repair.hs b/Git/Repair.hs
index 5731138..b441f13 100644
--- a/Git/Repair.hs
+++ b/Git/Repair.hs
@@ -1,6 +1,6 @@
{- git repository recovery
-
- - Copyright 2013-2014 Joey Hess <joey@kitenet.net>
+ - Copyright 2013-2014 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@@ -99,7 +99,7 @@ retrieveMissingObjects :: FsckResults -> Maybe FilePath -> Repo -> IO FsckResult
retrieveMissingObjects missing referencerepo r
| not (foundBroken missing) = return missing
| otherwise = withTmpDir "tmprepo" $ \tmpdir -> do
- unlessM (boolSystem "git" [Params "init", File tmpdir]) $
+ unlessM (boolSystem "git" [Param "init", File tmpdir]) $
error $ "failed to create temp repository in " ++ tmpdir
tmpr <- Config.read =<< Construct.fromAbsPath tmpdir
stillmissing <- pullremotes tmpr (remotes r) fetchrefstags missing
@@ -140,7 +140,9 @@ retrieveMissingObjects missing referencerepo r
ps' =
[ Param "fetch"
, Param fetchurl
- , Params "--force --update-head-ok --quiet"
+ , Param "--force"
+ , Param "--update-head-ok"
+ , Param "--quiet"
] ++ ps
fetchr' = fetchr { gitGlobalOpts = gitGlobalOpts fetchr ++ nogc }
nogc = [ Param "-c", Param "gc.auto=0" ]
@@ -225,10 +227,13 @@ badBranches missing r = filterM isbad =<< getAllRefs r
- Relies on packed refs being exploded before it's called.
-}
getAllRefs :: Repo -> IO [Ref]
-getAllRefs r = map toref <$> dirContentsRecursive refdir
- where
- refdir = localGitDir r </> "refs"
- toref = Ref . relPathDirToFile (localGitDir r)
+getAllRefs r = getAllRefs' (localGitDir r </> "refs")
+
+getAllRefs' :: FilePath -> IO [Ref]
+getAllRefs' refdir = do
+ let topsegs = length (splitPath refdir) - 1
+ let toref = Ref . joinPath . drop topsegs . splitPath
+ map toref <$> dirContentsRecursive refdir
explodePackedRefsFile :: Repo -> IO ()
explodePackedRefsFile r = do
@@ -241,7 +246,7 @@ explodePackedRefsFile r = do
where
makeref (sha, ref) = do
let dest = localGitDir r </> fromRef ref
- createDirectoryIfMissing True (takeDirectory dest)
+ createDirectoryIfMissing True (parentDir dest)
unlessM (doesFileExist dest) $
writeFile dest (fromRef sha)
@@ -336,7 +341,7 @@ verifyTree :: MissingObjects -> Sha -> Repo -> IO Bool
verifyTree missing treesha r
| S.member treesha missing = return False
| otherwise = do
- (ls, cleanup) <- pipeNullSplit (LsTree.lsTreeParams treesha) r
+ (ls, cleanup) <- pipeNullSplit (LsTree.lsTreeParams treesha []) r
let objshas = map (extractSha . LsTree.sha . LsTree.parseLsTree) ls
if any isNothing objshas || any (`S.member` missing) (catMaybes objshas)
then do
diff --git a/Git/Sha.hs b/Git/Sha.hs
index cbb66ea..b802c85 100644
--- a/Git/Sha.hs
+++ b/Git/Sha.hs
@@ -1,6 +1,6 @@
{- git SHA stuff
-
- - Copyright 2011 Joey Hess <joey@kitenet.net>
+ - Copyright 2011 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
diff --git a/Git/Types.hs b/Git/Types.hs
index 838c9e0..bb91a17 100644
--- a/Git/Types.hs
+++ b/Git/Types.hs
@@ -1,6 +1,6 @@
{- git data types
-
- - Copyright 2010-2012 Joey Hess <joey@kitenet.net>
+ - Copyright 2010-2012 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
diff --git a/Git/UpdateIndex.hs b/Git/UpdateIndex.hs
index 613596d..55c5b3b 100644
--- a/Git/UpdateIndex.hs
+++ b/Git/UpdateIndex.hs
@@ -1,6 +1,6 @@
{- git-update-index library
-
- - Copyright 2011-2013 Joey Hess <joey@kitenet.net>
+ - Copyright 2011-2013 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
diff --git a/Git/Url.hs b/Git/Url.hs
index d383a6a..fa7d200 100644
--- a/Git/Url.hs
+++ b/Git/Url.hs
@@ -1,6 +1,6 @@
{- git repository urls
-
- - Copyright 2010, 2011 Joey Hess <joey@kitenet.net>
+ - Copyright 2010, 2011 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
diff --git a/Git/Version.hs b/Git/Version.hs
index 73ce2f8..19ff945 100644
--- a/Git/Version.hs
+++ b/Git/Version.hs
@@ -1,10 +1,12 @@
{- git versions
-
- - Copyright 2011, 2013 Joey Hess <joey@kitenet.net>
+ - Copyright 2011, 2013 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
+
module Git.Version (
installed,
older,
generated by cgit v1.2.3 (git 2.39.1) at 2024-05-18 01:35:00 +0000