Ref ByteString conversion done

Test suite passes.
This commit is contained in:
Joey Hess 2020-04-07 17:41:09 -04:00
parent 6c81e0c8f1
commit c0cd07c36b
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
22 changed files with 72 additions and 47 deletions

View file

@ -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

View file

@ -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 ()

View file

@ -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

View file

@ -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

View file

@ -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)

View file

@ -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

View file

@ -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 ->

View file

@ -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"

View file

@ -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 = []
}

View file

@ -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]"

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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"]

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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"

View file

@ -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

View file

@ -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]]