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