d7021d420f
This fixes a crash when a git submodule has a name starting with a dot. Such a submodule might contain dotfiles that are intended to be used when inside the view (since a dot-directory that's not a submodule was already preserved when entering a view). So, rather than eliminating the submodule from the view, its git ls-files --stage hash is copied over into the view. dotfiles/dirs have their git ls-files --stage hashes similarly copied over to the view. This is more efficient and simpler than the old method, and also won't break if git ever adds a new type of tree item, like was done with submodules. Since the content of dotfiles in the working tree is no longer hashed when entering a view, when there are unstaged modifications, they are not included in the view branch. Entering the view branch still works, but git checkout shows "M .dotfile", and git diff will show the unstaged changes. This seems like an improvement over the old behavior. Also made Command.View not delete empty directories that are submodules when entering a view, while still deleting other empty directories. This commit was supported by the NSF-funded DataLad project.
268 lines
8 KiB
Haskell
268 lines
8 KiB
Haskell
{- git ls-files interface
|
|
-
|
|
- Copyright 2010-2018 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
module Git.LsFiles (
|
|
inRepo,
|
|
notInRepo,
|
|
notInRepoIncludingEmptyDirectories,
|
|
allFiles,
|
|
deleted,
|
|
modified,
|
|
modifiedOthers,
|
|
staged,
|
|
stagedNotDeleted,
|
|
stagedOthersDetails,
|
|
stagedDetails,
|
|
typeChanged,
|
|
typeChangedStaged,
|
|
Conflicting(..),
|
|
Unmerged(..),
|
|
unmerged,
|
|
StagedDetails,
|
|
) where
|
|
|
|
import Common
|
|
import Git
|
|
import Git.Command
|
|
import Git.Types
|
|
import Git.Sha
|
|
|
|
import Numeric
|
|
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 $
|
|
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 = notInRepo' []
|
|
|
|
notInRepo' :: [CommandParam] -> Bool -> [FilePath] -> Repo -> IO ([FilePath], IO Bool)
|
|
notInRepo' ps include_ignored l repo = pipeNullSplit params repo
|
|
where
|
|
params = concat
|
|
[ [ Param "ls-files", Param "--others"]
|
|
, ps
|
|
, exclude
|
|
, [ Param "-z", Param "--" ]
|
|
, map File l
|
|
]
|
|
exclude
|
|
| include_ignored = []
|
|
| otherwise = [Param "--exclude-standard"]
|
|
|
|
{- Scans for files at the specified locations that are not checked into
|
|
- git. Empty directories are included in the result. -}
|
|
notInRepoIncludingEmptyDirectories :: Bool -> [FilePath] -> Repo -> IO ([FilePath], IO Bool)
|
|
notInRepoIncludingEmptyDirectories = notInRepo' [Param "--directory"]
|
|
|
|
{- Finds all files in the specified locations, whether checked into git or
|
|
- not. -}
|
|
allFiles :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
|
|
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 =
|
|
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 =
|
|
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 =
|
|
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)
|
|
staged = staged' []
|
|
|
|
{- Returns a list of the files, staged for commit, that are being added,
|
|
- moved, or changed (but not deleted), from the specified locations. -}
|
|
stagedNotDeleted :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
|
|
stagedNotDeleted = staged' [Param "--diff-filter=ACMRT"]
|
|
|
|
staged' :: [CommandParam] -> [FilePath] -> Repo -> IO ([FilePath], IO Bool)
|
|
staged' ps l = pipeNullSplit $ prefix ++ ps ++ suffix
|
|
where
|
|
prefix = [Param "diff", Param "--cached", Param "--name-only", Param "-z"]
|
|
suffix = Param "--" : map File l
|
|
|
|
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' [Param "--others", Param "--exclude-standard"]
|
|
|
|
{- Returns details about all files that are staged in the index. -}
|
|
stagedDetails :: [FilePath] -> Repo -> IO ([StagedDetails], IO Bool)
|
|
stagedDetails = stagedDetails' []
|
|
|
|
{- Gets details about staged files, including the Sha of their staged
|
|
- contents. -}
|
|
stagedDetails' :: [CommandParam] -> [FilePath] -> Repo -> IO ([StagedDetails], IO Bool)
|
|
stagedDetails' ps l repo = do
|
|
(ls, cleanup) <- pipeNullSplit params repo
|
|
return (map parse ls, cleanup)
|
|
where
|
|
params = Param "ls-files" : Param "--stage" : Param "-z" : ps ++
|
|
Param "--" : map File l
|
|
parse s
|
|
| null file = (s, Nothing, Nothing)
|
|
| otherwise = (file, extractSha $ take shaSize rest, readmode mode)
|
|
where
|
|
(metadata, file) = separate (== '\t') s
|
|
(mode, rest) = separate (== ' ') metadata
|
|
readmode = fst <$$> headMaybe . readOct
|
|
|
|
{- Returns a list of the files in the specified locations that are staged
|
|
- for commit, and whose type has changed. -}
|
|
typeChangedStaged :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
|
|
typeChangedStaged = typeChanged' [Param "--cached"]
|
|
|
|
{- Returns a list of the files in the specified locations whose type has
|
|
- changed. Files only staged for commit will not be included. -}
|
|
typeChanged :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
|
|
typeChanged = typeChanged' []
|
|
|
|
typeChanged' :: [CommandParam] -> [FilePath] -> Repo -> IO ([FilePath], IO Bool)
|
|
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.
|
|
top <- absPath (repoPath repo)
|
|
currdir <- getCurrentDirectory
|
|
return (map (\f -> relPathDirToFileAbs currdir $ top </> f) fs, cleanup)
|
|
where
|
|
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.
|
|
- Either can be Nothing, when that side deleted the file. -}
|
|
data Conflicting v = Conflicting
|
|
{ valUs :: Maybe v
|
|
, valThem :: Maybe v
|
|
} deriving (Show)
|
|
|
|
data Unmerged = Unmerged
|
|
{ unmergedFile :: FilePath
|
|
, unmergedTreeItemType :: Conflicting TreeItemType
|
|
, unmergedSha :: Conflicting Sha
|
|
}
|
|
|
|
{- Returns a list of the files in the specified locations that have
|
|
- unresolved merge conflicts.
|
|
-
|
|
- ls-files outputs multiple lines per conflicting file, each with its own
|
|
- stage number:
|
|
- 1 = old version, can be ignored
|
|
- 2 = us
|
|
- 3 = them
|
|
- If a line is omitted, that side removed the file.
|
|
-}
|
|
unmerged :: [FilePath] -> Repo -> IO ([Unmerged], IO Bool)
|
|
unmerged l repo = do
|
|
(fs, cleanup) <- pipeNullSplit params repo
|
|
return (reduceUnmerged [] $ catMaybes $ map parseUnmerged fs, cleanup)
|
|
where
|
|
params =
|
|
Param "ls-files" :
|
|
Param "--unmerged" :
|
|
Param "-z" :
|
|
Param "--" :
|
|
map File l
|
|
|
|
data InternalUnmerged = InternalUnmerged
|
|
{ isus :: Bool
|
|
, ifile :: FilePath
|
|
, itreeitemtype :: Maybe TreeItemType
|
|
, isha :: Maybe Sha
|
|
}
|
|
|
|
parseUnmerged :: String -> Maybe InternalUnmerged
|
|
parseUnmerged s
|
|
| null file = Nothing
|
|
| otherwise = case words metadata of
|
|
(rawtreeitemtype:rawsha:rawstage:_) -> do
|
|
stage <- readish rawstage :: Maybe Int
|
|
if stage /= 2 && stage /= 3
|
|
then Nothing
|
|
else do
|
|
treeitemtype <- readTreeItemType rawtreeitemtype
|
|
sha <- extractSha rawsha
|
|
return $ InternalUnmerged (stage == 2) file
|
|
(Just treeitemtype) (Just sha)
|
|
_ -> Nothing
|
|
where
|
|
(metadata, file) = separate (== '\t') s
|
|
|
|
reduceUnmerged :: [Unmerged] -> [InternalUnmerged] -> [Unmerged]
|
|
reduceUnmerged c [] = c
|
|
reduceUnmerged c (i:is) = reduceUnmerged (new:c) rest
|
|
where
|
|
(rest, sibi) = findsib i is
|
|
(treeitemtypeA, treeitemtypeB, shaA, shaB)
|
|
| isus i = (itreeitemtype i, itreeitemtype sibi, isha i, isha sibi)
|
|
| otherwise = (itreeitemtype sibi, itreeitemtype i, isha sibi, isha i)
|
|
new = Unmerged
|
|
{ unmergedFile = ifile i
|
|
, unmergedTreeItemType = Conflicting treeitemtypeA treeitemtypeB
|
|
, unmergedSha = Conflicting shaA shaB
|
|
}
|
|
findsib templatei [] = ([], removed templatei)
|
|
findsib templatei (l:ls)
|
|
| ifile l == ifile templatei = (ls, l)
|
|
| otherwise = (l:ls, removed templatei)
|
|
removed templatei = templatei
|
|
{ isus = not (isus templatei)
|
|
, itreeitemtype = Nothing
|
|
, isha = Nothing
|
|
}
|