diff options
author | 2011-06-21 17:39:45 -0400 | |
---|---|---|
committer | 2011-06-21 17:52:39 -0400 | |
commit | 40ec8a9726586f24357a5ae2057a092a971c1046 (patch) | |
tree | 3da8a6b99fe58f3405fcfb117050b5821fbc0041 /GitRepo.hs | |
parent | 7e7428f173ba1b72b4de69fd482f44161ee84420 (diff) |
Branch module complete
Refactored some code that it needs into GitRepo.
Diffstat (limited to 'GitRepo.hs')
-rw-r--r-- | GitRepo.hs | 50 |
1 files changed, 41 insertions, 9 deletions
diff --git a/GitRepo.hs b/GitRepo.hs index 11511f77d..91ddf6dca 100644 --- a/GitRepo.hs +++ b/GitRepo.hs @@ -58,12 +58,16 @@ module GitRepo ( typeChangedStagedFiles, repoAbsPath, reap, - withIndex, + useIndex, + useDefaultIndex, + hashObject, + getSha, + shaSize, prop_idempotent_deencode ) where -import Control.Monad (unless) +import Control.Monad (unless, when) import System.Directory import System.FilePath import System.Posix.Directory @@ -381,13 +385,41 @@ reap = do r <- catch (getAnyProcessStatus False True) (\_ -> return Nothing) maybe (return ()) (const reap) r -{- Runs an action using a specified index file. -} -withIndex :: FilePath -> IO a -> IO a -withIndex index a = do - setEnv "GIT_INDEX_FILE" index True - r <- a - unsetEnv "GIT_INDEX_FILE" - return r +{- Forces git to use the specified index file. -} +useIndex :: FilePath -> IO () +useIndex index = setEnv "GIT_INDEX_FILE" index True + +{- Undoes useIndex -} +useDefaultIndex :: IO () +useDefaultIndex = unsetEnv "GIT_INDEX_FILE" + +{- Injects some content into git, returning its hash. -} +hashObject :: Repo -> String -> IO String +hashObject repo content = getSha subcmd $ do + (h, s) <- pipeWriteRead repo (map Param params) content + length s `seq` do + forceSuccess h + reap -- XXX unsure why this is needed + return s + where + subcmd = "hash-object" + params = [subcmd, "-w", "--stdin"] + +{- Runs an action that causes a git subcommand to emit a sha, and strips + any trailing newline, returning the sha. -} +getSha :: String -> IO String -> IO String +getSha subcommand a = do + t <- a + let t' = if last t == '\n' + then take (length t - 1) t + else t + when (length t' /= shaSize) $ + error $ "failed to read sha from git " ++ subcommand ++ " (" ++ t' ++ ")" + return t' + +{- Size of a git sha. -} +shaSize :: Int +shaSize = 40 {- Scans for files that are checked into git at the specified locations. -} inRepo :: Repo -> [FilePath] -> IO [FilePath] |