module VCSWrapper.Mercurial (
addremove
,commit
,pull
,push
,simpleLog
,update
,status
,runVcs
,module VCSWrapper.Mercurial.Types
) where
import VCSWrapper.Mercurial.Process
import VCSWrapper.Mercurial.Parsers
import VCSWrapper.Mercurial.Types
import VCSWrapper.Common.TemporaryFiles
import VCSWrapper.Common.VCSMonad (runVcs)
import System.IO
import Control.Monad.Reader
import Data.Maybe
import Data.Text (Text)
import qualified Data.Text as T (unpack, pack)
addremove :: [FilePath]
-> Ctx ()
addremove files = hgExecNoEnv "addremove" (map T.pack files)
checkout :: Maybe Text
-> [Text]
-> Ctx ()
checkout mbChangeset options = hgExecNoEnv "checkout" opts
where
changeSet = [fromMaybe "" mbChangeset]
opts = options++changeSet
commit :: [FilePath]
-> Text
-> [Text]
-> Ctx ()
commit filesToCommit logMsg options = hgExecNoEnv "commit" opts
where
msgOpt = [ "--message", logMsg ]
opts = msgOpt ++ options ++ (map T.pack filesToCommit)
localBranches :: Ctx (Text, [Text])
localBranches = do
currentBranch <- hgExec "branch" [] []
o <- hgExec "branches" ["-q"] []
let otherBranches = filter (\b -> not $ b == currentBranch) $ parseBranches o
return (currentBranch, otherBranches)
pull :: Ctx ()
pull = do
hgExecNoEnv "pull" []
hgExecNoEnv "update" []
push :: Ctx ()
push = do
hgExecNoEnv "push" []
simpleLog :: Maybe Text
-> Ctx[LogEntry]
simpleLog mbRev = do
o <- hgExec "log" opts []
logEntries <- liftIO $ withTempFile "log.xml" (parseLog o)
return logEntries
where
rev Nothing = [""]
rev (Just revision) = ["-r",revision]
opts = ["--style", "xml"] ++ (rev mbRev)
parseLog out path handle = do
hPutStrLn handle (T.unpack out)
hClose handle
parseLogFile path
status :: Ctx [Status]
status = do
o <- hgExec "status" [] []
return $ parseStatusOut o
update :: Maybe Text
-> Ctx ()
update mbRev = hgExecNoEnv "update" opts
where
rev Nothing = [""]
rev (Just revision) = ["-r",revision]
opts = rev mbRev