From 6c81e0c8f1a4806489f7617499d6922c208b4011 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 7 Apr 2020 13:27:11 -0400 Subject: [PATCH] ByteString Ref continued Several nice speed wins I think. At 340/633 files converted. --- Annex/AdjustedBranch/Name.hs | 31 ++++++++++++++++------------ Annex/Branch.hs | 8 +++++--- Annex/ChangedRefs.hs | 7 ++++--- Database/Keys.hs | 25 +++++++++++++---------- Git/Branch.hs | 22 +++++++++++--------- Git/CatFile.hs | 39 ++++++++++++++++++------------------ Git/History.hs | 8 ++++---- Git/LsFiles.hs | 21 ++++++++++--------- Git/Repair.hs | 17 ++++++++-------- Git/Tree.hs | 3 ++- Git/UnionMerge.hs | 18 +++++++++-------- Logs/FsckResults.hs | 2 +- Logs/View.hs | 16 +++++++++------ Types/GitConfig.hs | 2 +- Types/View.hs | 2 ++ Upgrade/V5/Direct.hs | 2 +- 16 files changed, 124 insertions(+), 99 deletions(-) diff --git a/Annex/AdjustedBranch/Name.hs b/Annex/AdjustedBranch/Name.hs index 5987662b9a..d997e72309 100644 --- a/Annex/AdjustedBranch/Name.hs +++ b/Annex/AdjustedBranch/Name.hs @@ -5,6 +5,8 @@ - Licensed under the GNU AGPL version 3 or higher. -} +{-# LANGUAGE OverloadedStrings #-} + module Annex.AdjustedBranch.Name ( originalToAdjusted, adjustedToOriginal, @@ -18,14 +20,15 @@ import qualified Git.Ref import Utility.Misc import Control.Applicative -import Data.List +import Data.Char +import qualified Data.ByteString as S -adjustedBranchPrefix :: String +adjustedBranchPrefix :: S.ByteString adjustedBranchPrefix = "refs/heads/adjusted/" class SerializeAdjustment t where - serializeAdjustment :: t -> String - deserializeAdjustment :: String -> Maybe t + serializeAdjustment :: t -> S.ByteString + deserializeAdjustment :: S.ByteString -> Maybe t instance SerializeAdjustment Adjustment where serializeAdjustment (LinkAdjustment l) = @@ -33,7 +36,7 @@ instance SerializeAdjustment Adjustment where serializeAdjustment (PresenceAdjustment p Nothing) = serializeAdjustment p serializeAdjustment (PresenceAdjustment p (Just l)) = - serializeAdjustment p ++ "-" ++ serializeAdjustment l + serializeAdjustment p <> "-" <> serializeAdjustment l deserializeAdjustment s = (LinkAdjustment <$> deserializeAdjustment s) <|> @@ -41,7 +44,7 @@ instance SerializeAdjustment Adjustment where <|> (PresenceAdjustment <$> deserializeAdjustment s <*> pure Nothing) where - (s1, s2) = separate (== '-') s + (s1, s2) = separate' (== (fromIntegral (ord '-'))) s instance SerializeAdjustment LinkAdjustment where serializeAdjustment UnlockAdjustment = "unlocked" @@ -65,19 +68,21 @@ newtype AdjBranch = AdjBranch { adjBranch :: Branch } originalToAdjusted :: OrigBranch -> Adjustment -> AdjBranch originalToAdjusted orig adj = AdjBranch $ Ref $ - adjustedBranchPrefix ++ base ++ '(' : serializeAdjustment adj ++ ")" + adjustedBranchPrefix <> base <> "(" <> serializeAdjustment adj <> ")" where - base = fromRef (Git.Ref.base orig) + base = fromRef' (Git.Ref.base orig) type OrigBranch = Branch adjustedToOriginal :: Branch -> Maybe (Adjustment, OrigBranch) adjustedToOriginal b - | adjustedBranchPrefix `isPrefixOf` bs = do - let (base, as) = separate (== '(') (drop prefixlen bs) - adj <- deserializeAdjustment (takeWhile (/= ')') as) + | adjustedBranchPrefix `S.isPrefixOf` bs = do + let (base, as) = separate' (== openparen) (S.drop prefixlen bs) + adj <- deserializeAdjustment (S.takeWhile (/= closeparen) as) Just (adj, Git.Ref.branchRef (Ref base)) | otherwise = Nothing where - bs = fromRef b - prefixlen = length adjustedBranchPrefix + bs = fromRef' b + prefixlen = S.length adjustedBranchPrefix + openparen = fromIntegral (ord '(') + closeparen = fromIntegral (ord ')') diff --git a/Annex/Branch.hs b/Annex/Branch.hs index 91d0276daa..f4b5ce1a1f 100644 --- a/Annex/Branch.hs +++ b/Annex/Branch.hs @@ -29,7 +29,9 @@ module Annex.Branch ( withIndex, ) where +import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L +import qualified Data.ByteString.Char8 as B8 import qualified Data.Set as S import qualified Data.Map as M import Data.Function @@ -643,11 +645,11 @@ getMergedRefs = S.fromList . map fst <$> getMergedRefs' getMergedRefs' :: Annex [(Git.Sha, Git.Branch)] getMergedRefs' = do f <- fromRepo gitAnnexMergedRefs - s <- liftIO $ catchDefaultIO "" $ readFile f - return $ map parse $ lines s + s <- liftIO $ catchDefaultIO mempty $ B.readFile f + return $ map parse $ B8.lines s where parse l = - let (s, b) = separate (== '\t') l + let (s, b) = separate' (== (fromIntegral (ord '\t'))) l in (Ref s, Ref b) {- Grafts a treeish into the branch at the specified location, diff --git a/Annex/ChangedRefs.hs b/Annex/ChangedRefs.hs index 786a193e55..3fb9d1ef1b 100644 --- a/Annex/ChangedRefs.hs +++ b/Annex/ChangedRefs.hs @@ -1,6 +1,6 @@ {- Waiting for changed git refs - - - Copyright 2014-216 Joey Hess + - Copyright 2014-2016 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} @@ -24,13 +24,14 @@ import qualified Utility.SimpleProtocol as Proto import Control.Concurrent import Control.Concurrent.STM import Control.Concurrent.STM.TBMChan +import qualified Data.ByteString as S newtype ChangedRefs = ChangedRefs [Git.Ref] deriving (Show) instance Proto.Serializable ChangedRefs where serialize (ChangedRefs l) = unwords $ map Git.fromRef l - deserialize = Just . ChangedRefs . map Git.Ref . words + deserialize = Just . ChangedRefs . map (Git.Ref . encodeBS) . words data ChangedRefsHandle = ChangedRefsHandle DirWatcherHandle (TBMChan Git.Sha) @@ -97,7 +98,7 @@ notifyHook chan reffile _ | ".lock" `isSuffixOf` reffile = noop | otherwise = void $ do sha <- catchDefaultIO Nothing $ - extractSha <$> readFile reffile + extractSha <$> S.readFile reffile -- When the channel is full, there is probably no reader -- running, or ref changes have been occuring very fast, -- so it's ok to not write the change to it. diff --git a/Database/Keys.hs b/Database/Keys.hs index b1650b286c..25954ba71a 100644 --- a/Database/Keys.hs +++ b/Database/Keys.hs @@ -6,6 +6,7 @@ -} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE OverloadedStrings #-} module Database.Keys ( DbHandle, @@ -44,6 +45,7 @@ import Git.Types import Git.Index import qualified Data.ByteString as S +import qualified Data.ByteString.Char8 as S8 import qualified System.FilePath.ByteString as P {- Runs an action that reads from the database. @@ -237,8 +239,8 @@ reconcileStaged qh = do Nothing -> noop where go cur indexcache = do - (l, cleanup) <- inRepo $ pipeNullSplit diff - changed <- procdiff (map decodeBL' l) False + (l, cleanup) <- inRepo $ pipeNullSplit' diff + changed <- procdiff l False void $ liftIO cleanup -- Flush database changes immediately -- so other processes can see them. @@ -278,15 +280,16 @@ reconcileStaged qh = do , Param "--no-ext-diff" ] - procdiff (info:file:rest) changed = case words info of - ((':':_srcmode):dstmode:_srcsha:dstsha:_change:[]) - -- Only want files, not symlinks - | dstmode /= decodeBS' (fmtTreeItemType TreeSymlink) -> do - maybe noop (reconcile (asTopFilePath (toRawFilePath file))) - =<< catKey (Ref dstsha) - procdiff rest True - | otherwise -> procdiff rest changed - _ -> return changed -- parse failed + procdiff (info:file:rest) changed + | ":" `S.isPrefixOf` info = case S8.words info of + (_colonsrcmode:dstmode:_srcsha:dstsha:_change:[]) + -- Only want files, not symlinks + | dstmode /= fmtTreeItemType TreeSymlink -> do + maybe noop (reconcile (asTopFilePath file)) + =<< catKey (Ref dstsha) + procdiff rest True + | otherwise -> procdiff rest changed + _ -> return changed -- parse failed procdiff _ changed = return changed -- Note that database writes done in here will not necessarily diff --git a/Git/Branch.hs b/Git/Branch.hs index 699fbf50e1..fcae905f64 100644 --- a/Git/Branch.hs +++ b/Git/Branch.hs @@ -18,6 +18,7 @@ import qualified Git.Config import qualified Git.Ref import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 as B8 {- The currently checked out branch. - @@ -39,25 +40,27 @@ current r = do {- The current branch, which may not really exist yet. -} currentUnsafe :: Repo -> IO (Maybe Branch) -currentUnsafe r = parse . firstLine' - <$> pipeReadStrict [Param "symbolic-ref", Param "-q", Param $ fromRef Git.Ref.headRef] r +currentUnsafe r = parse . firstLine' <$> pipeReadStrict + [ Param "symbolic-ref" + , Param "-q" + , Param $ fromRef Git.Ref.headRef + ] r where parse b | B.null b = Nothing - | otherwise = Just $ Git.Ref $ decodeBS b + | otherwise = Just $ Git.Ref b {- Checks if the second branch has any commits not present on the first - branch. -} changed :: Branch -> Branch -> Repo -> IO Bool changed origbranch newbranch repo | origbranch == newbranch = return False - | otherwise = not . null + | otherwise = not . B.null <$> changed' origbranch newbranch [Param "-n1"] repo where -changed' :: Branch -> Branch -> [CommandParam] -> Repo -> IO String -changed' origbranch newbranch extraps repo = - decodeBS <$> pipeReadStrict ps repo +changed' :: Branch -> Branch -> [CommandParam] -> Repo -> IO B.ByteString +changed' origbranch newbranch extraps repo = pipeReadStrict ps repo where ps = [ Param "log" @@ -68,7 +71,7 @@ changed' origbranch newbranch extraps repo = {- Lists commits that are in the second branch and not in the first branch. -} changedCommits :: Branch -> Branch -> [CommandParam] -> Repo -> IO [Sha] changedCommits origbranch newbranch extraps repo = - catMaybes . map extractSha . lines + catMaybes . map extractSha . B8.lines <$> changed' origbranch newbranch extraps repo {- Check if it's possible to fast-forward from the old @@ -163,8 +166,7 @@ commitCommand' runner commitmode ps = runner $ -} commit :: CommitMode -> Bool -> String -> Branch -> [Ref] -> Repo -> IO (Maybe Sha) commit commitmode allowempty message branch parentrefs repo = do - tree <- getSha "write-tree" $ - decodeBS' <$> pipeReadStrict [Param "write-tree"] repo + tree <- getSha "write-tree" $ pipeReadStrict [Param "write-tree"] repo ifM (cancommit tree) ( do sha <- commitTree commitmode message parentrefs tree repo diff --git a/Git/CatFile.hs b/Git/CatFile.hs index 980d289840..68850f075c 100644 --- a/Git/CatFile.hs +++ b/Git/CatFile.hs @@ -5,6 +5,8 @@ - Licensed under the GNU AGPL version 3 or higher. -} +{-# LANGUAGE OverloadedStrings #-} + module Git.CatFile ( CatFileHandle, catFileStart, @@ -22,7 +24,6 @@ module Git.CatFile ( import System.IO import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L -import qualified Data.ByteString.Lazy.Char8 as L8 import qualified Data.Map as M import Data.String import Data.Char @@ -69,11 +70,11 @@ catFileStop h = do {- Reads a file from a specified branch. -} catFile :: CatFileHandle -> Branch -> RawFilePath -> IO L.ByteString catFile h branch file = catObject h $ Ref $ - fromRef branch ++ ":" ++ fromRawFilePath (toInternalGitPath file) + fromRef' branch <> ":" <> toInternalGitPath file catFileDetails :: CatFileHandle -> Branch -> RawFilePath -> IO (Maybe (L.ByteString, Sha, ObjectType)) catFileDetails h branch file = catObjectDetails h $ Ref $ - fromRef branch ++ ":" ++ fromRawFilePath (toInternalGitPath file) + fromRef' branch <> ":" <> toInternalGitPath file {- Uses a running git cat-file read the content of an object. - Objects that do not exist will have "" returned. -} @@ -148,7 +149,7 @@ parseResp object l | " missing" `isSuffixOf` l -- less expensive than full check && l == fromRef object ++ " missing" = Just DNE | otherwise = case words l of - [sha, objtype, size] -> case extractSha sha of + [sha, objtype, size] -> case extractSha (encodeBS sha) of Just sha' -> case (readObjectType (encodeBS objtype), reads size) of (Just t, [(bytes, "")]) -> Just $ ParsedResp sha' bytes t @@ -218,39 +219,39 @@ catTree h treeref = go <$> catObjectDetails h treeref catCommit :: CatFileHandle -> Ref -> IO (Maybe Commit) catCommit h commitref = go <$> catObjectDetails h commitref where - go (Just (b, _, CommitObject)) = parseCommit b + go (Just (b, _, CommitObject)) = parseCommit (L.toStrict b) go _ = Nothing -parseCommit :: L.ByteString -> Maybe Commit +parseCommit :: S.ByteString -> Maybe Commit parseCommit b = Commit - <$> (extractSha . L8.unpack =<< field "tree") - <*> Just (maybe [] (mapMaybe (extractSha . L8.unpack)) (fields "parent")) + <$> (extractSha =<< field "tree") + <*> Just (maybe [] (mapMaybe extractSha) (fields "parent")) <*> (parsemetadata <$> field "author") <*> (parsemetadata <$> field "committer") - <*> Just (L8.unpack $ L.intercalate (L.singleton nl) message) + <*> Just (decodeBS $ S.intercalate (S.singleton nl) message) where field n = headMaybe =<< fields n fields n = M.lookup (fromString n) fieldmap fieldmap = M.fromListWith (++) ((map breakfield) header) breakfield l = - let (k, sp_v) = L.break (== sp) l - in (k, [L.drop 1 sp_v]) - (header, message) = separate L.null ls - ls = L.split nl b + let (k, sp_v) = S.break (== sp) l + in (k, [S.drop 1 sp_v]) + (header, message) = separate S.null ls + ls = S.split nl b -- author and committer lines have the form: "name date" -- The email is always present, even if empty "<>" parsemetadata l = CommitMetaData - { commitName = whenset $ L.init name_sp + { commitName = whenset $ S.init name_sp , commitEmail = whenset email - , commitDate = whenset $ L.drop 2 gt_sp_date + , commitDate = whenset $ S.drop 2 gt_sp_date } where - (name_sp, rest) = L.break (== lt) l - (email, gt_sp_date) = L.break (== gt) (L.drop 1 rest) + (name_sp, rest) = S.break (== lt) l + (email, gt_sp_date) = S.break (== gt) (S.drop 1 rest) whenset v - | L.null v = Nothing - | otherwise = Just (L8.unpack v) + | S.null v = Nothing + | otherwise = Just (decodeBS v) nl = fromIntegral (ord '\n') sp = fromIntegral (ord ' ') diff --git a/Git/History.hs b/Git/History.hs index 5c202c9b5c..1b7127229b 100644 --- a/Git/History.hs +++ b/Git/History.hs @@ -16,8 +16,8 @@ import Git.Sha import qualified Data.Set as S import qualified Data.ByteString.Lazy as L -import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as B8 +import qualified Data.ByteString.Lazy.Char8 as L8 data History t = History t (S.Set (History t)) deriving (Show, Eq, Ord) @@ -56,8 +56,8 @@ getHistoryToDepth n commit r = do !h <- fmap (truncateHistoryToDepth n) . build Nothing . map parsehistorycommit - . map B.copy - . B8.lines + . map L.toStrict + . L8.lines <$> L.hGetContents inh hClose inh void $ waitForProcess pid @@ -97,7 +97,7 @@ getHistoryToDepth n commit r = do , Param "--format=%T %H %P" ] - parsehistorycommit l = case map extractSha (S8.split ' ' l) of + parsehistorycommit l = case map extractSha (B8.split ' ' l) of (Just t:Just c:ps) -> Just $ ( HistoryCommit { historyCommit = c diff --git a/Git/LsFiles.hs b/Git/LsFiles.hs index 2291e9c42a..830b5f5bfe 100644 --- a/Git/LsFiles.hs +++ b/Git/LsFiles.hs @@ -36,9 +36,10 @@ import Utility.InodeCache import Utility.TimeStamp import Numeric +import Data.Char import System.Posix.Types import qualified Data.Map as M -import qualified Data.ByteString.Lazy as L +import qualified Data.ByteString as S {- It's only safe to use git ls-files on the current repo, not on a remote. - @@ -81,7 +82,7 @@ inRepo' ps l repo = guardSafeForLsFiles repo $ pipeNullSplit' params repo {- Files that are checked into the index or have been committed to a - branch. -} inRepoOrBranch :: Branch -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool) -inRepoOrBranch (Ref b) = inRepo' [Param $ "--with-tree=" ++ b] +inRepoOrBranch b = inRepo' [Param $ "--with-tree=" ++ fromRef b] {- Scans for files at the specified locations that are not checked into git. -} notInRepo :: Bool -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool) @@ -189,21 +190,21 @@ stagedDetails = stagedDetails' [] - contents. -} stagedDetails' :: [CommandParam] -> [RawFilePath] -> Repo -> IO ([StagedDetails], IO Bool) stagedDetails' ps l repo = guardSafeForLsFiles repo $ do - (ls, cleanup) <- pipeNullSplit params repo + (ls, cleanup) <- pipeNullSplit' params repo return (map parseStagedDetails ls, cleanup) where params = Param "ls-files" : Param "--stage" : Param "-z" : ps ++ Param "--" : map (File . fromRawFilePath) l -parseStagedDetails :: L.ByteString -> StagedDetails +parseStagedDetails :: S.ByteString -> StagedDetails parseStagedDetails s - | null file = (L.toStrict s, Nothing, Nothing) - | otherwise = (toRawFilePath file, extractSha sha, readmode mode) + | S.null file = (s, Nothing, Nothing) + | otherwise = (file, extractSha sha, readmode mode) where - (metadata, file) = separate (== '\t') (decodeBL' s) - (mode, metadata') = separate (== ' ') metadata - (sha, _) = separate (== ' ') metadata' - readmode = fst <$$> headMaybe . readOct + (metadata, file) = separate' (== fromIntegral (ord '\t')) s + (mode, metadata') = separate' (== fromIntegral (ord ' ')) metadata + (sha, _) = separate' (== fromIntegral (ord ' ')) metadata' + readmode = fst <$$> headMaybe . readOct . decodeBS' {- Returns a list of the files in the specified locations that are staged - for commit, and whose type has changed. -} diff --git a/Git/Repair.hs b/Git/Repair.hs index 10ea6a8ddc..f7a91ca0fe 100644 --- a/Git/Repair.hs +++ b/Git/Repair.hs @@ -232,7 +232,7 @@ getAllRefs r = getAllRefs' (fromRawFilePath (localGitDir r) "refs") getAllRefs' :: FilePath -> IO [Ref] getAllRefs' refdir = do let topsegs = length (splitPath refdir) - 1 - let toref = Ref . joinPath . drop topsegs . splitPath + let toref = Ref . encodeBS' . joinPath . drop topsegs . splitPath map toref <$> dirContentsRecursive refdir explodePackedRefsFile :: Repo -> IO () @@ -257,8 +257,8 @@ packedRefsFile r = fromRawFilePath (localGitDir r) "packed-refs" parsePacked :: String -> Maybe (Sha, Ref) parsePacked l = case words l of (sha:ref:[]) - | isJust (extractSha sha) && Ref.legal True ref -> - Just (Ref sha, Ref ref) + | isJust (extractSha (encodeBS' sha)) && Ref.legal True ref -> + Just (Ref (encodeBS' sha), Ref (encodeBS' ref)) _ -> Nothing {- git-branch -d cannot be used to remove a branch that is directly @@ -279,13 +279,13 @@ findUncorruptedCommit missing goodcommits branch r = do if ok then return (Just branch, goodcommits') else do - (ls, cleanup) <- pipeNullSplit + (ls, cleanup) <- pipeNullSplit' [ Param "log" , Param "-z" , Param "--format=%H" , Param (fromRef branch) ] r - let branchshas = catMaybes $ map (extractSha . decodeBL) ls + let branchshas = catMaybes $ map extractSha ls reflogshas <- RefLog.get branch r -- XXX Could try a bit harder here, and look -- for uncorrupted old commits in branches in the @@ -328,8 +328,8 @@ verifyCommit missing goodcommits commit r where parse l = case words l of (commitsha:treesha:[]) -> (,) - <$> extractSha commitsha - <*> extractSha treesha + <$> extractSha (encodeBS' commitsha) + <*> extractSha (encodeBS' treesha) _ -> Nothing check [] = return True check ((c, t):rest) @@ -448,7 +448,8 @@ preRepair g = do void $ tryIO $ allowWrite f where headfile = fromRawFilePath (localGitDir g) "HEAD" - validhead s = "ref: refs/" `isPrefixOf` s || isJust (extractSha s) + validhead s = "ref: refs/" `isPrefixOf` s + || isJust (extractSha (encodeBS' s)) {- Put it all together. -} runRepair :: (Ref -> Bool) -> Bool -> Repo -> IO (Bool, [Branch]) diff --git a/Git/Tree.hs b/Git/Tree.hs index 9627ae9690..491314fff5 100644 --- a/Git/Tree.hs +++ b/Git/Tree.hs @@ -38,6 +38,7 @@ import System.Posix.Types import Control.Monad.IO.Class import qualified Data.Set as S import qualified Data.Map as M +import qualified Data.ByteString.Char8 as S8 newtype Tree = Tree [TreeContent] deriving (Show) @@ -106,7 +107,7 @@ mkTree (MkTreeHandle cp) l = CoProcess.query cp send receive NewSubTree _ _ -> error "recordSubTree internal error; unexpected NewSubTree" TreeCommit f fm s -> mkTreeOutput fm CommitObject s f hPutStr h "\NUL" -- signal end of tree to --batch - receive h = getSha "mktree" (hGetLine h) + receive h = getSha "mktree" (S8.hGetLine h) treeMode :: FileMode treeMode = 0o040000 diff --git a/Git/UnionMerge.hs b/Git/UnionMerge.hs index 2100f1dcf9..2cf103dd9d 100644 --- a/Git/UnionMerge.hs +++ b/Git/UnionMerge.hs @@ -10,8 +10,10 @@ module Git.UnionMerge ( mergeIndex ) where +import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy.Char8 as L8 +import qualified Data.ByteString.Char8 as S8 import qualified Data.Set as S import Common @@ -54,13 +56,13 @@ mergeIndex hashhandle ch repo bs = forM_ bs $ \b -> {- For merging two trees. -} mergeTrees :: Ref -> Ref -> HashObjectHandle -> CatFileHandle -> Repo -> Streamer -mergeTrees (Ref x) (Ref y) hashhandle ch = doMerge hashhandle ch - ("diff-tree":diffOpts ++ [x, y, "--"]) +mergeTrees x y hashhandle ch = doMerge hashhandle ch + ("diff-tree":diffOpts ++ [fromRef x, fromRef y, "--"]) {- For merging a single tree into the index. -} mergeTreeIndex :: Ref -> HashObjectHandle -> CatFileHandle -> Repo -> Streamer -mergeTreeIndex (Ref r) hashhandle ch = doMerge hashhandle ch $ - "diff-index" : diffOpts ++ ["--cached", r, "--"] +mergeTreeIndex r hashhandle ch = doMerge hashhandle ch $ + "diff-index" : diffOpts ++ ["--cached", fromRef r, "--"] diffOpts :: [String] diffOpts = ["--raw", "-z", "-r", "--no-renames", "-l0"] @@ -69,19 +71,19 @@ diffOpts = ["--raw", "-z", "-r", "--no-renames", "-l0"] - using git to get a raw diff. -} doMerge :: HashObjectHandle -> CatFileHandle -> [String] -> Repo -> Streamer doMerge hashhandle ch differ repo streamer = do - (diff, cleanup) <- pipeNullSplit (map Param differ) repo + (diff, cleanup) <- pipeNullSplit' (map Param differ) repo go diff void $ cleanup where go [] = noop - go (info:file:rest) = mergeFile (decodeBL' info) (L.toStrict file) hashhandle ch >>= + go (info:file:rest) = mergeFile info file hashhandle ch >>= maybe (go rest) (\l -> streamer l >> go rest) go (_:[]) = error $ "parse error " ++ show differ {- Given an info line from a git raw diff, and the filename, generates - a line suitable for update-index that union merges the two sides of the - diff. -} -mergeFile :: String -> RawFilePath -> HashObjectHandle -> CatFileHandle -> IO (Maybe L.ByteString) +mergeFile :: S.ByteString -> RawFilePath -> HashObjectHandle -> CatFileHandle -> IO (Maybe L.ByteString) mergeFile info file hashhandle h = case filter (`notElem` nullShas) [Ref asha, Ref bsha] of [] -> return Nothing (sha:[]) -> use sha @@ -89,7 +91,7 @@ mergeFile info file hashhandle h = case filter (`notElem` nullShas) [Ref asha, R =<< either return (hashBlob hashhandle . L8.unlines) =<< calcMerge . zip shas <$> mapM getcontents shas where - [_colonmode, _bmode, asha, bsha, _status] = words info + [_colonmode, _bmode, asha, bsha, _status] = S8.words info use sha = return $ Just $ updateIndexLine sha TreeFile $ asTopFilePath file -- Get file and split into lines to union merge. diff --git a/Logs/FsckResults.hs b/Logs/FsckResults.hs index 73f6d4c6c0..1f188ed08f 100644 --- a/Logs/FsckResults.hs +++ b/Logs/FsckResults.hs @@ -43,7 +43,7 @@ readFsckResults u = do deserialize ("truncated":ls) = deserialize' ls True deserialize ls = deserialize' ls False deserialize' ls t = - let s = S.fromList $ map Ref ls + let s = S.fromList $ map (Ref . encodeBS') ls in if S.null s then FsckFailed else FsckFoundMissing s t clearFsckResults :: UUID -> Annex () diff --git a/Logs/View.hs b/Logs/View.hs index b14d065166..ea28f29b55 100644 --- a/Logs/View.hs +++ b/Logs/View.hs @@ -9,6 +9,8 @@ - Licensed under the GNU AGPL version 3 or higher. -} +{-# LANGUAGE OverloadedStrings #-} + module Logs.View ( currentView, setView, @@ -31,6 +33,7 @@ import Logs.File import qualified Data.Text as T import qualified Data.Set as S import Data.Char +import qualified Data.ByteString as B setView :: View -> Annex () setView v = do @@ -54,11 +57,11 @@ recentViews = do currentView :: Annex (Maybe View) currentView = go =<< inRepo Git.Branch.current where - go (Just b) | branchViewPrefix `isPrefixOf` fromRef b = + go (Just b) | branchViewPrefix `B.isPrefixOf` fromRef' b = headMaybe . filter (\v -> branchView v == b) <$> recentViews go _ = return Nothing -branchViewPrefix :: String +branchViewPrefix :: B.ByteString branchViewPrefix = "refs/heads/views" {- Generates a git branch name for a View. @@ -68,10 +71,11 @@ branchViewPrefix = "refs/heads/views" -} branchView :: View -> Git.Branch branchView view - | null name = Git.Ref branchViewPrefix - | otherwise = Git.Ref $ branchViewPrefix ++ "/" ++ name + | B.null name = Git.Ref branchViewPrefix + | otherwise = Git.Ref $ branchViewPrefix <> "/" <> name where - name = intercalate ";" $ map branchcomp (viewComponents view) + name = encodeBS' $ + intercalate ";" $ map branchcomp (viewComponents view) branchcomp c | viewVisible c = branchcomp' c | otherwise = "(" ++ branchcomp' c ++ ")" @@ -92,7 +96,7 @@ branchView view is_branchView :: Git.Branch -> Bool is_branchView (Ref b) | b == branchViewPrefix = True - | otherwise = (branchViewPrefix ++ "/") `isPrefixOf` b + | otherwise = (branchViewPrefix <> "/") `B.isPrefixOf` b prop_branchView_legal :: View -> Bool prop_branchView_legal = Git.Ref.legal False . fromRef . branchView diff --git a/Types/GitConfig.hs b/Types/GitConfig.hs index 91c8701811..35e9ad91c7 100644 --- a/Types/GitConfig.hs +++ b/Types/GitConfig.hs @@ -343,7 +343,7 @@ extractRemoteGitConfig r remotename = do , remoteAnnexReadOnly = getbool "readonly" False , remoteAnnexCheckUUID = getbool "checkuuid" True , remoteAnnexVerify = getbool "verify" True - , remoteAnnexTrackingBranch = Git.Ref <$> + , remoteAnnexTrackingBranch = Git.Ref . encodeBS <$> ( notempty (getmaybe "tracking-branch") <|> notempty (getmaybe "export-tracking") -- old name ) diff --git a/Types/View.hs b/Types/View.hs index 1185afd982..5b3f9d906d 100644 --- a/Types/View.hs +++ b/Types/View.hs @@ -5,6 +5,8 @@ - Licensed under the GNU AGPL version 3 or higher. -} +{-# LANGUAGE OverloadedStrings #-} + module Types.View where import Annex.Common diff --git a/Upgrade/V5/Direct.hs b/Upgrade/V5/Direct.hs index 1fcf8c4eeb..9af32e79ce 100644 --- a/Upgrade/V5/Direct.hs +++ b/Upgrade/V5/Direct.hs @@ -59,7 +59,7 @@ setIndirect = do fromDirectBranch :: Ref -> Ref fromDirectBranch directhead = case splitc '/' $ fromRef directhead of ("refs":"heads":"annex":"direct":rest) -> - Ref $ "refs/heads/" ++ intercalate "/" rest + Ref $ encodeBS' $ "refs/heads/" ++ intercalate "/" rest _ -> directhead switchHEADBack :: Annex ()