wip RawFilePath

Goal is to make git-annex faster by using ByteString for all the
worktree traversal. For now, this is focusing on Command.Find,
in order to benchmark how much it helps. (All other commands are
temporarily disabled)

Currently in a very bad unbuildable in-between state.
This commit is contained in:
Joey Hess 2019-11-25 16:18:19 -04:00
parent 1f035c0d66
commit 6a97ff6b3a
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
25 changed files with 258 additions and 200 deletions

View file

@ -1,11 +1,11 @@
{- git-update-index library
-
- Copyright 2011-2018 Joey Hess <id@joeyh.name>
- Copyright 2011-2019 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE BangPatterns, CPP #-}
{-# LANGUAGE BangPatterns, OverloadedStrings, CPP #-}
module Git.UpdateIndex (
Streamer,
@ -32,12 +32,14 @@ import Git.FilePath
import Git.Sha
import qualified Git.DiffTreeItem as Diff
import qualified Data.ByteString.Lazy as L
{- Streamers are passed a callback and should feed it lines in the form
- read by update-index, and generated by ls-tree. -}
type Streamer = (String -> IO ()) -> IO ()
type Streamer = (L.ByteString -> IO ()) -> IO ()
{- A streamer with a precalculated value. -}
pureStreamer :: String -> Streamer
pureStreamer :: L.ByteString -> Streamer
pureStreamer !s = \streamer -> streamer s
{- Streams content into update-index from a list of Streamers. -}
@ -49,8 +51,8 @@ data UpdateIndexHandle = UpdateIndexHandle ProcessHandle Handle
streamUpdateIndex' :: UpdateIndexHandle -> Streamer -> IO ()
streamUpdateIndex' (UpdateIndexHandle _ h) a = a $ \s -> do
hPutStr h s
hPutStr h "\0"
L.hPutStr h s
L.hPutStr h "\0"
startUpdateIndex :: Repo -> IO UpdateIndexHandle
startUpdateIndex repo = do
@ -84,14 +86,13 @@ lsSubTree (Ref x) p repo streamer = do
{- Generates a line suitable to be fed into update-index, to add
- a given file with a given sha. -}
updateIndexLine :: Sha -> TreeItemType -> TopFilePath -> String
updateIndexLine sha treeitemtype file = concat
[ fmtTreeItemType treeitemtype
, " blob "
, fromRef sha
, "\t"
, indexPath file
]
updateIndexLine :: Sha -> TreeItemType -> TopFilePath -> L.ByteString
updateIndexLine sha treeitemtype file = L.fromStrict $
fmtTreeItemType treeitemtype
<> " blob "
<> encodeBS (fromRef sha)
<> "\t"
<> indexPath file
stageFile :: Sha -> TreeItemType -> FilePath -> Repo -> IO Streamer
stageFile sha treeitemtype file repo = do
@ -105,7 +106,11 @@ unstageFile file repo = do
return $ unstageFile' p
unstageFile' :: TopFilePath -> Streamer
unstageFile' p = pureStreamer $ "0 " ++ fromRef nullSha ++ "\t" ++ indexPath p
unstageFile' p = pureStreamer $ L.fromStrict $
"0 "
<> encodeBS' (fromRef nullSha)
<> "\t"
<> indexPath p
{- A streamer that adds a symlink to the index. -}
stageSymlink :: FilePath -> Sha -> Repo -> IO Streamer
@ -123,7 +128,7 @@ stageDiffTreeItem d = case toTreeItemType (Diff.dstmode d) of
Just t -> pureStreamer $ updateIndexLine (Diff.dstsha d) t (Diff.file d)
indexPath :: TopFilePath -> InternalGitPath
indexPath = toInternalGitPath . getTopFilePath
indexPath = toInternalGitPath . toRawFilePath . getTopFilePath
{- Refreshes the index, by checking file stat information. -}
refreshIndex :: Repo -> ((FilePath -> IO ()) -> IO ()) -> IO Bool