summaryrefslogtreecommitdiff
path: root/Git
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2011-09-29 19:04:24 -0400
committerGravatar Joey Hess <joey@kitenet.net>2011-09-29 19:04:24 -0400
commita91c8a15d523791ea729976cd5c76bac1e7ec135 (patch)
tree32fcd0deaa1694f25ab3747f355264dd29d20636 /Git
parent244ffef43f859152907f5202e85161f3e73cfe64 (diff)
Sped up unused.
Added Git.ByteString which replaces Git IO methods with ones using lazy ByteStrings. This can be more efficient when large quantities of data are being read from git. In Git.LsTree, parse git ls-tree output more efficiently, thanks to ByteString. This benchmarks 25% faster, in a benchmark that includes (probably predominately) the run time for git ls-tree itself. In real world numbers, this makes git annex unused 2 seconds faster for each branch it needs to check, in my usual large repo.
Diffstat (limited to 'Git')
-rw-r--r--Git/ByteString.hs62
-rw-r--r--Git/LsTree.hs34
2 files changed, 79 insertions, 17 deletions
diff --git a/Git/ByteString.hs b/Git/ByteString.hs
new file mode 100644
index 000000000..4eb6a4876
--- /dev/null
+++ b/Git/ByteString.hs
@@ -0,0 +1,62 @@
+{- module using Data.ByteString.Lazy.Char8 for git IO
+ -
+ - This can be imported instead of Git when more efficient ByteString IO
+ - is needed.
+ -
+ - Copyright 2011 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Git.ByteString (
+ module Git,
+ pipeRead,
+ pipeWrite,
+ pipeWriteRead,
+ pipeNullSplit
+) where
+
+import Control.Applicative
+import System.Cmd.Utils
+import System.IO
+import qualified Data.ByteString.Lazy.Char8 as L
+
+import Git hiding (pipeRead, pipeWrite, pipeWriteRead, pipeNullSplit)
+import Utility.SafeCommand
+
+{- Runs a git subcommand and returns its output, lazily.
+ -
+ - Note that this leaves the git process running, and so zombies will
+ - result unless reap is called.
+ -}
+pipeRead :: Repo -> [CommandParam] -> IO L.ByteString
+pipeRead repo params = assertLocal repo $ do
+ (_, h) <- hPipeFrom "git" $ toCommand $ gitCommandLine repo params
+ hSetBinaryMode h True
+ L.hGetContents h
+
+{- Runs a git subcommand, feeding it input.
+ - You should call either getProcessStatus or forceSuccess on the PipeHandle. -}
+pipeWrite :: Repo -> [CommandParam] -> L.ByteString -> IO PipeHandle
+pipeWrite repo params s = assertLocal repo $ do
+ (p, h) <- hPipeTo "git" (toCommand $ gitCommandLine repo params)
+ L.hPut h s
+ hClose h
+ return p
+
+{- Runs a git subcommand, feeding it input, and returning its output.
+ - You should call either getProcessStatus or forceSuccess on the PipeHandle. -}
+pipeWriteRead :: Repo -> [CommandParam] -> L.ByteString -> IO (PipeHandle, L.ByteString)
+pipeWriteRead repo params s = assertLocal repo $ do
+ (p, from, to) <- hPipeBoth "git" (toCommand $ gitCommandLine repo params)
+ hSetBinaryMode from True
+ L.hPut to s
+ hClose to
+ c <- L.hGetContents from
+ return (p, c)
+
+{- Reads null terminated output of a git command (as enabled by the -z
+ - parameter), and splits it. -}
+pipeNullSplit :: Repo -> [CommandParam] -> IO [L.ByteString]
+pipeNullSplit repo params = filter (not . L.null) . L.split '\0' <$>
+ pipeRead repo params
diff --git a/Git/LsTree.hs b/Git/LsTree.hs
index 4a6c509f9..9d2fe7a37 100644
--- a/Git/LsTree.hs
+++ b/Git/LsTree.hs
@@ -7,22 +7,23 @@
module Git.LsTree (
TreeItem(..),
- lsTree
+ lsTree,
+ parseLsTree
) where
import Numeric
import Control.Applicative
-import Data.Char
import System.Posix.Types
+import qualified Data.ByteString.Lazy.Char8 as L
-import Git
+import Git.ByteString
import Utility.SafeCommand
type Treeish = String
data TreeItem = TreeItem
{ mode :: FileMode
- , objtype :: String
+ , typeobj :: String
, sha :: String
, file :: FilePath
} deriving Show
@@ -34,18 +35,17 @@ lsTree repo t = map parseLsTree <$>
{- Parses a line of ls-tree output.
- (The --long format is not currently supported.) -}
-parseLsTree :: String -> TreeItem
-parseLsTree l = TreeItem m o s f
+parseLsTree :: L.ByteString -> TreeItem
+parseLsTree l = TreeItem
+ (fst $ head $ readOct $ L.unpack m)
+ (L.unpack t)
+ (L.unpack s)
+ (decodeGitFile $ L.unpack f)
where
-- l = <mode> SP <type> SP <sha> TAB <file>
- -- Since everything until the file is fixed-width,
- -- do not need to split on words.
- (m, past_m) = head $ readOct l
- (o, past_o) = splitAt 4 $ space past_m
- (s, past_s) = splitAt shaSize $ space past_o
- f = decodeGitFile $ space past_s
- space (sp:rest)
- | isSpace sp = rest
- | otherwise = parseerr
- space [] = parseerr
- parseerr = "ls-tree parse error: " ++ l
+ -- All fields are fixed, so we can pull them out of
+ -- specific positions in the line.
+ (m, past_m) = L.splitAt 7 l
+ (t, past_t) = L.splitAt 4 past_m
+ (s, past_s) = L.splitAt 40 $ L.tail past_t
+ f = L.tail past_s