From 9af9872f0f54d5d4af2aed3d08eef9ab67012261 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 6 Jan 2015 19:02:48 -0400 Subject: Merge from git-annex. --- Git/Branch.hs | 3 +++ Git/Construct.hs | 4 ++-- Git/DiffTreeItem.hs | 24 ++++++++++++++++++++++++ Git/Index.hs | 21 ++++++++++++++++++++- Git/Repair.hs | 2 +- Git/UpdateIndex.hs | 15 +++++++++++++-- Git/Version.hs | 37 ++++++++++++------------------------- 7 files changed, 75 insertions(+), 31 deletions(-) create mode 100644 Git/DiffTreeItem.hs (limited to 'Git') diff --git a/Git/Branch.hs b/Git/Branch.hs index 0b7d888..5c6135d 100644 --- a/Git/Branch.hs +++ b/Git/Branch.hs @@ -43,6 +43,9 @@ currentUnsafe r = parse . firstLine | 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/Construct.hs b/Git/Construct.hs index eed2b99..3c6013a 100644 --- a/Git/Construct.hs +++ b/Git/Construct.hs @@ -46,8 +46,8 @@ fromCwd = getCurrentDirectory >>= seekUp r <- checkForRepo dir case r of Nothing -> case parentDir dir of - "" -> return Nothing - d -> seekUp d + Nothing -> return Nothing + Just d -> seekUp d Just loc -> Just <$> newFrom loc {- Local Repo constructor, accepts a relative or absolute path. -} diff --git a/Git/DiffTreeItem.hs b/Git/DiffTreeItem.hs new file mode 100644 index 0000000..2389b69 --- /dev/null +++ b/Git/DiffTreeItem.hs @@ -0,0 +1,24 @@ +{- git diff-tree item + - + - Copyright 2012 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Git.DiffTreeItem ( + DiffTreeItem(..), +) where + +import System.Posix.Types + +import Git.FilePath +import Git.Types + +data DiffTreeItem = DiffTreeItem + { srcmode :: FileMode + , dstmode :: FileMode + , srcsha :: Sha -- nullSha if file was added + , dstsha :: Sha -- nullSha if file was deleted + , status :: String + , file :: TopFilePath + } deriving Show diff --git a/Git/Index.hs b/Git/Index.hs index c42ac42..7145bb9 100644 --- a/Git/Index.hs +++ b/Git/Index.hs @@ -11,6 +11,9 @@ import Common import Git import Utility.Env +indexEnv :: String +indexEnv = "GIT_INDEX_FILE" + {- Forces git to use the specified index file. - - Returns an action that will reset back to the default @@ -25,7 +28,7 @@ override index = do return $ reset res where var = "GIT_INDEX_FILE" - reset (Just v) = setEnv var v True + reset (Just v) = setEnv indexEnv v True reset _ = unsetEnv var indexFile :: Repo -> FilePath @@ -34,3 +37,19 @@ indexFile r = localGitDir r "index" {- Git locks the index by creating this file. -} indexFileLock :: Repo -> FilePath indexFileLock r = indexFile r ++ ".lock" + +{- When the pre-commit hook is run, and git commit has been run with + - a file or files specified to commit, rather than committing the staged + - index, git provides the pre-commit hook with a "false index file". + - + - Changes made to this index will influence the commit, but won't + - affect the real index file. + - + - This detects when we're in this situation, using a heuristic, which + - might be broken by changes to git. Any use of this should have a test + - case to make sure it works. + -} +haveFalseIndex :: IO Bool +haveFalseIndex = maybe (False) check <$> getEnv indexEnv + where + check f = "next-index" `isPrefixOf` takeFileName f diff --git a/Git/Repair.hs b/Git/Repair.hs index 77a592b..5731138 100644 --- a/Git/Repair.hs +++ b/Git/Repair.hs @@ -241,7 +241,7 @@ explodePackedRefsFile r = do where makeref (sha, ref) = do let dest = localGitDir r fromRef ref - createDirectoryIfMissing True (parentDir dest) + createDirectoryIfMissing True (takeDirectory dest) unlessM (doesFileExist dest) $ writeFile dest (fromRef sha) diff --git a/Git/UpdateIndex.hs b/Git/UpdateIndex.hs index ecd154a..613596d 100644 --- a/Git/UpdateIndex.hs +++ b/Git/UpdateIndex.hs @@ -19,7 +19,8 @@ module Git.UpdateIndex ( updateIndexLine, stageFile, unstageFile, - stageSymlink + stageSymlink, + stageDiffTreeItem, ) where import Common @@ -28,6 +29,7 @@ import Git.Types import Git.Command import Git.FilePath import Git.Sha +import qualified Git.DiffTreeItem as Diff {- Streamers are passed a callback and should feed it lines in the form - read by update-index, and generated by ls-tree. -} @@ -95,7 +97,10 @@ stageFile sha filetype file repo = do unstageFile :: FilePath -> Repo -> IO Streamer unstageFile file repo = do p <- toTopFilePath file repo - return $ pureStreamer $ "0 " ++ fromRef nullSha ++ "\t" ++ indexPath p + return $ unstageFile' p + +unstageFile' :: TopFilePath -> Streamer +unstageFile' p = pureStreamer $ "0 " ++ fromRef nullSha ++ "\t" ++ indexPath p {- A streamer that adds a symlink to the index. -} stageSymlink :: FilePath -> Sha -> Repo -> IO Streamer @@ -106,5 +111,11 @@ stageSymlink file sha repo = do <*> toTopFilePath file repo return $ pureStreamer line +{- A streamer that applies a DiffTreeItem to the index. -} +stageDiffTreeItem :: Diff.DiffTreeItem -> Streamer +stageDiffTreeItem d = case toBlobType (Diff.dstmode d) of + Nothing -> unstageFile' (Diff.file d) + Just t -> pureStreamer $ updateIndexLine (Diff.dstsha d) t (Diff.file d) + indexPath :: TopFilePath -> InternalGitPath indexPath = toInternalGitPath . getTopFilePath diff --git a/Git/Version.hs b/Git/Version.hs index 5c61f85..73ce2f8 100644 --- a/Git/Version.hs +++ b/Git/Version.hs @@ -5,18 +5,17 @@ - Licensed under the GNU GPL version 3 or higher. -} -module Git.Version where +module Git.Version ( + installed, + older, + normalize, + GitVersion, +) where import Common +import Utility.DottedVersion -data GitVersion = GitVersion String Integer - deriving (Eq) - -instance Ord GitVersion where - compare (GitVersion _ x) (GitVersion _ y) = compare x y - -instance Show GitVersion where - show (GitVersion s _) = s +type GitVersion = DottedVersion installed :: IO GitVersion installed = normalize . extract <$> readProcess "git" ["--version"] @@ -25,19 +24,7 @@ installed = normalize . extract <$> readProcess "git" ["--version"] [] -> "" (l:_) -> unwords $ drop 2 $ words l -{- To compare dotted versions like 1.7.7 and 1.8, they are normalized to - - a somewhat arbitrary integer representation. -} -normalize :: String -> GitVersion -normalize v = GitVersion v $ - sum $ mult 1 $ reverse $ extend precision $ take precision $ - map readi $ split "." v - where - extend n l = l ++ replicate (n - length l) 0 - mult _ [] = [] - mult n (x:xs) = (n*x) : mult (n*10^width) xs - readi :: String -> Integer - readi s = case reads s of - ((x,_):_) -> x - _ -> 0 - precision = 10 -- number of segments of the version to compare - width = length "yyyymmddhhmmss" -- maximum width of a segment +older :: String -> IO Bool +older n = do + v <- installed + return $ v < normalize n -- cgit v1.2.3