This commit is contained in:
Joey Hess 2012-02-20 15:20:36 -04:00
parent ac5cff3668
commit 6c0155efb7
4 changed files with 77 additions and 51 deletions

View file

@ -11,8 +11,9 @@ import Common
import Git
import Git.Command
import qualified Git.Version
import qualified Utility.CoProcess as CoProcess
type CheckAttrHandle = (PipeHandle, Handle, Handle, [Attr], String)
type CheckAttrHandle = (CoProcess.CoProcessHandle, [Attr], String)
type Attr = String
@ -21,11 +22,10 @@ type Attr = String
checkAttrStart :: [Attr] -> Repo -> IO CheckAttrHandle
checkAttrStart attrs repo = do
cwd <- getCurrentDirectory
(pid, from, to) <- hPipeBoth "git" $ toCommand $
h <- CoProcess.start "git" $ toCommand $
gitCommandLine params repo
fileEncoding from
fileEncoding to
return (pid, from, to, attrs, cwd)
CoProcess.query h fileEncoding fileEncoding
return (h, attrs, cwd)
where
params =
[ Param "check-attr"
@ -35,24 +35,21 @@ checkAttrStart attrs repo = do
{- Stops git check-attr. -}
checkAttrStop :: CheckAttrHandle -> IO ()
checkAttrStop (pid, from, to, _, _) = do
hClose to
hClose from
forceSuccess pid
checkAttrStop (h, _, _) = CoProcess.stop h
{- Gets an attribute of a file. -}
checkAttr :: CheckAttrHandle -> Attr -> FilePath -> IO String
checkAttr (_, from, to, attrs, cwd) want file = do
hPutStr to $ file' ++ "\0"
hFlush to
pairs <- forM attrs $ \attr -> do
l <- hGetLine from
return (attr, attrvalue attr l)
checkAttr (h, attrs, cwd) want file = do
pairs <- CoProcess.query h send receive
let vals = map snd $ filter (\(attr, _) -> attr == want) pairs
case vals of
[v] -> return v
_ -> error $ "unable to determine " ++ want ++ " attribute of " ++ file
where
send to = hPutStr to $ file' ++ "\0"
receive from = forM attrs $ \attr -> do
l <- hGetLine from
return (attr, attrvalue attr l)
{- Before git 1.7.7, git check-attr worked best with
- absolute filenames; using them worked around some bugs
- with relative filenames.