fix hacked up AutoMerge module to work again
authorJoey Hess <joeyh@joeyh.name>
Mon, 2 Dec 2019 14:51:43 +0000 (10:51 -0400)
committerJoey Hess <joeyh@joeyh.name>
Mon, 2 Dec 2019 14:51:43 +0000 (10:51 -0400)
Annex/AutoMerge.hs

index 00193d3481765e2f4cc35d3a7973ff3b5008e290..f537081d717678cb641e7f6fc0fca797c8f6869b 100644 (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