fix hacked up AutoMerge module to work again

This commit is contained in:
Joey Hess 2019-12-02 10:51:43 -04:00
parent d7833def66
commit c756006374
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38

View file

@ -43,8 +43,6 @@ import qualified Data.ByteString.Lazy as L
-}
autoMergeFrom :: Git.Ref -> Maybe Git.Ref -> [Git.Merge.MergeConfig] -> Annex Bool -> Git.Branch.CommitMode -> Annex Bool
autoMergeFrom branch currbranch mergeconfig canresolvemerge commitmode = do
error "STUBBED FIXME"
{-
showOutput
case currbranch of
Nothing -> go Nothing
@ -64,7 +62,6 @@ autoMergeFrom branch currbranch mergeconfig canresolvemerge commitmode = do
( resolveMerge old branch False
, return False
)
-}
{- Resolves a conflicted merge. It's important that any conflicts be
- resolved in a way that itself avoids later merge conflicts, since
@ -107,9 +104,7 @@ autoMergeFrom branch currbranch mergeconfig canresolvemerge commitmode = do
-}
resolveMerge :: Maybe Git.Ref -> Git.Ref -> Bool -> Annex Bool
resolveMerge us them inoverlay = do
error "STUBBED FIXME"
{-
top <- if inoverlay
top <- toRawFilePath <$> if inoverlay
then pure "."
else fromRepo Git.repoPath
(fs, cleanup) <- inRepo (LsFiles.unmerged [top])
@ -127,7 +122,7 @@ resolveMerge us them inoverlay = do
unless (null deleted) $
Annex.Queue.addCommand "rm"
[Param "--quiet", Param "-f", Param "--"]
deleted
(map fromRawFilePath deleted)
void $ liftIO cleanup2
when merged $ do
@ -137,13 +132,10 @@ resolveMerge us them inoverlay = do
cleanConflictCruft mergedks' mergedfs' unstagedmap
showLongNote "Merge conflict was automatically resolved; you may want to examine the result."
return merged
-}
resolveMerge' :: InodeMap -> Maybe Git.Ref -> Git.Ref -> Bool -> LsFiles.Unmerged -> Annex ([Key], Maybe FilePath)
resolveMerge' _ Nothing _ _ _ = return ([], Nothing)
resolveMerge' unstagedmap (Just us) them inoverlay u = do
error "STUBBED FIXME"
{-
kus <- getkey LsFiles.valUs
kthem <- getkey LsFiles.valThem
case (kus, kthem) of
@ -177,7 +169,7 @@ resolveMerge' unstagedmap (Just us) them inoverlay u = do
-- Neither side is annexed file; cannot resolve.
(Nothing, Nothing) -> return ([], Nothing)
where
file = LsFiles.unmergedFile u
file = fromRawFilePath $ LsFiles.unmergedFile u
getkey select =
case select (LsFiles.unmergedSha u) of
@ -210,20 +202,20 @@ resolveMerge' unstagedmap (Just us) them inoverlay u = do
makesymlink key dest = do
l <- calcRepo $ gitAnnexLink dest key
unless inoverlay $ replacewithsymlink dest l
dest' <- stagefile dest
dest' <- toRawFilePath <$> stagefile dest
stageSymlink dest' =<< hashSymlink l
replacewithsymlink dest link = withworktree dest $ \f ->
replaceFile f $ makeGitLink link
replaceFile f $ makeGitLink link . toRawFilePath
makepointer key dest destmode = do
unless inoverlay $
unlessM (reuseOldFile unstagedmap key file dest) $
linkFromAnnex key dest destmode >>= \case
LinkAnnexFailed -> liftIO $
writePointerFile dest key destmode
writePointerFile (toRawFilePath dest) key destmode
_ -> noop
dest' <- stagefile dest
dest' <- toRawFilePath <$> stagefile dest
stagePointerFile dest' destmode =<< hashPointerFile key
unless inoverlay $
Database.Keys.addAssociatedFile key
@ -247,7 +239,7 @@ resolveMerge' unstagedmap (Just us) them inoverlay u = do
Nothing -> noop
Just sha -> do
link <- catSymLinkTarget sha
replacewithsymlink item link
replacewithsymlink item (fromRawFilePath link)
-- And when grafting in anything else vs a symlink,
-- the work tree already contains what we want.
(_, Just TreeSymlink) -> noop
@ -273,7 +265,6 @@ resolveMerge' unstagedmap (Just us) them inoverlay u = do
[Param "--quiet", Param "-f", Param "--cached", Param "--"] [file]
void a
return (ks, Just file)
-}
{- git-merge moves conflicting files away to files
- named something like f~HEAD or f~branch or just f, but the
@ -287,8 +278,6 @@ resolveMerge' unstagedmap (Just us) them inoverlay u = do
-}
cleanConflictCruft :: [Key] -> [FilePath] -> InodeMap -> Annex ()
cleanConflictCruft resolvedks resolvedfs unstagedmap = do
error "STUBBED FIXME"
{-
is <- S.fromList . map (inodeCacheToKey Strongly) . concat
<$> mapM Database.Keys.getInodeCaches resolvedks
forM_ (M.toList unstagedmap) $ \(i, f) ->
@ -301,11 +290,10 @@ cleanConflictCruft resolvedks resolvedfs unstagedmap = do
matchesresolved is i f
| S.member f fs || S.member (conflictCruftBase f) fs = anyM id
[ pure (S.member i is)
, inks <$> isAnnexLink f
, inks <$> liftIO (isPointerFile f)
, inks <$> isAnnexLink (toRawFilePath f)
, inks <$> liftIO (isPointerFile (toRawFilePath f))
]
| otherwise = return False
-}
conflictCruftBase :: FilePath -> FilePath
conflictCruftBase f = reverse $ drop 1 $ dropWhile (/= '~') $ reverse f
@ -340,13 +328,14 @@ commitResolvedMerge commitmode = inRepo $ Git.Branch.commitCommand commitmode
type InodeMap = M.Map InodeCacheKey FilePath
inodeMap :: Annex ([FilePath], IO Bool) -> Annex InodeMap
inodeMap :: Annex ([RawFilePath], IO Bool) -> Annex InodeMap
inodeMap getfiles = do
(fs, cleanup) <- getfiles
fsis <- forM fs $ \f -> do
mi <- withTSDelta (liftIO . genInodeCache f)
let f' = fromRawFilePath f
mi <- withTSDelta (liftIO . genInodeCache f')
return $ case mi of
Nothing -> Nothing
Just i -> Just (inodeCacheToKey Strongly i, f)
Just i -> Just (inodeCacheToKey Strongly i, f')
void $ liftIO cleanup
return $ M.fromList $ catMaybes fsis