refactor catfile code

split into generic IO code, and a thin Annex wrapper

Annex.hs

@@ -24,6 +24,7 @@ import Control.Monad.IO.Control
 import Control.Applicative hiding (empty)
 
 import qualified Git
+import Git.CatFile
 import Git.Queue
 import Types.Backend
 import qualified Types.Remote
@@ -55,6 +56,7 @@ data AnnexState = AnnexState
 	, fast :: Bool
 	, auto :: Bool
 	, branchstate :: BranchState
+	, catfilehandle :: Maybe CatFileHandle
 	, forcebackend :: Maybe String
 	, forcenumcopies :: Maybe Int
 	, defaultkey :: Maybe String
@@ -79,6 +81,7 @@ newState gitrepo = AnnexState
 	, fast = False
 	, auto = False
 	, branchstate = startBranchState
+	, catfilehandle = Nothing
 	, forcebackend = Nothing
 	, forcenumcopies = Nothing
 	, defaultkey = Nothing

Branch.hs

@@ -18,7 +18,7 @@ module Branch (
 	name	
 ) where
 
-import Control.Monad (when, unless, liftM)
+import Control.Monad (unless, liftM)
 import Control.Monad.State (liftIO)
 import Control.Applicative ((<$>))
 import System.FilePath
@@ -31,7 +31,6 @@ import System.IO
 import System.IO.Binary
 import System.Posix.Process
 import System.Exit
-import qualified Data.ByteString.Char8 as B
 
 import Types.BranchState
 import qualified Git
@@ -43,6 +42,7 @@ import Utility.SafeCommand
 import Types
 import Messages
 import Locations
+import CatFile
 
 type GitRef = String
 
@@ -244,49 +244,10 @@ get file = do
 					setCache file content
 					return content
 				Nothing -> withIndexUpdate $ do
-					content <- catFile file
+					content <- catFile fullname file
 					setCache file content
 					return content
 
-{- Uses git cat-file in batch mode to read the content of a file.
- -
- - Only one process is run, and it persists and is used for all accesses. -}
-catFile :: FilePath -> Annex String
-catFile file = do
-	state <- getState
-	maybe (startup state) ask (catFileHandles state)
-	where
-		startup state = do
-			g <- Annex.gitRepo
-			(_, from, to) <- liftIO $ hPipeBoth "git" $
-				toCommand $ Git.gitCommandLine g
-					[Param "cat-file", Param "--batch"]
-			setState state { catFileHandles = Just (from, to) }
-			ask (from, to)
-		ask (from, to) = liftIO $ do
-			let want = fullname ++ ":" ++ file
-			hPutStrLn to want
-			hFlush to
-			header <- hGetLine from
-			case words header of
-				[sha, blob, size]
-					| length sha == Git.shaSize &&
-					  blob == "blob" -> handle from size
-					| otherwise -> empty
-				_
-					| header == want ++ " missing" -> empty
-					| otherwise -> error $ "unknown response from git cat-file " ++ header
-		handle from size = case reads size of
-			[(bytes, "")] -> readcontent from bytes
-			_ -> empty
-		readcontent from bytes = do
-			content <- B.hGet from bytes
-			c <- hGetChar from
-			when (c /= '\n') $
-				error "missing newline from git cat-file"
-			return $ B.unpack content
-		empty = return ""
-
 {- Lists all files on the branch. There may be duplicates in the list. -}
 files :: Annex [FilePath]
 files = withIndexUpdate $ do

CatFile.hs

@@ -0,0 +1,26 @@
+{- git cat-file interface, with handle automatically stored in the Annex monad
+ -
+ - Copyright 2011 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module CatFile (
+	catFile
+) where
+
+import Control.Monad.State
+
+import qualified Git.CatFile
+import Types
+import qualified Annex
+
+catFile :: String -> FilePath -> Annex String
+catFile branch file = maybe startup go =<< Annex.getState Annex.catfilehandle
+	where
+		startup = do
+			g <- Annex.gitRepo
+			h <- liftIO $ Git.CatFile.catFileStart g
+			Annex.changeState $ \s -> s { Annex.catfilehandle = Just h }
+			go h
+		go h = liftIO $ Git.CatFile.catFile h branch file

Git/CatFile.hs

@@ -0,0 +1,63 @@
+{- git cat-file interface
+ -
+ - Copyright 2011 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Git.CatFile (
+	CatFileHandle,
+	catFileStart,
+	catFileStop,
+	catFile
+) where
+
+import Control.Monad.State
+import System.Cmd.Utils
+import System.IO
+import qualified Data.ByteString.Char8 as B
+
+import Git
+import Utility.SafeCommand
+
+type CatFileHandle = (PipeHandle, Handle, Handle)
+
+{- Starts git cat-file running in batch mode in a repo and returns a handle. -}
+catFileStart :: Repo -> IO CatFileHandle
+catFileStart repo = hPipeBoth "git" $ toCommand $
+	Git.gitCommandLine repo [Param "cat-file", Param "--batch"]
+
+{- Stops git cat-file. -}
+catFileStop :: CatFileHandle -> IO ()
+catFileStop (pid, from, to) = do
+	hClose to
+	hClose from
+	forceSuccess pid
+
+{- Uses a running git cat-file read the content of a file from a branch.
+ - Files that do not exist on the branch will have "" returned. -}
+catFile :: CatFileHandle -> String -> FilePath -> IO String
+catFile (_, from, to) branch file = do
+	hPutStrLn to want
+	hFlush to
+	header <- hGetLine from
+	case words header of
+		[sha, blob, size]
+			| length sha == Git.shaSize &&
+			  blob == "blob" -> handle size
+			| otherwise -> empty
+		_
+			| header == want ++ " missing" -> empty
+			| otherwise -> error $ "unknown response from git cat-file " ++ header
+	where
+		want = branch ++ ":" ++ file
+		handle size = case reads size of
+			[(bytes, "")] -> readcontent bytes
+			_ -> empty
+		readcontent bytes = do
+			content <- B.hGet from bytes
+			c <- hGetChar from
+			when (c /= '\n') $
+				error "missing newline from git cat-file"
+			return $ B.unpack content
+		empty = return ""

Types/BranchState.hs

@@ -7,18 +7,13 @@
 
 module Types.BranchState where
 
-import System.IO
-
 data BranchState = BranchState {
 	branchUpdated :: Bool, -- has the branch been updated this run?
 
-	-- (from, to) handles used to talk to a git-cat-file process
-	catFileHandles :: Maybe (Handle, Handle),
-
 	-- the content of one file is cached
 	cachedFile :: Maybe FilePath,
 	cachedContent :: String
 }
 
 startBranchState :: BranchState
-startBranchState = BranchState False Nothing Nothing ""
+startBranchState = BranchState False Nothing ""