diff options
Diffstat (limited to 'Git/CatFile.hs')
| -rw-r--r-- | Git/CatFile.hs | 81 |
1 files changed, 41 insertions, 40 deletions
diff --git a/Git/CatFile.hs b/Git/CatFile.hs index 46b59c631..aee6bd19f 100644 --- a/Git/CatFile.hs +++ b/Git/CatFile.hs @@ -8,8 +8,10 @@ module Git.CatFile ( CatFileHandle, catFileStart, + catFileStart', catFileStop, catFile, + catTree, catObject, catObjectDetails, ) where @@ -17,9 +19,9 @@ module Git.CatFile ( import System.IO import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L -import Data.Digest.Pure.SHA -import Data.Char -import System.Process (std_out, std_err) +import Data.Tuple.Utils +import Numeric +import System.Posix.Types import Common import Git @@ -32,8 +34,11 @@ import qualified Utility.CoProcess as CoProcess data CatFileHandle = CatFileHandle CoProcess.CoProcessHandle Repo catFileStart :: Repo -> IO CatFileHandle -catFileStart repo = do - coprocess <- CoProcess.rawMode =<< gitCoProcessStart True +catFileStart = catFileStart' True + +catFileStart' :: Bool -> Repo -> IO CatFileHandle +catFileStart' restartable repo = do + coprocess <- CoProcess.rawMode =<< gitCoProcessStart restartable [ Param "cat-file" , Param "--batch" ] repo @@ -50,11 +55,10 @@ catFile h branch file = catObject h $ Ref $ {- Uses a running git cat-file read the content of an object. - Objects that do not exist will have "" returned. -} catObject :: CatFileHandle -> Ref -> IO L.ByteString -catObject h object = maybe L.empty fst <$> catObjectDetails h object +catObject h object = maybe L.empty fst3 <$> catObjectDetails h object -{- Gets both the content of an object, and its Sha. -} -catObjectDetails :: CatFileHandle -> Ref -> IO (Maybe (L.ByteString, Sha)) -catObjectDetails (CatFileHandle hdl repo) object = CoProcess.query hdl send receive +catObjectDetails :: CatFileHandle -> Ref -> IO (Maybe (L.ByteString, Sha, ObjectType)) +catObjectDetails (CatFileHandle hdl _) object = CoProcess.query hdl send receive where query = show object send to = hPutStrLn to query @@ -62,46 +66,43 @@ catObjectDetails (CatFileHandle hdl repo) object = CoProcess.query hdl send rece header <- hGetLine from case words header of [sha, objtype, size] - | length sha == shaSize && - isJust (readObjectType objtype) -> - case reads size of - [(bytes, "")] -> readcontent bytes from sha + | length sha == shaSize -> + case (readObjectType objtype, reads size) of + (Just t, [(bytes, "")]) -> readcontent t bytes from sha _ -> dne | otherwise -> dne _ | header == show object ++ " missing" -> dne - | otherwise -> - if any isSpace query - then fallback - else error $ "unknown response from git cat-file " ++ show (header, object) - readcontent bytes from sha = do + | otherwise -> error $ "unknown response from git cat-file " ++ show (header, object) + readcontent objtype bytes from sha = do content <- S.hGet from bytes eatchar '\n' from - return $ Just (L.fromChunks [content], Ref sha) + return $ Just (L.fromChunks [content], Ref sha, objtype) dne = return Nothing eatchar expected from = do c <- hGetChar from when (c /= expected) $ error $ "missing " ++ (show expected) ++ " from git cat-file" - {- Work around a bug in git 1.8.4 rc0 which broke it for filenames - - containing spaces. http://bugs.debian.org/718517 - - Slow! Also can use a lot of memory, if the object is large. -} - fallback = do - let p = gitCreateProcess - [ Param "cat-file" - , Param "-p" - , Param query - ] repo - (_, Just h, _, pid) <- withNullHandle $ \h -> - createProcess p - { std_out = CreatePipe - , std_err = UseHandle h - } - fileEncoding h - content <- L.hGetContents h - let sha = (\s -> length s `seq` s) (showDigest $ sha1 content) - ok <- checkSuccessProcess pid - return $ if ok - then Just (content, Ref sha) - else Nothing +{- Gets a list of files and directories in a tree. (Not recursive.) -} +catTree :: CatFileHandle -> Ref -> IO [(FilePath, FileMode)] +catTree h treeref = go <$> catObjectDetails h treeref + where + go (Just (b, _, TreeObject)) = parsetree [] b + go _ = [] + + parsetree c b = case L.break (== 0) b of + (modefile, rest) + | L.null modefile -> c + | otherwise -> parsetree + (parsemodefile modefile:c) + (dropsha rest) + + -- these 20 bytes after the NUL hold the file's sha + -- TODO: convert from raw form to regular sha + dropsha = L.drop 21 + + parsemodefile b = + let (modestr, file) = separate (== ' ') (encodeW8 $ L.unpack b) + in (file, readmode modestr) + readmode = fst . fromMaybe (0, undefined) . headMaybe . readOct |