module VCSWrapper.Git (
initDB
, add
, rm
, commit
, checkout
, status
, simpleLog
, localBranches
, revparse
, remote
, pull
, push
, runVcs
, module VCSWrapper.Git.Types
) where
import System.Directory
import Control.Monad.Trans
import qualified Control.Exception as Exc
import Data.List.Utils
import VCSWrapper.Git.Parsers
import VCSWrapper.Git.Process
import VCSWrapper.Git.Types
import VCSWrapper.Common.VCSMonad (runVcs)
import Data.Maybe
import qualified Data.List
import Data.String.Utils (strip)
initDB :: Bool
-> Ctx ()
initDB bare = do
let opts = if bare then ["--bare"] else []
gitExecWithoutResult "init-db" opts []
add :: [ FilePath ]
-> Ctx ()
add paths = do
let opts = "--" : paths
gitExecWithoutResult "add" opts []
rm :: [ FilePath ]
-> Ctx ()
rm paths = do
let opts = "--" : paths
gitExecWithoutResult "rm" opts []
commit :: [ FilePath ]
-> Maybe (String, String)
-> String
-> [String]
-> Ctx ()
commit rsrcs mbAuthor logmsg extraopts = do
case mbAuthor of
Just (author, author_email) ->
commit' rsrcs logmsg extraopts ["--author", author ++ " <" ++ author_email ++ ">"]
Nothing ->
commit' rsrcs logmsg extraopts []
where
commit' files logmsg extraopts authopts = do
let msgopts = [ "-m", logmsg ]
let opts = authopts ++ msgopts ++ extraopts ++ [ "--" ] ++ files
gitExecWithoutResult "commit" opts []
checkout :: Maybe String
-> Maybe String
-> Ctx ()
checkout rev branch = do
let bopt = maybe [] (\b -> [ "-b", b ]) branch
let copt = maybeToList rev
gitExecWithoutResult "checkout" (bopt ++ copt) []
status :: Ctx [Status]
status = do
o <- gitExec "status" ["--porcelain"] []
return $ parseStatus o
simpleLog :: Maybe String
-> Ctx [LogEntry]
simpleLog mbBranch = do
o <- gitExec "log" ((branch mbBranch) ++ ["--pretty=tformat:commit:%H%n%an%n%ae%n%ai%n%s%n%b%x00", "--"]) []
return $ parseSimpleLog o
where
branch Nothing = []
branch (Just b) = [b]
localBranches :: Ctx (String, [String])
localBranches = do
o <- gitExec "branch" [] []
return $ parseBranches o
remote :: Ctx [String]
remote = do
o <- gitExec "remote" [] []
return $ parseRemotes o
push :: Ctx ()
push = gitExecWithoutResult "push" [] []
pull :: Ctx (Either String ())
pull = do
o <- gitExec' "pull" [] []
case o of
Right _ -> return $ Right ()
Left exc@(VCSException _ out _ _ _) -> if (parsePullMergeConflict out) then return $ Left out
else Exc.throw exc
revparse :: String
-> Ctx (String)
revparse commit = do
o <- gitExec "rev-parse" [commit] []
return $ strip o