more robust git cat-file output parser
Only remaining ugliness is the handling of error messages for files that are not present on the branch.
This commit is contained in:
parent
8562e6096c
commit
5fe02f2807
1 changed files with 18 additions and 12 deletions
20
Branch.hs
20
Branch.hs
|
@ -243,8 +243,8 @@ catFile file = do
|
||||||
[Param "cat-file", Param "--batch"]
|
[Param "cat-file", Param "--batch"]
|
||||||
let gitcmd = join " " ("git" : toCommand cmd)
|
let gitcmd = join " " ("git" : toCommand cmd)
|
||||||
(_, from, to) <- liftIO $ hPipeBoth "sh"
|
(_, from, to) <- liftIO $ hPipeBoth "sh"
|
||||||
-- want stderr on stdin to handle error messages
|
-- want stderr on stdin to see error messages
|
||||||
["-c", "LANG=C exec " ++ gitcmd ++ " 2>&1"]
|
["-c", "exec " ++ gitcmd ++ " 2>&1"]
|
||||||
setState state { catFileHandles = Just (from, to) }
|
setState state { catFileHandles = Just (from, to) }
|
||||||
ask (from, to)
|
ask (from, to)
|
||||||
ask (from, to) = liftIO $ do
|
ask (from, to) = liftIO $ do
|
||||||
|
@ -252,16 +252,22 @@ catFile file = do
|
||||||
hPutStrLn to want
|
hPutStrLn to want
|
||||||
hFlush to
|
hFlush to
|
||||||
header <- hGetLine from
|
header <- hGetLine from
|
||||||
if header == want ++ " missing"
|
case words header of
|
||||||
then return ""
|
[sha, blob, size]
|
||||||
else do
|
| length sha == Git.shaSize &&
|
||||||
let [_sha, _type, size] = words header
|
blob == "blob" -> handle from size
|
||||||
let bytes = read size
|
| otherwise -> empty
|
||||||
|
_ -> empty
|
||||||
|
handle from size = case reads size of
|
||||||
|
[(bytes, "")] -> readcontent from bytes
|
||||||
|
_ -> empty
|
||||||
|
readcontent from bytes = do
|
||||||
content <- B.hGet from bytes
|
content <- B.hGet from bytes
|
||||||
c <- hGetChar from
|
c <- hGetChar from
|
||||||
when (c /= '\n') $
|
when (c /= '\n') $
|
||||||
error "missing newline from git cat-file"
|
error "missing newline from git cat-file"
|
||||||
return $ B.unpack content
|
return $ B.unpack content
|
||||||
|
empty = return ""
|
||||||
|
|
||||||
{- Lists all files on the branch. There may be duplicates in the list. -}
|
{- Lists all files on the branch. There may be duplicates in the list. -}
|
||||||
files :: Annex [FilePath]
|
files :: Annex [FilePath]
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue