refactor
This commit is contained in:
parent
ac5cff3668
commit
6c0155efb7
4 changed files with 77 additions and 51 deletions
|
@ -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.
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue