module GitHUD.Git.Command (
gitCmdLocalBranchName
, gitCmdMergeBase
, gitCmdRemoteName
, gitCmdRemoteBranchName
, gitCmdPorcelainStatus
, gitCmdRevToPush
, gitCmdRevToPull
, gitCmdStashCount
, gitCmdCommitShortSHA
, gitCmdCommitTag
, gitCmdFetch
, checkInGitDirectory
) where
import Control.Concurrent.MVar (MVar, putMVar)
import Control.Monad (void)
import GHC.IO.Handle (hGetLine)
import System.Directory (doesDirectoryExist)
import System.Exit (ExitCode(ExitSuccess))
import System.Process (readCreateProcessWithExitCode, readProcessWithExitCode, proc, StdStream(CreatePipe, UseHandle), createProcess, CreateProcess(..))
import GitHUD.Process (readProcessWithIgnoreExitCode)
import GitHUD.Git.Common
checkInGitDirectory :: IO Bool
checkInGitDirectory = do
(exCode, _, _) <- readProcessWithExitCode "git" ["rev-parse", "--git-dir"] ""
return (exCode == ExitSuccess)
gitCmdLocalBranchName :: MVar String -> IO ()
gitCmdLocalBranchName out = do
localBranch <- readProcessWithIgnoreExitCode "git" ["symbolic-ref", "--short", "HEAD"] ""
putMVar out localBranch
gitCmdMergeBase :: String
-> MVar String
-> IO ()
gitCmdMergeBase localBranchName out = do
mergeBase <- readProcessWithIgnoreExitCode "git" ["merge-base", "origin/master", localBranchName] ""
putMVar out mergeBase
gitCmdRemoteName :: String
-> MVar String
-> IO ()
gitCmdRemoteName localBranchName out = do
remoteName <- readProcessWithIgnoreExitCode "git" ["config", "--get", gitRemoteTrackingConfigKey localBranchName] ""
putMVar out remoteName
gitCmdRemoteBranchName :: String
-> MVar String
-> IO ()
gitCmdRemoteBranchName remoteName out = do
remoteBranch <- readProcessWithIgnoreExitCode "git" ["config", "--get", gitRemoteBranchConfigKey remoteName] ""
putMVar out remoteBranch
gitCmdPorcelainStatus :: MVar String -> IO ()
gitCmdPorcelainStatus out = do
porcelainStatus <- readProcessWithIgnoreExitCode "git" ["status", "--porcelain"] ""
putMVar out porcelainStatus
gitCmdRevToPush :: String
-> String
-> MVar String
-> IO ()
gitCmdRevToPush fromCommit toCommit out = do
revToPush <- readProcessWithIgnoreExitCode "git" ["rev-list", "--no-merges", "--right-only", "--count", mergeBaseDiffFromTo fromCommit toCommit] ""
putMVar out revToPush
gitCmdRevToPull :: String
-> String
-> MVar String
-> IO ()
gitCmdRevToPull fromCommit toCommit out = do
revToPull <- readProcessWithIgnoreExitCode "git" ["rev-list", "--no-merges", "--left-only", "--count", mergeBaseDiffFromTo fromCommit toCommit] ""
putMVar out revToPull
gitCmdStashCount :: MVar String
-> IO ()
gitCmdStashCount out = do
( _, Just hGitStashList, _, _) <- createProcess
(proc "git" ["stash", "list"])
{ std_out = CreatePipe }
( _, Just hCountStr, _, _) <- createProcess
(proc "wc" ["-l"])
{ std_in = UseHandle hGitStashList, std_out = CreatePipe }
count <- hGetLine hCountStr
putMVar out count
gitCmdCommitShortSHA :: MVar String
-> IO ()
gitCmdCommitShortSHA out = do
shortSHA <- readProcessWithIgnoreExitCode "git" ["rev-parse", "--short", "HEAD"] ""
putMVar out shortSHA
gitCmdCommitTag :: MVar String
-> IO ()
gitCmdCommitTag out = do
tag <- readProcessWithIgnoreExitCode "git" ["describe", "--exact-match", "--tags"] ""
putMVar out tag
gitCmdFetch :: String
-> IO ()
gitCmdFetch path = do
isDir <- doesDirectoryExist path
if isDir
then do
let fetch_proc = (proc "git" ["fetch"]) { cwd = Just path }
void $ readCreateProcessWithExitCode fetch_proc ""
else
putStrLn ("Folder" ++ path ++ " does not exist")