refactor

Git/CheckAttr.hs

@@ -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.