remove Params constructor from Utility.SafeCommand
This removes a bit of complexity, and should make things faster (avoids tokenizing Params string), and probably involve less garbage collection. In a few places, it was useful to use Params to avoid needing a list, but that is easily avoided. Problems noticed while doing this conversion: * Some uses of Params "oneword" which was entirely unnecessary overhead. * A few places that built up a list of parameters with ++ and then used Params to split it! Test suite passes.
This commit is contained in:
parent
8f4860df13
commit
eb33569f9d
26 changed files with 221 additions and 118 deletions
|
@ -30,7 +30,8 @@ checkAttrStart attrs repo = do
|
|||
where
|
||||
params =
|
||||
[ Param "check-attr"
|
||||
, Params "-z --stdin"
|
||||
, Param "-z"
|
||||
, Param "--stdin"
|
||||
] ++ map Param attrs ++
|
||||
[ Param "--" ]
|
||||
|
||||
|
|
|
@ -43,7 +43,10 @@ checkIgnoreStart repo = ifM supportedGitVersion
|
|||
where
|
||||
params =
|
||||
[ Param "check-ignore"
|
||||
, Params "-z --stdin --verbose --non-matching"
|
||||
, Param "-z"
|
||||
, Param "--stdin"
|
||||
, Param "--verbose"
|
||||
, Param "--non-matching"
|
||||
]
|
||||
repo' = repo { gitGlobalOpts = filter (not . pathspecs) (gitGlobalOpts repo) }
|
||||
pathspecs (Param "--literal-pathspecs") = True
|
||||
|
|
|
@ -78,7 +78,13 @@ getdiff command params repo = do
|
|||
(diff, cleanup) <- pipeNullSplit ps repo
|
||||
return (parseDiffRaw diff, cleanup)
|
||||
where
|
||||
ps = command : Params "-z --raw --no-renames -l0" : params
|
||||
ps =
|
||||
command :
|
||||
Param "-z" :
|
||||
Param "--raw" :
|
||||
Param "--no-renames" :
|
||||
Param "-l0" :
|
||||
params
|
||||
|
||||
{- Parses --raw output used by diff-tree and git-log. -}
|
||||
parseDiffRaw :: [String] -> [DiffTreeItem]
|
||||
|
|
|
@ -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)
|
||||
|
@ -135,7 +167,12 @@ typeChanged' ps l repo = do
|
|||
currdir <- getCurrentDirectory
|
||||
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
|
||||
|
|
|
@ -37,13 +37,26 @@ lsTree t repo = map parseLsTree
|
|||
<$> pipeNullSplitZombie (lsTreeParams t) repo
|
||||
|
||||
lsTreeParams :: Ref -> [CommandParam]
|
||||
lsTreeParams t = [ Params "ls-tree --full-tree -z -r --", File $ fromRef t ]
|
||||
lsTreeParams t =
|
||||
[ Param "ls-tree"
|
||||
, Param "--full-tree"
|
||||
, Param "-z"
|
||||
, Param "-r"
|
||||
, Param "--"
|
||||
, File $ fromRef t
|
||||
]
|
||||
|
||||
{- 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.) -}
|
||||
|
|
|
@ -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" ]
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue