From ef28b3fef7e236d8c27ce35308c0e37ece58d20c Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 14 Dec 2011 15:56:11 -0400 Subject: split out Git/Command.hs --- Git.hs | 78 ------------------------------------------------------------------ 1 file changed, 78 deletions(-) (limited to 'Git.hs') diff --git a/Git.hs b/Git.hs index a3f2ad74c..9420810a6 100644 --- a/Git.hs +++ b/Git.hs @@ -23,22 +23,12 @@ module Git ( workTree, gitDir, configTrue, - gitCommandLine, - run, - runBool, - pipeRead, - pipeWrite, - pipeWriteRead, - pipeNullSplit, - pipeNullSplitB, attributes, - reap, assertLocal, ) where import qualified Data.Map as M import Data.Char -import qualified Data.ByteString.Lazy.Char8 as L import Network.URI (uriPath, uriScheme) import Common @@ -121,74 +111,6 @@ workTree Repo { location = Url u } = uriPath u workTree Repo { location = Dir d } = d workTree Repo { location = Unknown } = undefined -{- Constructs a git command line operating on the specified repo. -} -gitCommandLine :: [CommandParam] -> Repo -> [CommandParam] -gitCommandLine params repo@(Repo { location = Dir _ } ) = - -- force use of specified repo via --git-dir and --work-tree - [ Param ("--git-dir=" ++ gitDir repo) - , Param ("--work-tree=" ++ workTree repo) - ] ++ params -gitCommandLine _ repo = assertLocal repo $ error "internal" - -{- Runs git in the specified repo. -} -runBool :: String -> [CommandParam] -> Repo -> IO Bool -runBool subcommand params repo = assertLocal repo $ - boolSystem "git" $ gitCommandLine (Param subcommand : params) repo - -{- Runs git in the specified repo, throwing an error if it fails. -} -run :: String -> [CommandParam] -> Repo -> IO () -run subcommand params repo = assertLocal repo $ - runBool subcommand params repo - >>! error $ "git " ++ show params ++ " failed" - -{- Runs a git subcommand and returns its output, lazily. - - - - Note that this leaves the git process running, and so zombies will - - result unless reap is called. - -} -pipeRead :: [CommandParam] -> Repo -> IO L.ByteString -pipeRead params repo = assertLocal repo $ do - (_, h) <- hPipeFrom "git" $ toCommand $ gitCommandLine params repo - hSetBinaryMode h True - L.hGetContents h - -{- Runs a git subcommand, feeding it input. - - You should call either getProcessStatus or forceSuccess on the PipeHandle. -} -pipeWrite :: [CommandParam] -> L.ByteString -> Repo -> IO PipeHandle -pipeWrite params s repo = assertLocal repo $ do - (p, h) <- hPipeTo "git" (toCommand $ gitCommandLine params repo) - L.hPut h s - hClose h - return p - -{- Runs a git subcommand, feeding it input, and returning its output. - - You should call either getProcessStatus or forceSuccess on the PipeHandle. -} -pipeWriteRead :: [CommandParam] -> L.ByteString -> Repo -> IO (PipeHandle, L.ByteString) -pipeWriteRead params s repo = assertLocal repo $ do - (p, from, to) <- hPipeBoth "git" (toCommand $ gitCommandLine params repo) - hSetBinaryMode from True - L.hPut to s - hClose to - c <- L.hGetContents from - return (p, c) - -{- Reads null terminated output of a git command (as enabled by the -z - - parameter), and splits it. -} -pipeNullSplit :: [CommandParam] -> Repo -> IO [String] -pipeNullSplit params repo = map L.unpack <$> pipeNullSplitB params repo - -{- For when Strings are not needed. -} -pipeNullSplitB ::[CommandParam] -> Repo -> IO [L.ByteString] -pipeNullSplitB params repo = filter (not . L.null) . L.split '\0' <$> - pipeRead params repo - -{- Reaps any zombie git processes. -} -reap :: IO () -reap = do - -- throws an exception when there are no child processes - r <- catchDefaultIO (getAnyProcessStatus False True) Nothing - maybe (return ()) (const reap) r - {- Checks if a string from git config is a true value. -} configTrue :: String -> Bool configTrue s = map toLower s == "true" -- cgit v1.2.3