From 6c0155efb7fd1ff7259095655093e0eab0e37e51 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 20 Feb 2012 15:20:36 -0400 Subject: refactor --- Git/CatFile.hs | 43 ++++++++++++++++++++----------------------- Git/CheckAttr.hs | 27 ++++++++++++--------------- Git/HashObject.hs | 23 ++++++++++------------- 3 files changed, 42 insertions(+), 51 deletions(-) (limited to 'Git') diff --git a/Git/CatFile.hs b/Git/CatFile.hs index 2a2eb5e6f..2987a9d9d 100644 --- a/Git/CatFile.hs +++ b/Git/CatFile.hs @@ -13,7 +13,6 @@ module Git.CatFile ( catObject ) where -import System.Cmd.Utils import System.IO import qualified Data.ByteString.Char8 as S import qualified Data.ByteString.Lazy.Char8 as L @@ -22,20 +21,18 @@ import Common import Git import Git.Sha import Git.Command +import qualified Utility.CoProcess as CoProcess -type CatFileHandle = (PipeHandle, Handle, Handle) +type CatFileHandle = CoProcess.CoProcessHandle {- Starts git cat-file running in batch mode in a repo and returns a handle. -} catFileStart :: Repo -> IO CatFileHandle -catFileStart repo = hPipeBoth "git" $ toCommand $ +catFileStart repo = CoProcess.start "git" $ toCommand $ gitCommandLine [Param "cat-file", Param "--batch"] repo {- Stops git cat-file. -} catFileStop :: CatFileHandle -> IO () -catFileStop (pid, from, to) = do - hClose to - hClose from - forceSuccess pid +catFileStop = CoProcess.stop {- Reads a file from a specified branch. -} catFile :: CatFileHandle -> Branch -> FilePath -> IO L.ByteString @@ -44,23 +41,23 @@ catFile h branch file = catObject h $ Ref $ show branch ++ ":" ++ file {- 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 (_, from, to) object = do - hPutStrLn to $ show object - hFlush to - header <- hGetLine from - case words header of - [sha, objtype, size] - | length sha == shaSize && - validobjtype objtype -> handle size - | otherwise -> dne - _ - | header == show object ++ " missing" -> dne - | otherwise -> error $ "unknown response from git cat-file " ++ header +catObject h object = CoProcess.query h send receive where - handle size = case reads size of - [(bytes, "")] -> readcontent bytes - _ -> dne - readcontent bytes = do + send to = hPutStrLn to $ show object + receive from = do + header <- hGetLine from + case words header of + [sha, objtype, size] + | length sha == shaSize && + validobjtype objtype -> + case reads size of + [(bytes, "")] -> readcontent bytes from + _ -> dne + | otherwise -> dne + _ + | header == show object ++ " missing" -> dne + | otherwise -> error $ "unknown response from git cat-file " ++ header + readcontent bytes from = do content <- S.hGet from bytes c <- hGetChar from when (c /= '\n') $ diff --git a/Git/CheckAttr.hs b/Git/CheckAttr.hs index 696d8aafd..65e8e03d8 100644 --- a/Git/CheckAttr.hs +++ b/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. diff --git a/Git/HashObject.hs b/Git/HashObject.hs index 200fedbd2..5848d0144 100644 --- a/Git/HashObject.hs +++ b/Git/HashObject.hs @@ -10,16 +10,16 @@ module Git.HashObject where import Common import Git import Git.Command +import qualified Utility.CoProcess as CoProcess -type HashObjectHandle = (PipeHandle, Handle, Handle) +type HashObjectHandle = CoProcess.CoProcessHandle {- Starts git hash-object and returns a handle. -} hashObjectStart :: Repo -> IO HashObjectHandle hashObjectStart repo = do - r@(_, _, toh) <- hPipeBoth "git" $ - toCommand $ gitCommandLine params repo - fileEncoding toh - return r + h <- CoProcess.start "git" $ toCommand $ gitCommandLine params repo + CoProcess.query h fileEncoding (const $ return ()) + return h where params = [ Param "hash-object" @@ -29,14 +29,11 @@ hashObjectStart repo = do {- Stops git hash-object. -} hashObjectStop :: HashObjectHandle -> IO () -hashObjectStop (pid, from, to) = do - hClose to - hClose from - forceSuccess pid +hashObjectStop = CoProcess.stop {- Injects a file into git, returning the shas of the objects. -} hashFile :: HashObjectHandle -> FilePath -> IO Sha -hashFile (_, from, to) file = do - hPutStrLn to file - hFlush to - Ref <$> hGetLine from +hashFile h file = CoProcess.query h send receive + where + send to = hPutStrLn to file + receive from = Ref <$> hGetLine from -- cgit v1.2.3