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