Ref ByteString conversion done
Test suite passes.
This commit is contained in:
parent
6c81e0c8f1
commit
c0cd07c36b
22 changed files with 72 additions and 47 deletions
|
@ -5,7 +5,7 @@
|
||||||
- Licensed under the GNU AGPL version 3 or higher.
|
- Licensed under the GNU AGPL version 3 or higher.
|
||||||
-}
|
-}
|
||||||
|
|
||||||
{-# LANGUAGE BangPatterns #-}
|
{-# LANGUAGE BangPatterns, OverloadedStrings #-}
|
||||||
|
|
||||||
module Annex.AdjustedBranch (
|
module Annex.AdjustedBranch (
|
||||||
Adjustment(..),
|
Adjustment(..),
|
||||||
|
@ -61,6 +61,7 @@ import qualified Database.Keys
|
||||||
import Config
|
import Config
|
||||||
|
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
|
import qualified Data.ByteString as S
|
||||||
|
|
||||||
-- How to perform various adjustments to a TreeItem.
|
-- How to perform various adjustments to a TreeItem.
|
||||||
class AdjustTreeItem t where
|
class AdjustTreeItem t where
|
||||||
|
@ -128,7 +129,7 @@ newtype BasisBranch = BasisBranch Ref
|
||||||
-- refs/basis/adjusted/master(unlocked).
|
-- refs/basis/adjusted/master(unlocked).
|
||||||
basisBranch :: AdjBranch -> BasisBranch
|
basisBranch :: AdjBranch -> BasisBranch
|
||||||
basisBranch (AdjBranch 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 :: Branch -> Maybe Adjustment
|
||||||
getAdjustment = fmap fst . adjustedToOriginal
|
getAdjustment = fmap fst . adjustedToOriginal
|
||||||
|
@ -405,7 +406,8 @@ mergeToAdjustedBranch tomerge (origbranch, adj) mergeconfig canresolvemerge comm
|
||||||
<||> (resolveMerge (Just updatedorig) tomerge True <&&> commitResolvedMerge commitmode)
|
<||> (resolveMerge (Just updatedorig) tomerge True <&&> commitResolvedMerge commitmode)
|
||||||
if merged
|
if merged
|
||||||
then do
|
then do
|
||||||
!mergecommit <- liftIO $ extractSha <$> readFile (tmpgit </> "HEAD")
|
!mergecommit <- liftIO $ extractSha
|
||||||
|
<$> S.readFile (tmpgit </> "HEAD")
|
||||||
-- This is run after the commit lock is dropped.
|
-- This is run after the commit lock is dropped.
|
||||||
return $ postmerge mergecommit
|
return $ postmerge mergecommit
|
||||||
else return $ return False
|
else return $ return False
|
||||||
|
|
|
@ -5,6 +5,8 @@
|
||||||
- Licensed under the GNU AGPL version 3 or higher.
|
- Licensed under the GNU AGPL version 3 or higher.
|
||||||
-}
|
-}
|
||||||
|
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
module Annex.Branch (
|
module Annex.Branch (
|
||||||
fullname,
|
fullname,
|
||||||
name,
|
name,
|
||||||
|
@ -57,7 +59,7 @@ import qualified Git.LsTree
|
||||||
import Git.LsTree (lsTreeParams)
|
import Git.LsTree (lsTreeParams)
|
||||||
import qualified Git.HashObject
|
import qualified Git.HashObject
|
||||||
import Annex.HashObject
|
import Annex.HashObject
|
||||||
import Git.Types (Ref(..), fromRef, RefDate, TreeItemType(..))
|
import Git.Types (Ref(..), fromRef, fromRef', RefDate, TreeItemType(..))
|
||||||
import Git.FilePath
|
import Git.FilePath
|
||||||
import Annex.CatFile
|
import Annex.CatFile
|
||||||
import Annex.Perms
|
import Annex.Perms
|
||||||
|
@ -79,11 +81,11 @@ name = Git.Ref "git-annex"
|
||||||
|
|
||||||
{- Fully qualified name of the branch. -}
|
{- Fully qualified name of the branch. -}
|
||||||
fullname :: Git.Ref
|
fullname :: Git.Ref
|
||||||
fullname = Git.Ref $ "refs/heads/" ++ fromRef name
|
fullname = Git.Ref $ "refs/heads/" <> fromRef' name
|
||||||
|
|
||||||
{- Branch's name in origin. -}
|
{- Branch's name in origin. -}
|
||||||
originname :: Git.Ref
|
originname :: Git.Ref
|
||||||
originname = Git.Ref $ "origin/" ++ fromRef name
|
originname = Git.Ref $ "origin/" <> fromRef' name
|
||||||
|
|
||||||
{- Does origin/git-annex exist? -}
|
{- Does origin/git-annex exist? -}
|
||||||
hasOrigin :: Annex Bool
|
hasOrigin :: Annex Bool
|
||||||
|
@ -329,9 +331,9 @@ commitIndex' jl branchref message basemessage retrynum parents = do
|
||||||
where
|
where
|
||||||
-- look for "parent ref" lines and return the refs
|
-- look for "parent ref" lines and return the refs
|
||||||
commitparents = map (Git.Ref . snd) . filter isparent .
|
commitparents = map (Git.Ref . snd) . filter isparent .
|
||||||
map (toassoc . decodeBL) . L.split newline
|
map (toassoc . L.toStrict) . L.split newline
|
||||||
newline = fromIntegral (ord '\n')
|
newline = fromIntegral (ord '\n')
|
||||||
toassoc = separate (== ' ')
|
toassoc = separate' (== (fromIntegral (ord ' ')))
|
||||||
isparent (k,_) = k == "parent"
|
isparent (k,_) = k == "parent"
|
||||||
|
|
||||||
{- The race can be detected by checking the commit's
|
{- The race can be detected by checking the commit's
|
||||||
|
@ -440,8 +442,8 @@ forceUpdateIndex jl branchref = do
|
||||||
needUpdateIndex :: Git.Ref -> Annex Bool
|
needUpdateIndex :: Git.Ref -> Annex Bool
|
||||||
needUpdateIndex branchref = do
|
needUpdateIndex branchref = do
|
||||||
f <- fromRepo gitAnnexIndexStatus
|
f <- fromRepo gitAnnexIndexStatus
|
||||||
committedref <- Git.Ref . firstLine <$>
|
committedref <- Git.Ref . firstLine' <$>
|
||||||
liftIO (catchDefaultIO "" $ readFileStrict f)
|
liftIO (catchDefaultIO mempty $ B.readFile f)
|
||||||
return (committedref /= branchref)
|
return (committedref /= branchref)
|
||||||
|
|
||||||
{- Record that the branch's index has been updated to correspond to a
|
{- 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
|
unlines $ map fromRef $ S.elems s
|
||||||
|
|
||||||
getIgnoredRefs :: Annex (S.Set Git.Sha)
|
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
|
where
|
||||||
content = do
|
content = do
|
||||||
f <- fromRepo gitAnnexIgnoredRefs
|
f <- fromRepo gitAnnexIgnoredRefs
|
||||||
liftIO $ catchDefaultIO "" $ readFile f
|
liftIO $ catchDefaultIO mempty $ B.readFile f
|
||||||
|
|
||||||
addMergedRefs :: [(Git.Sha, Git.Branch)] -> Annex ()
|
addMergedRefs :: [(Git.Sha, Git.Branch)] -> Annex ()
|
||||||
addMergedRefs [] = return ()
|
addMergedRefs [] = return ()
|
||||||
|
|
|
@ -14,7 +14,6 @@ import Types.Key
|
||||||
import qualified Git
|
import qualified Git
|
||||||
import qualified Types.Remote as Remote
|
import qualified Types.Remote as Remote
|
||||||
import Messages
|
import Messages
|
||||||
import Utility.FileSystemEncoding
|
|
||||||
|
|
||||||
import Control.Applicative
|
import Control.Applicative
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
|
@ -34,7 +33,7 @@ exportKey sha = mk <$> catKey sha
|
||||||
where
|
where
|
||||||
mk (Just k) = AnnexKey k
|
mk (Just k) = AnnexKey k
|
||||||
mk Nothing = GitKey $ mkKey $ \k -> k
|
mk Nothing = GitKey $ mkKey $ \k -> k
|
||||||
{ keyName = encodeBS $ Git.fromRef sha
|
{ keyName = Git.fromRef' sha
|
||||||
, keyVariety = SHA1Key (HasExt False)
|
, keyVariety = SHA1Key (HasExt False)
|
||||||
, keySize = Nothing
|
, keySize = Nothing
|
||||||
, keyMtime = Nothing
|
, keyMtime = Nothing
|
||||||
|
|
|
@ -122,7 +122,9 @@ buildImportCommit remote importtreeconfig importcommitconfig importable =
|
||||||
Nothing -> pure committedtree
|
Nothing -> pure committedtree
|
||||||
Just dir ->
|
Just dir ->
|
||||||
let subtreeref = Ref $
|
let subtreeref = Ref $
|
||||||
fromRef committedtree ++ ":" ++ fromRawFilePath (getTopFilePath dir)
|
fromRef' committedtree
|
||||||
|
<> ":"
|
||||||
|
<> getTopFilePath dir
|
||||||
in fromMaybe emptyTree
|
in fromMaybe emptyTree
|
||||||
<$> inRepo (Git.Ref.tree subtreeref)
|
<$> inRepo (Git.Ref.tree subtreeref)
|
||||||
updateexportdb importedtree
|
updateexportdb importedtree
|
||||||
|
|
|
@ -5,6 +5,8 @@
|
||||||
- Licensed under the GNU AGPL version 3 or higher.
|
- Licensed under the GNU AGPL version 3 or higher.
|
||||||
-}
|
-}
|
||||||
|
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
module Annex.TaggedPush where
|
module Annex.TaggedPush where
|
||||||
|
|
||||||
import Annex.Common
|
import Annex.Common
|
||||||
|
@ -16,6 +18,8 @@ import qualified Git.Command
|
||||||
import qualified Git.Branch
|
import qualified Git.Branch
|
||||||
import Utility.Base64
|
import Utility.Base64
|
||||||
|
|
||||||
|
import qualified Data.ByteString as S
|
||||||
|
|
||||||
{- Converts a git branch into a branch that is tagged with a UUID, typically
|
{- 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
|
- the UUID of the repo that will be pushing it, and possibly with other
|
||||||
- information.
|
- information.
|
||||||
|
@ -31,11 +35,11 @@ import Utility.Base64
|
||||||
- refs, per git-check-ref-format.
|
- refs, per git-check-ref-format.
|
||||||
-}
|
-}
|
||||||
toTaggedBranch :: UUID -> Maybe String -> Git.Branch -> Git.Ref
|
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 "refs/synced"
|
||||||
, Just $ fromUUID u
|
, Just $ fromUUID u
|
||||||
, toB64 <$> info
|
, toB64' . encodeBS <$> info
|
||||||
, Just $ Git.fromRef $ Git.Ref.base b
|
, Just $ Git.fromRef' $ Git.Ref.base b
|
||||||
]
|
]
|
||||||
|
|
||||||
fromTaggedBranch :: Git.Ref -> Maybe (UUID, Maybe String)
|
fromTaggedBranch :: Git.Ref -> Maybe (UUID, Maybe String)
|
||||||
|
|
|
@ -109,6 +109,6 @@ isAnnexBranch f = n `isSuffixOf` f
|
||||||
n = '/' : Git.fromRef Annex.Branch.name
|
n = '/' : Git.fromRef Annex.Branch.name
|
||||||
|
|
||||||
fileToBranch :: FilePath -> Git.Ref
|
fileToBranch :: FilePath -> Git.Ref
|
||||||
fileToBranch f = Git.Ref $ "refs" </> base
|
fileToBranch f = Git.Ref $ encodeBS' $ "refs" </> base
|
||||||
where
|
where
|
||||||
base = Prelude.last $ split "/refs/" f
|
base = Prelude.last $ split "/refs/" f
|
||||||
|
|
|
@ -330,7 +330,7 @@ addLink :: FilePath -> FilePath -> Maybe Key -> Assistant (Maybe Change)
|
||||||
addLink file link mk = do
|
addLink file link mk = do
|
||||||
debug ["add symlink", file]
|
debug ["add symlink", file]
|
||||||
liftAnnex $ do
|
liftAnnex $ do
|
||||||
v <- catObjectDetails $ Ref $ ':':file
|
v <- catObjectDetails $ Ref $ encodeBS' $ ':':file
|
||||||
case v of
|
case v of
|
||||||
Just (currlink, sha, _type)
|
Just (currlink, sha, _type)
|
||||||
| s2w8 link == L.unpack currlink ->
|
| s2w8 link == L.unpack currlink ->
|
||||||
|
|
|
@ -37,6 +37,7 @@ import Utility.Tmp
|
||||||
import Utility.Metered
|
import Utility.Metered
|
||||||
import Utility.Matcher
|
import Utility.Matcher
|
||||||
|
|
||||||
|
import qualified Data.ByteString.Char8 as S8
|
||||||
import qualified Data.ByteString.Lazy as L
|
import qualified Data.ByteString.Lazy as L
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Control.Concurrent
|
import Control.Concurrent
|
||||||
|
@ -112,7 +113,7 @@ getExportCommit r treeish
|
||||||
return (fmap (tb, ) commitsha)
|
return (fmap (tb, ) commitsha)
|
||||||
| otherwise = return Nothing
|
| otherwise = return Nothing
|
||||||
where
|
where
|
||||||
baseref = Ref $ takeWhile (/= ':') $ fromRef $
|
baseref = Ref $ S8.takeWhile (/= ':') $ fromRef' $
|
||||||
Git.Ref.removeBase refsheads treeish
|
Git.Ref.removeBase refsheads treeish
|
||||||
refsheads = "refs/heads"
|
refsheads = "refs/heads"
|
||||||
|
|
||||||
|
|
|
@ -22,6 +22,6 @@ seek o = Find.seek o'
|
||||||
where
|
where
|
||||||
o' = o
|
o' = o
|
||||||
{ Find.keyOptions = Just $ WantBranchKeys $
|
{ Find.keyOptions = Just $ WantBranchKeys $
|
||||||
map Git.Ref (Find.findThese o)
|
map (Git.Ref . encodeBS') (Find.findThese o)
|
||||||
, Find.findThese = []
|
, Find.findThese = []
|
||||||
}
|
}
|
||||||
|
|
|
@ -66,7 +66,7 @@ optParser desc = do
|
||||||
[bs] ->
|
[bs] ->
|
||||||
let (branch, subdir) = separate (== ':') bs
|
let (branch, subdir) = separate (== ':') bs
|
||||||
in RemoteImportOptions r
|
in RemoteImportOptions r
|
||||||
(Ref branch)
|
(Ref (encodeBS' branch))
|
||||||
(if null subdir then Nothing else Just subdir)
|
(if null subdir then Nothing else Just subdir)
|
||||||
_ -> giveup "expected BRANCH[:SUBDIR]"
|
_ -> giveup "expected BRANCH[:SUBDIR]"
|
||||||
|
|
||||||
|
|
|
@ -181,7 +181,7 @@ dirInfo o dir = showCustom (unwords ["info", dir]) $ do
|
||||||
|
|
||||||
treeishInfo :: InfoOptions -> String -> Annex ()
|
treeishInfo :: InfoOptions -> String -> Annex ()
|
||||||
treeishInfo o t = do
|
treeishInfo o t = do
|
||||||
mi <- getTreeStatInfo o (Git.Ref t)
|
mi <- getTreeStatInfo o (Git.Ref (encodeBS' t))
|
||||||
case mi of
|
case mi of
|
||||||
Nothing -> noInfo t
|
Nothing -> noInfo t
|
||||||
Just i -> showCustom (unwords ["info", t]) $ do
|
Just i -> showCustom (unwords ["info", t]) $ do
|
||||||
|
|
|
@ -264,7 +264,8 @@ parseGitRawLog config = parse epoch
|
||||||
parseRawChangeLine :: String -> Maybe (Git.Ref, Git.Ref)
|
parseRawChangeLine :: String -> Maybe (Git.Ref, Git.Ref)
|
||||||
parseRawChangeLine = go . words
|
parseRawChangeLine = go . words
|
||||||
where
|
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
|
go _ = Nothing
|
||||||
|
|
||||||
parseTimeStamp :: String -> POSIXTime
|
parseTimeStamp :: String -> POSIXTime
|
||||||
|
|
|
@ -26,7 +26,7 @@ seek [] = do
|
||||||
commandAction mergeSyncedBranch
|
commandAction mergeSyncedBranch
|
||||||
seek bs = do
|
seek bs = do
|
||||||
prepMerge
|
prepMerge
|
||||||
forM_ bs (commandAction . mergeBranch . Git.Ref)
|
forM_ bs (commandAction . mergeBranch . Git.Ref . encodeBS')
|
||||||
|
|
||||||
mergeAnnexBranch :: CommandStart
|
mergeAnnexBranch :: CommandStart
|
||||||
mergeAnnexBranch = starting "merge" (ActionItemOther (Just "git-annex")) $ do
|
mergeAnnexBranch = starting "merge" (ActionItemOther (Just "git-annex")) $ do
|
||||||
|
|
|
@ -13,6 +13,8 @@ import Git.Sha
|
||||||
import qualified Git.Branch
|
import qualified Git.Branch
|
||||||
import Annex.AutoMerge
|
import Annex.AutoMerge
|
||||||
|
|
||||||
|
import qualified Data.ByteString as S
|
||||||
|
|
||||||
cmd :: Command
|
cmd :: Command
|
||||||
cmd = command "resolvemerge" SectionPlumbing
|
cmd = command "resolvemerge" SectionPlumbing
|
||||||
"resolve merge conflicts"
|
"resolve merge conflicts"
|
||||||
|
@ -27,7 +29,7 @@ start = starting "resolvemerge" (ActionItemOther Nothing) $ do
|
||||||
d <- fromRawFilePath <$> fromRepo Git.localGitDir
|
d <- fromRawFilePath <$> fromRepo Git.localGitDir
|
||||||
let merge_head = d </> "MERGE_HEAD"
|
let merge_head = d </> "MERGE_HEAD"
|
||||||
them <- fromMaybe (error nomergehead) . extractSha
|
them <- fromMaybe (error nomergehead) . extractSha
|
||||||
<$> liftIO (readFile merge_head)
|
<$> liftIO (S.readFile merge_head)
|
||||||
ifM (resolveMerge (Just us) them False)
|
ifM (resolveMerge (Just us) them False)
|
||||||
( do
|
( do
|
||||||
void $ commitResolvedMerge Git.Branch.ManualCommit
|
void $ commitResolvedMerge Git.Branch.ManualCommit
|
||||||
|
|
|
@ -72,6 +72,8 @@ import Utility.Process.Transcript
|
||||||
|
|
||||||
import Control.Concurrent.MVar
|
import Control.Concurrent.MVar
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
|
import qualified Data.ByteString as S
|
||||||
|
import Data.Char
|
||||||
|
|
||||||
cmd :: Command
|
cmd :: Command
|
||||||
cmd = withGlobalOptions [jobsOption] $
|
cmd = withGlobalOptions [jobsOption] $
|
||||||
|
@ -444,11 +446,11 @@ importRemote o mergeconfig remote currbranch
|
||||||
| otherwise = case remoteAnnexTrackingBranch (Remote.gitconfig remote) of
|
| otherwise = case remoteAnnexTrackingBranch (Remote.gitconfig remote) of
|
||||||
Nothing -> noop
|
Nothing -> noop
|
||||||
Just tb -> do
|
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 branch = Git.Ref b
|
||||||
let subdir = if null s
|
let subdir = if S.null p
|
||||||
then Nothing
|
then Nothing
|
||||||
else Just (asTopFilePath (toRawFilePath s))
|
else Just (asTopFilePath p)
|
||||||
Command.Import.seekRemote remote branch subdir
|
Command.Import.seekRemote remote branch subdir
|
||||||
void $ mergeRemote remote currbranch mergeconfig o
|
void $ mergeRemote remote currbranch mergeconfig o
|
||||||
where
|
where
|
||||||
|
|
|
@ -35,7 +35,7 @@ check = do
|
||||||
whenM ((/=) <$> liftIO (absPath top) <*> liftIO (absPath currdir)) $
|
whenM ((/=) <$> liftIO (absPath top) <*> liftIO (absPath currdir)) $
|
||||||
giveup "can only run uninit from the top of the git repository"
|
giveup "can only run uninit from the top of the git repository"
|
||||||
where
|
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
|
revhead = inRepo $ Git.Command.pipeReadStrict
|
||||||
[Param "rev-parse", Param "--abbrev-ref", Param "HEAD"]
|
[Param "rev-parse", Param "--abbrev-ref", Param "HEAD"]
|
||||||
|
|
||||||
|
|
|
@ -5,12 +5,10 @@
|
||||||
- Licensed under the GNU AGPL version 3 or higher.
|
- Licensed under the GNU AGPL version 3 or higher.
|
||||||
-}
|
-}
|
||||||
|
|
||||||
{-# LANGUAGE BangPatterns #-}
|
{-# LANGUAGE BangPatterns, OverloadedStrings #-}
|
||||||
|
|
||||||
module Command.Unused where
|
module Command.Unused where
|
||||||
|
|
||||||
import qualified Data.Map as M
|
|
||||||
|
|
||||||
import Command
|
import Command
|
||||||
import Logs.Unused
|
import Logs.Unused
|
||||||
import Annex.Content
|
import Annex.Content
|
||||||
|
@ -37,6 +35,11 @@ import Annex.BloomFilter
|
||||||
import qualified Database.Keys
|
import qualified Database.Keys
|
||||||
import Annex.InodeSentinal
|
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
|
||||||
cmd = command "unused" SectionMaintenance "look for unused file content"
|
cmd = command "unused" SectionMaintenance "look for unused file content"
|
||||||
paramNothing (seek <$$> optParser)
|
paramNothing (seek <$$> optParser)
|
||||||
|
@ -221,8 +224,7 @@ withKeysReferenced' mdir initial a = do
|
||||||
|
|
||||||
withKeysReferencedDiffGitRefs :: RefSpec -> (Key -> Annex ()) -> Annex ()
|
withKeysReferencedDiffGitRefs :: RefSpec -> (Key -> Annex ()) -> Annex ()
|
||||||
withKeysReferencedDiffGitRefs refspec a = do
|
withKeysReferencedDiffGitRefs refspec a = do
|
||||||
rs <- relevantrefs . decodeBS'
|
rs <- relevantrefs <$> inRepo (Git.Command.pipeReadStrict [Param "show-ref"])
|
||||||
<$> inRepo (Git.Command.pipeReadStrict [Param "show-ref"])
|
|
||||||
shaHead <- maybe (return Nothing) (inRepo . Git.Ref.sha)
|
shaHead <- maybe (return Nothing) (inRepo . Git.Ref.sha)
|
||||||
=<< inRepo Git.Branch.currentUnsafe
|
=<< inRepo Git.Branch.currentUnsafe
|
||||||
let haveHead = any (\(shaRef, _) -> Just shaRef == shaHead) rs
|
let haveHead = any (\(shaRef, _) -> Just shaRef == shaHead) rs
|
||||||
|
@ -233,12 +235,12 @@ withKeysReferencedDiffGitRefs refspec a = do
|
||||||
where
|
where
|
||||||
relevantrefs = map (\(r, h) -> (Git.Ref r, Git.Ref h)) .
|
relevantrefs = map (\(r, h) -> (Git.Ref r, Git.Ref h)) .
|
||||||
filter ourbranches .
|
filter ourbranches .
|
||||||
map (separate (== ' ')) .
|
map (separate' (== (fromIntegral (ord ' ')))) .
|
||||||
lines
|
S8.lines
|
||||||
nubRefs = nubBy (\(x, _) (y, _) -> x == y)
|
nubRefs = nubBy (\(x, _) (y, _) -> x == y)
|
||||||
ourbranchend = '/' : Git.fromRef Annex.Branch.name
|
ourbranchend = S.cons (fromIntegral (ord '/')) (Git.fromRef' Annex.Branch.name)
|
||||||
ourbranches (_, b) = not (ourbranchend `isSuffixOf` b)
|
ourbranches (_, b) = not (ourbranchend `S.isSuffixOf` b)
|
||||||
&& not ("refs/synced/" `isPrefixOf` b)
|
&& not ("refs/synced/" `S.isPrefixOf` b)
|
||||||
&& not (is_branchView (Git.Ref b))
|
&& not (is_branchView (Git.Ref b))
|
||||||
getreflog rs = inRepo $ Git.RefLog.getMulti rs
|
getreflog rs = inRepo $ Git.RefLog.getMulti rs
|
||||||
|
|
||||||
|
|
|
@ -26,7 +26,7 @@ headFile :: Repo -> FilePath
|
||||||
headFile r = fromRawFilePath (localGitDir r) </> "HEAD"
|
headFile r = fromRawFilePath (localGitDir r) </> "HEAD"
|
||||||
|
|
||||||
setHeadRef :: Ref -> Repo -> IO ()
|
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. -}
|
{- Converts a fully qualified git ref into a user-visible string. -}
|
||||||
describe :: Ref -> String
|
describe :: Ref -> String
|
||||||
|
@ -55,7 +55,7 @@ removeBase dir r
|
||||||
- refs/heads/master, yields a version of that ref under the directory,
|
- refs/heads/master, yields a version of that ref under the directory,
|
||||||
- such as refs/remotes/origin/master. -}
|
- such as refs/remotes/origin/master. -}
|
||||||
underBase :: String -> Ref -> Ref
|
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. -}
|
{- Convert a branch such as "master" into a fully qualified ref. -}
|
||||||
branchRef :: Branch -> Ref
|
branchRef :: Branch -> Ref
|
||||||
|
|
|
@ -158,12 +158,12 @@ buildExported exported = go (exportedTreeish exported : incompleteExportedTreeis
|
||||||
where
|
where
|
||||||
go [] = mempty
|
go [] = mempty
|
||||||
go (r:rs) = rref r <> mconcat [ charUtf8 ' ' <> rref r' | r' <- rs ]
|
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 :: A.Parser Exported
|
||||||
exportedParser = Exported <$> refparser <*> many refparser
|
exportedParser = Exported <$> refparser <*> many refparser
|
||||||
where
|
where
|
||||||
refparser = (Git.Ref . decodeBS <$> A8.takeWhile1 (/= ' ') )
|
refparser = (Git.Ref <$> A8.takeWhile1 (/= ' ') )
|
||||||
<* ((const () <$> A8.char ' ') <|> A.endOfInput)
|
<* ((const () <$> A8.char ' ') <|> A.endOfInput)
|
||||||
|
|
||||||
logExportExcluded :: UUID -> ((Git.Tree.TreeItem -> IO ()) -> Annex a) -> Annex a
|
logExportExcluded :: UUID -> ((Git.Tree.TreeItem -> IO ()) -> Annex a) -> Annex a
|
||||||
|
|
2
Test.hs
2
Test.hs
|
@ -1664,7 +1664,7 @@ test_add_subdirs = intmpclonerepo $ do
|
||||||
unlessM (hasUnlockedFiles <$> getTestMode) $ do
|
unlessM (hasUnlockedFiles <$> getTestMode) $ do
|
||||||
git_annex "sync" [] @? "sync failed"
|
git_annex "sync" [] @? "sync failed"
|
||||||
l <- annexeval $ Utility.FileSystemEncoding.decodeBL
|
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)
|
"../.git/annex/" `isPrefixOf` l @? ("symlink from subdir to .git/annex is wrong: " ++ l)
|
||||||
|
|
||||||
createDirectory "dir2"
|
createDirectory "dir2"
|
||||||
|
|
|
@ -92,7 +92,8 @@ logFiles dir = return . filter (".log" `isSuffixOf`)
|
||||||
|
|
||||||
push :: Annex ()
|
push :: Annex ()
|
||||||
push = do
|
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
|
origin_gitannex <- Annex.Branch.hasOrigin
|
||||||
case (origin_master, origin_gitannex) of
|
case (origin_master, origin_gitannex) of
|
||||||
(_, True) -> do
|
(_, True) -> do
|
||||||
|
|
|
@ -3,3 +3,9 @@ to contain a ByteString, rather than a String, would eliminate a
|
||||||
fromRawFilePath that uses about 1% of runtime.
|
fromRawFilePath that uses about 1% of runtime.
|
||||||
|
|
||||||
[[!tag confirmed]]
|
[[!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]]
|
||||||
|
|
Loading…
Add table
Reference in a new issue