summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2011-09-28 15:15:42 -0400
committerGravatar Joey Hess <joey@kitenet.net>2011-09-28 15:17:36 -0400
commitad245a6375b32a17a9aa18088ee006cad6b4c1ff (patch)
tree857f50ce714cbf667bcbb77796e806a3c7bd1985
parent4f4eaf387ab801157cb8986a9ca3542a977e9e03 (diff)
refactor catfile code
split into generic IO code, and a thin Annex wrapper
-rw-r--r--Annex.hs3
-rw-r--r--Branch.hs45
-rw-r--r--CatFile.hs26
-rw-r--r--Git/CatFile.hs63
-rw-r--r--Types/BranchState.hs7
5 files changed, 96 insertions, 48 deletions
diff --git a/Annex.hs b/Annex.hs
index 1517a3470..8a386a044 100644
--- a/Annex.hs
+++ b/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
diff --git a/Branch.hs b/Branch.hs
index 15681e699..af3851635 100644
--- a/Branch.hs
+++ b/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
diff --git a/CatFile.hs b/CatFile.hs
new file mode 100644
index 000000000..0eb1e74f6
--- /dev/null
+++ b/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
diff --git a/Git/CatFile.hs b/Git/CatFile.hs
new file mode 100644
index 000000000..64857c66a
--- /dev/null
+++ b/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 ""
diff --git a/Types/BranchState.hs b/Types/BranchState.hs
index bc1d32e69..777edb32c 100644
--- a/Types/BranchState.hs
+++ b/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 ""