git subcommand cleanup
Pass subcommand as a regular param, which allows passing git parameters like -c before it. This was already done in the pipeing set of functions, but not the command running set.
This commit is contained in:
parent
3a783b4a3a
commit
0c13d3065e
20 changed files with 95 additions and 76 deletions
|
@ -73,8 +73,7 @@ fastForward branch (first:rest) repo =
|
|||
where
|
||||
no_ff = return False
|
||||
do_ff to = do
|
||||
run "update-ref"
|
||||
[Param $ show branch, Param $ show to] repo
|
||||
run [Param "update-ref", Param $ show branch, Param $ show to] repo
|
||||
return True
|
||||
findbest c [] = return $ Just c
|
||||
findbest c (r:rs)
|
||||
|
@ -97,7 +96,7 @@ commit message branch parentrefs repo = do
|
|||
sha <- getSha "commit-tree" $ pipeWriteRead
|
||||
(map Param $ ["commit-tree", show tree] ++ ps)
|
||||
message repo
|
||||
run "update-ref" [Param $ show branch, Param $ show sha] repo
|
||||
run [Param "update-ref", Param $ show branch, Param $ show sha] repo
|
||||
return sha
|
||||
where
|
||||
ps = concatMap (\r -> ["-p", show r]) parentrefs
|
||||
|
|
|
@ -25,25 +25,25 @@ gitCommandLine params Repo { location = l@(Local _ _ ) } = setdir : settree ++ p
|
|||
gitCommandLine _ repo = assertLocal repo $ error "internal"
|
||||
|
||||
{- Runs git in the specified repo. -}
|
||||
runBool :: String -> [CommandParam] -> Repo -> IO Bool
|
||||
runBool subcommand params repo = assertLocal repo $
|
||||
runBool :: [CommandParam] -> Repo -> IO Bool
|
||||
runBool params repo = assertLocal repo $
|
||||
boolSystemEnv "git"
|
||||
(gitCommandLine (Param subcommand : params) repo)
|
||||
(gitCommandLine params repo)
|
||||
(gitEnv repo)
|
||||
|
||||
{- Runs git in the specified repo, throwing an error if it fails. -}
|
||||
run :: String -> [CommandParam] -> Repo -> IO ()
|
||||
run subcommand params repo = assertLocal repo $
|
||||
unlessM (runBool subcommand params repo) $
|
||||
error $ "git " ++ subcommand ++ " " ++ show params ++ " failed"
|
||||
run :: [CommandParam] -> Repo -> IO ()
|
||||
run params repo = assertLocal repo $
|
||||
unlessM (runBool params repo) $
|
||||
error $ "git " ++ show params ++ " failed"
|
||||
|
||||
{- Runs git and forces it to be quiet, throwing an error if it fails. -}
|
||||
runQuiet :: String -> [CommandParam] -> Repo -> IO ()
|
||||
runQuiet subcommand params repo = withQuietOutput createProcessSuccess $
|
||||
(proc "git" $ toCommand $ gitCommandLine (Param subcommand : params) repo)
|
||||
runQuiet :: [CommandParam] -> Repo -> IO ()
|
||||
runQuiet params repo = withQuietOutput createProcessSuccess $
|
||||
(proc "git" $ toCommand $ gitCommandLine (params) repo)
|
||||
{ env = gitEnv repo }
|
||||
|
||||
{- Runs a git subcommand and returns its output, lazily.
|
||||
{- Runs a git command and returns its output, lazily.
|
||||
-
|
||||
- Also returns an action that should be used when the output is all
|
||||
- read (or no more is needed), that will wait on the command, and
|
||||
|
@ -58,7 +58,7 @@ pipeReadLazy params repo = assertLocal repo $ do
|
|||
where
|
||||
p = gitCreateProcess params repo
|
||||
|
||||
{- Runs a git subcommand, and returns its output, strictly.
|
||||
{- Runs a git command, and returns its output, strictly.
|
||||
-
|
||||
- Nonzero exit status is ignored.
|
||||
-}
|
||||
|
@ -72,7 +72,7 @@ pipeReadStrict params repo = assertLocal repo $
|
|||
where
|
||||
p = gitCreateProcess params repo
|
||||
|
||||
{- Runs a git subcommand, feeding it input, and returning its output,
|
||||
{- Runs a git command, feeding it input, and returning its output,
|
||||
- which is expected to be fairly small, since it's all read into memory
|
||||
- strictly. -}
|
||||
pipeWriteRead :: [CommandParam] -> String -> Repo -> IO String
|
||||
|
@ -80,7 +80,7 @@ pipeWriteRead params s repo = assertLocal repo $
|
|||
writeReadProcessEnv "git" (toCommand $ gitCommandLine params repo)
|
||||
(gitEnv repo) s (Just fileEncoding)
|
||||
|
||||
{- Runs a git subcommand, feeding it input on a handle with an action. -}
|
||||
{- Runs a git command, feeding it input on a handle with an action. -}
|
||||
pipeWrite :: [CommandParam] -> Repo -> (Handle -> IO ()) -> IO ()
|
||||
pipeWrite params repo = withHandle StdinHandle createProcessSuccess $
|
||||
gitCreateProcess params repo
|
||||
|
|
|
@ -15,5 +15,7 @@ import Git.Version
|
|||
{- Avoids recent git's interactive merge. -}
|
||||
mergeNonInteractive :: Ref -> Repo -> IO Bool
|
||||
mergeNonInteractive branch
|
||||
| older "1.7.7.6" = runBool "merge" [Param $ show branch]
|
||||
| otherwise = runBool "merge" [Param "--no-edit", Param $ show branch]
|
||||
| older "1.7.7.6" = merge [Param $ show branch]
|
||||
| otherwise = merge [Param "--no-edit", Param $ show branch]
|
||||
where
|
||||
merge ps = runBool $ Param "merge" : ps
|
||||
|
|
|
@ -34,8 +34,8 @@ under dir r = Ref $ dir </> show (base r)
|
|||
|
||||
{- Checks if a ref exists. -}
|
||||
exists :: Ref -> Repo -> IO Bool
|
||||
exists ref = runBool "show-ref"
|
||||
[Param "--verify", Param "-q", Param $ show ref]
|
||||
exists ref = runBool
|
||||
[Param "show-ref", Param "show-ref", Param "--verify", Param "-q", Param $ show ref]
|
||||
|
||||
{- Checks if HEAD exists. It generally will, except for in a repository
|
||||
- that was just created. -}
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue