remove hashPointerFile'
no longer needed now that hashPointerFile uses a long-running git hash-object handle
This commit is contained in:
parent
70e8d6860e
commit
1df62b43d1
2 changed files with 19 additions and 27 deletions
|
@ -34,7 +34,6 @@ import Git.FilePath
|
||||||
import qualified Git.LockFile
|
import qualified Git.LockFile
|
||||||
import Annex.CatFile
|
import Annex.CatFile
|
||||||
import Annex.Link
|
import Annex.Link
|
||||||
import Git.HashObject
|
|
||||||
import Annex.AutoMerge
|
import Annex.AutoMerge
|
||||||
import Annex.Content
|
import Annex.Content
|
||||||
import qualified Database.Keys
|
import qualified Database.Keys
|
||||||
|
@ -55,18 +54,18 @@ reverseAdjustment HideMissingAdjustment = ShowMissingAdjustment
|
||||||
reverseAdjustment ShowMissingAdjustment = HideMissingAdjustment
|
reverseAdjustment ShowMissingAdjustment = HideMissingAdjustment
|
||||||
|
|
||||||
{- How to perform various adjustments to a TreeItem. -}
|
{- How to perform various adjustments to a TreeItem. -}
|
||||||
adjustTreeItem :: Adjustment -> HashObjectHandle -> TreeItem -> Annex (Maybe TreeItem)
|
adjustTreeItem :: Adjustment -> TreeItem -> Annex (Maybe TreeItem)
|
||||||
adjustTreeItem UnlockAdjustment h ti@(TreeItem f m s)
|
adjustTreeItem UnlockAdjustment ti@(TreeItem f m s)
|
||||||
| toBlobType m == Just SymlinkBlob = do
|
| toBlobType m == Just SymlinkBlob = do
|
||||||
mk <- catKey s
|
mk <- catKey s
|
||||||
case mk of
|
case mk of
|
||||||
Just k -> do
|
Just k -> do
|
||||||
Database.Keys.addAssociatedFile k f
|
Database.Keys.addAssociatedFile k f
|
||||||
Just . TreeItem f (fromBlobType FileBlob)
|
Just . TreeItem f (fromBlobType FileBlob)
|
||||||
<$> hashPointerFile' h k
|
<$> hashPointerFile k
|
||||||
Nothing -> return (Just ti)
|
Nothing -> return (Just ti)
|
||||||
| otherwise = return (Just ti)
|
| otherwise = return (Just ti)
|
||||||
adjustTreeItem LockAdjustment h ti@(TreeItem f m s)
|
adjustTreeItem LockAdjustment ti@(TreeItem f m s)
|
||||||
| toBlobType m /= Just SymlinkBlob = do
|
| toBlobType m /= Just SymlinkBlob = do
|
||||||
mk <- catKey s
|
mk <- catKey s
|
||||||
case mk of
|
case mk of
|
||||||
|
@ -75,10 +74,10 @@ adjustTreeItem LockAdjustment h ti@(TreeItem f m s)
|
||||||
fromTopFilePath f r
|
fromTopFilePath f r
|
||||||
linktarget <- calcRepo $ gitAnnexLink absf k
|
linktarget <- calcRepo $ gitAnnexLink absf k
|
||||||
Just . TreeItem f (fromBlobType SymlinkBlob)
|
Just . TreeItem f (fromBlobType SymlinkBlob)
|
||||||
<$> hashSymlink' h linktarget
|
<$> hashSymlink linktarget
|
||||||
Nothing -> return (Just ti)
|
Nothing -> return (Just ti)
|
||||||
| otherwise = return (Just ti)
|
| otherwise = return (Just ti)
|
||||||
adjustTreeItem HideMissingAdjustment h ti@(TreeItem _ _ s) = do
|
adjustTreeItem HideMissingAdjustment ti@(TreeItem _ _ s) = do
|
||||||
mk <- catKey s
|
mk <- catKey s
|
||||||
case mk of
|
case mk of
|
||||||
Just k -> ifM (inAnnex k)
|
Just k -> ifM (inAnnex k)
|
||||||
|
@ -86,7 +85,7 @@ adjustTreeItem HideMissingAdjustment h ti@(TreeItem _ _ s) = do
|
||||||
, return Nothing
|
, return Nothing
|
||||||
)
|
)
|
||||||
Nothing -> return (Just ti)
|
Nothing -> return (Just ti)
|
||||||
adjustTreeItem ShowMissingAdjustment _ ti = return (Just ti)
|
adjustTreeItem ShowMissingAdjustment ti = return (Just ti)
|
||||||
|
|
||||||
type OrigBranch = Branch
|
type OrigBranch = Branch
|
||||||
type AdjBranch = Branch
|
type AdjBranch = Branch
|
||||||
|
@ -163,10 +162,8 @@ adjust adj orig = do
|
||||||
|
|
||||||
adjustTree :: Adjustment -> Ref -> Annex Sha
|
adjustTree :: Adjustment -> Ref -> Annex Sha
|
||||||
adjustTree adj orig = do
|
adjustTree adj orig = do
|
||||||
h <- inRepo hashObjectStart
|
let toadj = adjustTreeItem adj
|
||||||
let toadj = adjustTreeItem adj h
|
|
||||||
treesha <- Git.Tree.adjustTree toadj [] [] orig =<< Annex.gitRepo
|
treesha <- Git.Tree.adjustTree toadj [] [] orig =<< Annex.gitRepo
|
||||||
liftIO $ hashObjectStop h
|
|
||||||
return treesha
|
return treesha
|
||||||
|
|
||||||
type CommitsPrevented = Git.LockFile.LockHandle
|
type CommitsPrevented = Git.LockFile.LockHandle
|
||||||
|
@ -262,9 +259,7 @@ propigateAdjustedCommits' origbranch (adj, currbranch) _commitsprevented = do
|
||||||
cv <- catCommit currbranch
|
cv <- catCommit currbranch
|
||||||
case cv of
|
case cv of
|
||||||
Just currcommit -> do
|
Just currcommit -> do
|
||||||
h <- inRepo hashObjectStart
|
v <- newcommits >>= go origsha False
|
||||||
v <- newcommits >>= go h origsha False
|
|
||||||
liftIO $ hashObjectStop h
|
|
||||||
case v of
|
case v of
|
||||||
Left e -> do
|
Left e -> do
|
||||||
warning e
|
warning e
|
||||||
|
@ -278,21 +273,21 @@ propigateAdjustedCommits' origbranch (adj, currbranch) _commitsprevented = do
|
||||||
-- Get commits oldest first, so they can be processed
|
-- Get commits oldest first, so they can be processed
|
||||||
-- in order made.
|
-- in order made.
|
||||||
[Param "--reverse"]
|
[Param "--reverse"]
|
||||||
go _ parent _ [] = do
|
go parent _ [] = do
|
||||||
inRepo $ Git.Branch.update origbranch parent
|
inRepo $ Git.Branch.update origbranch parent
|
||||||
return (Right parent)
|
return (Right parent)
|
||||||
go h parent pastadjcommit (sha:l) = do
|
go parent pastadjcommit (sha:l) = do
|
||||||
mc <- catCommit sha
|
mc <- catCommit sha
|
||||||
case mc of
|
case mc of
|
||||||
Just c
|
Just c
|
||||||
| commitMessage c == adjustedBranchCommitMessage ->
|
| commitMessage c == adjustedBranchCommitMessage ->
|
||||||
go h parent True l
|
go parent True l
|
||||||
| pastadjcommit -> do
|
| pastadjcommit -> do
|
||||||
v <- reverseAdjustedCommit h parent adj (sha, c) origbranch
|
v <- reverseAdjustedCommit parent adj (sha, c) origbranch
|
||||||
case v of
|
case v of
|
||||||
Left e -> return (Left e)
|
Left e -> return (Left e)
|
||||||
Right commit -> go h commit pastadjcommit l
|
Right commit -> go commit pastadjcommit l
|
||||||
_ -> go h parent pastadjcommit l
|
_ -> go parent pastadjcommit l
|
||||||
rebase currcommit newparent = do
|
rebase currcommit newparent = do
|
||||||
-- Reuse the current adjusted tree,
|
-- Reuse the current adjusted tree,
|
||||||
-- and reparent it on top of the new
|
-- and reparent it on top of the new
|
||||||
|
@ -309,8 +304,8 @@ propigateAdjustedCommits' origbranch (adj, currbranch) _commitsprevented = do
|
||||||
- Note that the commit message, and the author and committer metadata are
|
- Note that the commit message, and the author and committer metadata are
|
||||||
- copied over. However, any gpg signature will be lost, and any other
|
- copied over. However, any gpg signature will be lost, and any other
|
||||||
- headers are not copied either. -}
|
- headers are not copied either. -}
|
||||||
reverseAdjustedCommit :: HashObjectHandle -> Sha -> Adjustment -> (Sha, Commit) -> OrigBranch -> Annex (Either String Sha)
|
reverseAdjustedCommit :: Sha -> Adjustment -> (Sha, Commit) -> OrigBranch -> Annex (Either String Sha)
|
||||||
reverseAdjustedCommit h newparent adj (csha, c) origbranch
|
reverseAdjustedCommit newparent adj (csha, c) origbranch
|
||||||
-- commitDiff does not support merge commits
|
-- commitDiff does not support merge commits
|
||||||
| length (commitParent c) > 1 = return $
|
| length (commitParent c) > 1 = return $
|
||||||
Left $ "unable to propigate merge commit " ++ show csha ++ " back to " ++ show origbranch
|
Left $ "unable to propigate merge commit " ++ show csha ++ " back to " ++ show origbranch
|
||||||
|
@ -319,7 +314,7 @@ reverseAdjustedCommit h newparent adj (csha, c) origbranch
|
||||||
let (adds, others) = partition (\dti -> Git.DiffTree.srcsha dti == nullSha) diff
|
let (adds, others) = partition (\dti -> Git.DiffTree.srcsha dti == nullSha) diff
|
||||||
let (removes, changes) = partition (\dti -> Git.DiffTree.dstsha dti == nullSha) others
|
let (removes, changes) = partition (\dti -> Git.DiffTree.dstsha dti == nullSha) others
|
||||||
adds' <- catMaybes <$>
|
adds' <- catMaybes <$>
|
||||||
mapM (adjustTreeItem reverseadj h) (map diffTreeToTreeItem adds)
|
mapM (adjustTreeItem reverseadj) (map diffTreeToTreeItem adds)
|
||||||
treesha <- Git.Tree.adjustTree
|
treesha <- Git.Tree.adjustTree
|
||||||
(propchanges changes)
|
(propchanges changes)
|
||||||
adds'
|
adds'
|
||||||
|
@ -338,7 +333,7 @@ reverseAdjustedCommit h newparent adj (csha, c) origbranch
|
||||||
propchanges changes ti@(TreeItem f _ _) =
|
propchanges changes ti@(TreeItem f _ _) =
|
||||||
case M.lookup f m of
|
case M.lookup f m of
|
||||||
Nothing -> return (Just ti) -- not changed
|
Nothing -> return (Just ti) -- not changed
|
||||||
Just change -> adjustTreeItem reverseadj h change
|
Just change -> adjustTreeItem reverseadj change
|
||||||
where
|
where
|
||||||
m = M.fromList $ map (\i@(TreeItem f' _ _) -> (f', i)) $
|
m = M.fromList $ map (\i@(TreeItem f' _ _) -> (f', i)) $
|
||||||
map diffTreeToTreeItem changes
|
map diffTreeToTreeItem changes
|
||||||
|
|
|
@ -117,9 +117,6 @@ stageSymlink file sha =
|
||||||
hashPointerFile :: Key -> Annex Sha
|
hashPointerFile :: Key -> Annex Sha
|
||||||
hashPointerFile key = hashBlob (formatPointer key)
|
hashPointerFile key = hashBlob (formatPointer key)
|
||||||
|
|
||||||
hashPointerFile' :: Git.HashObject.HashObjectHandle -> Key -> Annex Sha
|
|
||||||
hashPointerFile' h = liftIO . Git.HashObject.hashBlob h . formatPointer
|
|
||||||
|
|
||||||
{- Stages a pointer file, using a Sha of its content -}
|
{- Stages a pointer file, using a Sha of its content -}
|
||||||
stagePointerFile :: FilePath -> Sha -> Annex ()
|
stagePointerFile :: FilePath -> Sha -> Annex ()
|
||||||
stagePointerFile file sha =
|
stagePointerFile file sha =
|
||||||
|
|
Loading…
Reference in a new issue