From 3f25317ad587fc06cb1c16dc255e8035ab1ef91d Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 11 Oct 2016 15:36:40 -0400 Subject: [PATCH] fix tree graft-in bug When adding a tree like a/b/c/d when a/b already exists, fixes the bug that the tree that got created was a/b/a/b/c/d Just need to flatten out the top N directories of the tree that's being grafted in, so we get the c/d part. This was complicated by the Tree data type being a rose tree rather than a regular tree. This commit was sponsored by Nick Daly on Patreon. --- Git/Tree.hs | 32 ++++++++++++------- ...d_branch_deleted_recently_added_files.mdwn | 2 ++ 2 files changed, 23 insertions(+), 11 deletions(-) diff --git a/Git/Tree.hs b/Git/Tree.hs index 65c3d713a4..c341e1f5bf 100644 --- a/Git/Tree.hs +++ b/Git/Tree.hs @@ -143,6 +143,16 @@ treeItemsToTree = go M.empty where parent = takeDirectory d +{- Flattens the top N levels of a Tree. -} +flattenTree :: Int -> Tree -> Tree +flattenTree 0 t = t +flattenTree n (Tree l) = Tree (concatMap (go n) l) + where + go 0 c = [c] + go _ b@(TreeBlob _ _ _) = [b] + go n' (RecordedSubTree _ _ l') = concatMap (go (n'-1)) l' + go n' (NewSubTree _ l') = concatMap (go (n'-1)) l' + {- Applies an adjustment to items in a tree. - - While less flexible than using getTree and recordTree, @@ -163,42 +173,42 @@ adjustTree adjustTree adjusttreeitem addtreeitems removefiles r repo = withMkTreeHandle repo $ \h -> do (l, cleanup) <- liftIO $ lsTreeWithObjects r repo - (l', _, _) <- go h False [] inTopTree l - l'' <- adjustlist h inTopTree (const True) l' + (l', _, _) <- go h False [] 1 inTopTree l + l'' <- adjustlist h 0 inTopTree (const True) l' sha <- liftIO $ mkTree h l'' void $ liftIO cleanup return sha where - go _ wasmodified c _ [] = return (c, wasmodified, []) - go h wasmodified c intree (i:is) + go _ wasmodified c _ _ [] = return (c, wasmodified, []) + go h wasmodified c depth intree (i:is) | intree i = case readObjectType (LsTree.typeobj i) of Just BlobObject -> do let ti = TreeItem (LsTree.file i) (LsTree.mode i) (LsTree.sha i) v <- adjusttreeitem ti case v of - Nothing -> go h True c intree is + Nothing -> go h True c depth intree is Just ti'@(TreeItem f m s) -> let !modified = wasmodified || ti' /= ti blob = TreeBlob f m s - in go h modified (blob:c) intree is + in go h modified (blob:c) depth intree is Just TreeObject -> do - (sl, modified, is') <- go h False [] (beneathSubTree i) is - sl' <- adjustlist h (inTree i) (beneathSubTree i) sl + (sl, modified, is') <- go h False [] (depth+1) (beneathSubTree i) is + sl' <- adjustlist h depth (inTree i) (beneathSubTree i) sl let slmodified = sl' /= sl subtree <- if modified || slmodified then liftIO $ recordSubTree h $ NewSubTree (LsTree.file i) sl' else return $ RecordedSubTree (LsTree.file i) (LsTree.sha i) [] let !modified' = modified || slmodified || wasmodified - go h modified' (subtree : c) intree is' + go h modified' (subtree : c) depth intree is' _ -> error ("unexpected object type \"" ++ LsTree.typeobj i ++ "\"") | otherwise = return (c, wasmodified, i:is) - adjustlist h ishere underhere l = do + adjustlist h depth ishere underhere l = do let (addhere, rest) = partition ishere addtreeitems let l' = filter (not . removed) $ map treeItemToTreeContent addhere ++ l let inl i = any (\t -> beneathSubTree t i) l' - let (Tree addunderhere) = treeItemsToTree $ + let (Tree addunderhere) = flattenTree depth $ treeItemsToTree $ filter (\i -> underhere i && not (inl i)) rest addunderhere' <- liftIO $ mapM (recordSubTree h) addunderhere return (addunderhere'++l') diff --git a/doc/bugs/sync_in_adjusted_branch_deleted_recently_added_files.mdwn b/doc/bugs/sync_in_adjusted_branch_deleted_recently_added_files.mdwn index 4681cbe482..6c82fcf82f 100644 --- a/doc/bugs/sync_in_adjusted_branch_deleted_recently_added_files.mdwn +++ b/doc/bugs/sync_in_adjusted_branch_deleted_recently_added_files.mdwn @@ -86,3 +86,5 @@ the adjusted branch that adds the file back, but the file doesn't reach the master branch in this scenario. --[[Joey]] + +Both bugs fixed now. [[done]] --[[Joey]] -- 2.30.2