diff --git a/Annex/AdjustedBranch.hs b/Annex/AdjustedBranch.hs index 1f1daecbc9..24f60b260d 100644 --- a/Annex/AdjustedBranch.hs +++ b/Annex/AdjustedBranch.hs @@ -5,7 +5,7 @@ - Licensed under the GNU AGPL version 3 or higher. -} -{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE BangPatterns, OverloadedStrings #-} module Annex.AdjustedBranch ( Adjustment(..), @@ -61,6 +61,7 @@ import qualified Database.Keys import Config import qualified Data.Map as M +import qualified Data.ByteString as S -- How to perform various adjustments to a TreeItem. class AdjustTreeItem t where @@ -128,7 +129,7 @@ newtype BasisBranch = BasisBranch Ref -- refs/basis/adjusted/master(unlocked). basisBranch :: AdjBranch -> BasisBranch basisBranch (AdjBranch adjbranch) = BasisBranch $ - Ref ("refs/basis/" ++ fromRef (Git.Ref.base adjbranch)) + Ref ("refs/basis/" <> fromRef' (Git.Ref.base adjbranch)) getAdjustment :: Branch -> Maybe Adjustment getAdjustment = fmap fst . adjustedToOriginal @@ -405,7 +406,8 @@ mergeToAdjustedBranch tomerge (origbranch, adj) mergeconfig canresolvemerge comm <||> (resolveMerge (Just updatedorig) tomerge True <&&> commitResolvedMerge commitmode) if merged then do - !mergecommit <- liftIO $ extractSha <$> readFile (tmpgit "HEAD") + !mergecommit <- liftIO $ extractSha + <$> S.readFile (tmpgit "HEAD") -- This is run after the commit lock is dropped. return $ postmerge mergecommit else return $ return False diff --git a/Annex/Branch.hs b/Annex/Branch.hs index f4b5ce1a1f..5870b6ad21 100644 --- a/Annex/Branch.hs +++ b/Annex/Branch.hs @@ -5,6 +5,8 @@ - Licensed under the GNU AGPL version 3 or higher. -} +{-# LANGUAGE OverloadedStrings #-} + module Annex.Branch ( fullname, name, @@ -57,7 +59,7 @@ import qualified Git.LsTree import Git.LsTree (lsTreeParams) import qualified Git.HashObject import Annex.HashObject -import Git.Types (Ref(..), fromRef, RefDate, TreeItemType(..)) +import Git.Types (Ref(..), fromRef, fromRef', RefDate, TreeItemType(..)) import Git.FilePath import Annex.CatFile import Annex.Perms @@ -79,11 +81,11 @@ name = Git.Ref "git-annex" {- Fully qualified name of the branch. -} fullname :: Git.Ref -fullname = Git.Ref $ "refs/heads/" ++ fromRef name +fullname = Git.Ref $ "refs/heads/" <> fromRef' name {- Branch's name in origin. -} originname :: Git.Ref -originname = Git.Ref $ "origin/" ++ fromRef name +originname = Git.Ref $ "origin/" <> fromRef' name {- Does origin/git-annex exist? -} hasOrigin :: Annex Bool @@ -329,9 +331,9 @@ commitIndex' jl branchref message basemessage retrynum parents = do where -- look for "parent ref" lines and return the refs commitparents = map (Git.Ref . snd) . filter isparent . - map (toassoc . decodeBL) . L.split newline + map (toassoc . L.toStrict) . L.split newline newline = fromIntegral (ord '\n') - toassoc = separate (== ' ') + toassoc = separate' (== (fromIntegral (ord ' '))) isparent (k,_) = k == "parent" {- The race can be detected by checking the commit's @@ -440,8 +442,8 @@ forceUpdateIndex jl branchref = do needUpdateIndex :: Git.Ref -> Annex Bool needUpdateIndex branchref = do f <- fromRepo gitAnnexIndexStatus - committedref <- Git.Ref . firstLine <$> - liftIO (catchDefaultIO "" $ readFileStrict f) + committedref <- Git.Ref . firstLine' <$> + liftIO (catchDefaultIO mempty $ B.readFile f) return (committedref /= branchref) {- Record that the branch's index has been updated to correspond to a @@ -623,11 +625,12 @@ ignoreRefs rs = do unlines $ map fromRef $ S.elems s getIgnoredRefs :: Annex (S.Set Git.Sha) -getIgnoredRefs = S.fromList . mapMaybe Git.Sha.extractSha . lines <$> content +getIgnoredRefs = + S.fromList . mapMaybe Git.Sha.extractSha . B8.lines <$> content where content = do f <- fromRepo gitAnnexIgnoredRefs - liftIO $ catchDefaultIO "" $ readFile f + liftIO $ catchDefaultIO mempty $ B.readFile f addMergedRefs :: [(Git.Sha, Git.Branch)] -> Annex () addMergedRefs [] = return () diff --git a/Annex/Export.hs b/Annex/Export.hs index 16786476de..0d2ff65235 100644 --- a/Annex/Export.hs +++ b/Annex/Export.hs @@ -14,7 +14,6 @@ import Types.Key import qualified Git import qualified Types.Remote as Remote import Messages -import Utility.FileSystemEncoding import Control.Applicative import Data.Maybe @@ -34,7 +33,7 @@ exportKey sha = mk <$> catKey sha where mk (Just k) = AnnexKey k mk Nothing = GitKey $ mkKey $ \k -> k - { keyName = encodeBS $ Git.fromRef sha + { keyName = Git.fromRef' sha , keyVariety = SHA1Key (HasExt False) , keySize = Nothing , keyMtime = Nothing diff --git a/Annex/Import.hs b/Annex/Import.hs index e346ff210e..9d21a27aff 100644 --- a/Annex/Import.hs +++ b/Annex/Import.hs @@ -122,7 +122,9 @@ buildImportCommit remote importtreeconfig importcommitconfig importable = Nothing -> pure committedtree Just dir -> let subtreeref = Ref $ - fromRef committedtree ++ ":" ++ fromRawFilePath (getTopFilePath dir) + fromRef' committedtree + <> ":" + <> getTopFilePath dir in fromMaybe emptyTree <$> inRepo (Git.Ref.tree subtreeref) updateexportdb importedtree diff --git a/Annex/TaggedPush.hs b/Annex/TaggedPush.hs index b2368dba14..cde24cdb74 100644 --- a/Annex/TaggedPush.hs +++ b/Annex/TaggedPush.hs @@ -5,6 +5,8 @@ - Licensed under the GNU AGPL version 3 or higher. -} +{-# LANGUAGE OverloadedStrings #-} + module Annex.TaggedPush where import Annex.Common @@ -16,6 +18,8 @@ import qualified Git.Command import qualified Git.Branch import Utility.Base64 +import qualified Data.ByteString as S + {- Converts a git branch into a branch that is tagged with a UUID, typically - the UUID of the repo that will be pushing it, and possibly with other - information. @@ -31,11 +35,11 @@ import Utility.Base64 - refs, per git-check-ref-format. -} toTaggedBranch :: UUID -> Maybe String -> Git.Branch -> Git.Ref -toTaggedBranch u info b = Git.Ref $ intercalate "/" $ catMaybes +toTaggedBranch u info b = Git.Ref $ S.intercalate "/" $ catMaybes [ Just "refs/synced" , Just $ fromUUID u - , toB64 <$> info - , Just $ Git.fromRef $ Git.Ref.base b + , toB64' . encodeBS <$> info + , Just $ Git.fromRef' $ Git.Ref.base b ] fromTaggedBranch :: Git.Ref -> Maybe (UUID, Maybe String) diff --git a/Assistant/Threads/Merger.hs b/Assistant/Threads/Merger.hs index ac9435122a..49c3956f10 100644 --- a/Assistant/Threads/Merger.hs +++ b/Assistant/Threads/Merger.hs @@ -109,6 +109,6 @@ isAnnexBranch f = n `isSuffixOf` f n = '/' : Git.fromRef Annex.Branch.name fileToBranch :: FilePath -> Git.Ref -fileToBranch f = Git.Ref $ "refs" base +fileToBranch f = Git.Ref $ encodeBS' $ "refs" base where base = Prelude.last $ split "/refs/" f diff --git a/Assistant/Threads/Watcher.hs b/Assistant/Threads/Watcher.hs index 80523b5e55..0956f59ba5 100644 --- a/Assistant/Threads/Watcher.hs +++ b/Assistant/Threads/Watcher.hs @@ -330,7 +330,7 @@ addLink :: FilePath -> FilePath -> Maybe Key -> Assistant (Maybe Change) addLink file link mk = do debug ["add symlink", file] liftAnnex $ do - v <- catObjectDetails $ Ref $ ':':file + v <- catObjectDetails $ Ref $ encodeBS' $ ':':file case v of Just (currlink, sha, _type) | s2w8 link == L.unpack currlink -> diff --git a/Command/Export.hs b/Command/Export.hs index f66c512d25..97c9014f51 100644 --- a/Command/Export.hs +++ b/Command/Export.hs @@ -37,6 +37,7 @@ import Utility.Tmp import Utility.Metered import Utility.Matcher +import qualified Data.ByteString.Char8 as S8 import qualified Data.ByteString.Lazy as L import qualified Data.Map as M import Control.Concurrent @@ -112,7 +113,7 @@ getExportCommit r treeish return (fmap (tb, ) commitsha) | otherwise = return Nothing where - baseref = Ref $ takeWhile (/= ':') $ fromRef $ + baseref = Ref $ S8.takeWhile (/= ':') $ fromRef' $ Git.Ref.removeBase refsheads treeish refsheads = "refs/heads" diff --git a/Command/FindRef.hs b/Command/FindRef.hs index eb74928f4c..27dfcbe07a 100644 --- a/Command/FindRef.hs +++ b/Command/FindRef.hs @@ -22,6 +22,6 @@ seek o = Find.seek o' where o' = o { Find.keyOptions = Just $ WantBranchKeys $ - map Git.Ref (Find.findThese o) + map (Git.Ref . encodeBS') (Find.findThese o) , Find.findThese = [] } diff --git a/Command/Import.hs b/Command/Import.hs index 5447df5bff..5d1c87c320 100644 --- a/Command/Import.hs +++ b/Command/Import.hs @@ -66,7 +66,7 @@ optParser desc = do [bs] -> let (branch, subdir) = separate (== ':') bs in RemoteImportOptions r - (Ref branch) + (Ref (encodeBS' branch)) (if null subdir then Nothing else Just subdir) _ -> giveup "expected BRANCH[:SUBDIR]" diff --git a/Command/Info.hs b/Command/Info.hs index 3448ee6ef2..7df42fa39a 100644 --- a/Command/Info.hs +++ b/Command/Info.hs @@ -181,7 +181,7 @@ dirInfo o dir = showCustom (unwords ["info", dir]) $ do treeishInfo :: InfoOptions -> String -> Annex () treeishInfo o t = do - mi <- getTreeStatInfo o (Git.Ref t) + mi <- getTreeStatInfo o (Git.Ref (encodeBS' t)) case mi of Nothing -> noInfo t Just i -> showCustom (unwords ["info", t]) $ do diff --git a/Command/Log.hs b/Command/Log.hs index 5597bfbf47..b2a7ea7e12 100644 --- a/Command/Log.hs +++ b/Command/Log.hs @@ -264,7 +264,8 @@ parseGitRawLog config = parse epoch parseRawChangeLine :: String -> Maybe (Git.Ref, Git.Ref) parseRawChangeLine = go . words where - go (_:_:oldsha:newsha:_) = Just (Git.Ref oldsha, Git.Ref newsha) + go (_:_:oldsha:newsha:_) = + Just (Git.Ref (encodeBS oldsha), Git.Ref (encodeBS newsha)) go _ = Nothing parseTimeStamp :: String -> POSIXTime diff --git a/Command/Merge.hs b/Command/Merge.hs index fe1119dc8a..ed075ad876 100644 --- a/Command/Merge.hs +++ b/Command/Merge.hs @@ -26,7 +26,7 @@ seek [] = do commandAction mergeSyncedBranch seek bs = do prepMerge - forM_ bs (commandAction . mergeBranch . Git.Ref) + forM_ bs (commandAction . mergeBranch . Git.Ref . encodeBS') mergeAnnexBranch :: CommandStart mergeAnnexBranch = starting "merge" (ActionItemOther (Just "git-annex")) $ do diff --git a/Command/ResolveMerge.hs b/Command/ResolveMerge.hs index e3d9829be8..10f5f98901 100644 --- a/Command/ResolveMerge.hs +++ b/Command/ResolveMerge.hs @@ -13,6 +13,8 @@ import Git.Sha import qualified Git.Branch import Annex.AutoMerge +import qualified Data.ByteString as S + cmd :: Command cmd = command "resolvemerge" SectionPlumbing "resolve merge conflicts" @@ -27,7 +29,7 @@ start = starting "resolvemerge" (ActionItemOther Nothing) $ do d <- fromRawFilePath <$> fromRepo Git.localGitDir let merge_head = d "MERGE_HEAD" them <- fromMaybe (error nomergehead) . extractSha - <$> liftIO (readFile merge_head) + <$> liftIO (S.readFile merge_head) ifM (resolveMerge (Just us) them False) ( do void $ commitResolvedMerge Git.Branch.ManualCommit diff --git a/Command/Sync.hs b/Command/Sync.hs index 49ec61cb52..42afe518a9 100644 --- a/Command/Sync.hs +++ b/Command/Sync.hs @@ -72,6 +72,8 @@ import Utility.Process.Transcript import Control.Concurrent.MVar import qualified Data.Map as M +import qualified Data.ByteString as S +import Data.Char cmd :: Command cmd = withGlobalOptions [jobsOption] $ @@ -444,11 +446,11 @@ importRemote o mergeconfig remote currbranch | otherwise = case remoteAnnexTrackingBranch (Remote.gitconfig remote) of Nothing -> noop Just tb -> do - let (b, s) = separate (== ':') (Git.fromRef tb) + let (b, p) = separate' (== (fromIntegral (ord ':'))) (Git.fromRef' tb) let branch = Git.Ref b - let subdir = if null s + let subdir = if S.null p then Nothing - else Just (asTopFilePath (toRawFilePath s)) + else Just (asTopFilePath p) Command.Import.seekRemote remote branch subdir void $ mergeRemote remote currbranch mergeconfig o where diff --git a/Command/Uninit.hs b/Command/Uninit.hs index c64d4aa2dc..db7d25a7a8 100644 --- a/Command/Uninit.hs +++ b/Command/Uninit.hs @@ -35,7 +35,7 @@ check = do whenM ((/=) <$> liftIO (absPath top) <*> liftIO (absPath currdir)) $ giveup "can only run uninit from the top of the git repository" where - current_branch = Git.Ref . Prelude.head . lines . decodeBS' <$> revhead + current_branch = Git.Ref . encodeBS' . Prelude.head . lines . decodeBS' <$> revhead revhead = inRepo $ Git.Command.pipeReadStrict [Param "rev-parse", Param "--abbrev-ref", Param "HEAD"] diff --git a/Command/Unused.hs b/Command/Unused.hs index b68452d5c8..4b2de82597 100644 --- a/Command/Unused.hs +++ b/Command/Unused.hs @@ -5,12 +5,10 @@ - Licensed under the GNU AGPL version 3 or higher. -} -{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE BangPatterns, OverloadedStrings #-} module Command.Unused where -import qualified Data.Map as M - import Command import Logs.Unused import Annex.Content @@ -37,6 +35,11 @@ import Annex.BloomFilter import qualified Database.Keys import Annex.InodeSentinal +import qualified Data.Map as M +import qualified Data.ByteString as S +import qualified Data.ByteString.Char8 as S8 +import Data.Char + cmd :: Command cmd = command "unused" SectionMaintenance "look for unused file content" paramNothing (seek <$$> optParser) @@ -221,8 +224,7 @@ withKeysReferenced' mdir initial a = do withKeysReferencedDiffGitRefs :: RefSpec -> (Key -> Annex ()) -> Annex () withKeysReferencedDiffGitRefs refspec a = do - rs <- relevantrefs . decodeBS' - <$> inRepo (Git.Command.pipeReadStrict [Param "show-ref"]) + rs <- relevantrefs <$> inRepo (Git.Command.pipeReadStrict [Param "show-ref"]) shaHead <- maybe (return Nothing) (inRepo . Git.Ref.sha) =<< inRepo Git.Branch.currentUnsafe let haveHead = any (\(shaRef, _) -> Just shaRef == shaHead) rs @@ -233,12 +235,12 @@ withKeysReferencedDiffGitRefs refspec a = do where relevantrefs = map (\(r, h) -> (Git.Ref r, Git.Ref h)) . filter ourbranches . - map (separate (== ' ')) . - lines + map (separate' (== (fromIntegral (ord ' ')))) . + S8.lines nubRefs = nubBy (\(x, _) (y, _) -> x == y) - ourbranchend = '/' : Git.fromRef Annex.Branch.name - ourbranches (_, b) = not (ourbranchend `isSuffixOf` b) - && not ("refs/synced/" `isPrefixOf` b) + ourbranchend = S.cons (fromIntegral (ord '/')) (Git.fromRef' Annex.Branch.name) + ourbranches (_, b) = not (ourbranchend `S.isSuffixOf` b) + && not ("refs/synced/" `S.isPrefixOf` b) && not (is_branchView (Git.Ref b)) getreflog rs = inRepo $ Git.RefLog.getMulti rs diff --git a/Git/Ref.hs b/Git/Ref.hs index 33922d1e30..104a1db715 100644 --- a/Git/Ref.hs +++ b/Git/Ref.hs @@ -26,7 +26,7 @@ headFile :: Repo -> FilePath headFile r = fromRawFilePath (localGitDir r) "HEAD" setHeadRef :: Ref -> Repo -> IO () -setHeadRef ref r = writeFile (headFile r) ("ref: " ++ fromRef ref) +setHeadRef ref r = S.writeFile (headFile r) ("ref: " <> fromRef' ref) {- Converts a fully qualified git ref into a user-visible string. -} describe :: Ref -> String @@ -55,7 +55,7 @@ removeBase dir r - refs/heads/master, yields a version of that ref under the directory, - such as refs/remotes/origin/master. -} underBase :: String -> Ref -> Ref -underBase dir r = Ref $ encodeBS' $ dir ++ "/" ++ fromRef (base r) +underBase dir r = Ref $ encodeBS dir <> "/" <> fromRef' (base r) {- Convert a branch such as "master" into a fully qualified ref. -} branchRef :: Branch -> Ref diff --git a/Logs/Export.hs b/Logs/Export.hs index aadd1b9c4a..586c789e86 100644 --- a/Logs/Export.hs +++ b/Logs/Export.hs @@ -158,12 +158,12 @@ buildExported exported = go (exportedTreeish exported : incompleteExportedTreeis where go [] = mempty go (r:rs) = rref r <> mconcat [ charUtf8 ' ' <> rref r' | r' <- rs ] - rref r = byteString (encodeBS' (Git.fromRef r)) + rref = byteString . Git.fromRef' exportedParser :: A.Parser Exported exportedParser = Exported <$> refparser <*> many refparser where - refparser = (Git.Ref . decodeBS <$> A8.takeWhile1 (/= ' ') ) + refparser = (Git.Ref <$> A8.takeWhile1 (/= ' ') ) <* ((const () <$> A8.char ' ') <|> A.endOfInput) logExportExcluded :: UUID -> ((Git.Tree.TreeItem -> IO ()) -> Annex a) -> Annex a diff --git a/Test.hs b/Test.hs index 29f891dc4e..04d36424e9 100644 --- a/Test.hs +++ b/Test.hs @@ -1664,7 +1664,7 @@ test_add_subdirs = intmpclonerepo $ do unlessM (hasUnlockedFiles <$> getTestMode) $ do git_annex "sync" [] @? "sync failed" l <- annexeval $ Utility.FileSystemEncoding.decodeBL - <$> Annex.CatFile.catObject (Git.Types.Ref "HEAD:dir/foo") + <$> Annex.CatFile.catObject (Git.Types.Ref (encodeBS "HEAD:dir/foo")) "../.git/annex/" `isPrefixOf` l @? ("symlink from subdir to .git/annex is wrong: " ++ l) createDirectory "dir2" diff --git a/Upgrade/V2.hs b/Upgrade/V2.hs index 4a70a05d1a..24d92e4ffc 100644 --- a/Upgrade/V2.hs +++ b/Upgrade/V2.hs @@ -92,7 +92,8 @@ logFiles dir = return . filter (".log" `isSuffixOf`) push :: Annex () push = do - origin_master <- inRepo $ Git.Ref.exists $ Git.Ref "origin/master" + origin_master <- inRepo $ Git.Ref.exists $ + Git.Ref $ encodeBS' "origin/master" origin_gitannex <- Annex.Branch.hasOrigin case (origin_master, origin_gitannex) of (_, True) -> do diff --git a/doc/todo/optimise_by_converting_Ref_to_ByteString.mdwn b/doc/todo/optimise_by_converting_Ref_to_ByteString.mdwn index 6434c4de3d..8b9f79c2da 100644 --- a/doc/todo/optimise_by_converting_Ref_to_ByteString.mdwn +++ b/doc/todo/optimise_by_converting_Ref_to_ByteString.mdwn @@ -3,3 +3,9 @@ to contain a ByteString, rather than a String, would eliminate a fromRawFilePath that uses about 1% of runtime. [[!tag confirmed]] + +> Well, I did the conversion. Running that command does not seem to have +> sped up by any appreciable amount. But, I did notice several places where +> using ByteString is certainly more efficient. It may just be that it +> doesn't matter if git-annex is IO bound etc. Still, glad I did it. +> [[done]] --[[Joey]]