module Git
( listBranches
, checkout
, toBranches
, Branch(..)
)
where
import System.Process
import Data.List
import Data.Char ( isSpace )
import System.Exit
data Branch = BranchLocal String
| BranchCurrent String
| BranchRemote String String
deriving Eq
instance (Show Branch) where
show (BranchLocal n ) = n
show (BranchCurrent n ) = n <> "*"
show (BranchRemote o n) = o <> "/" <> n
listBranches :: IO [Branch]
listBranches = toBranches <$> execGitBranch
where
execGitBranch = readProcess
"git"
[ "branch"
, "--list"
, "--all"
, "--sort=-committerdate"
, "--no-column"
, "--no-color"
]
[]
toBranches :: String -> [Branch]
toBranches input = toBranch <$> filter (not . isHead) (lines input)
toBranch :: String -> Branch
toBranch line = toBranch' $ words $ dropWhile isSpace line
where
toBranch' ("*" : name : _) = BranchCurrent name
toBranch' (name : _) = case stripPrefix "remotes/" name of
Just rest -> parseRemoteBranch rest
Nothing -> BranchLocal name
toBranch' [] = error "empty branch name"
checkout :: Branch -> IO (Either String String)
checkout branch = toEither <$> execGitCheckout (branchName branch)
where
execGitCheckout name = readProcessWithExitCode "git" ["checkout", name] []
toEither (ExitSuccess , stdout, _ ) = Right $ dropWhile isSpace stdout
toEither (ExitFailure _, _ , stderr) = Left $ dropWhile isSpace stderr
parseRemoteBranch :: String -> Branch
parseRemoteBranch str = BranchRemote remote name
where (remote, _ : name) = span ('/' /=) str
branchName :: Branch -> String
branchName (BranchCurrent n ) = n
branchName (BranchLocal n ) = n
branchName (BranchRemote _ n) = n
isHead :: String -> Bool
isHead name = isInfixOf "HEAD" name