mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

refactor

Browse source
This commit is contained in:
Joey Hess 2016-03-11 16:45:40 -04:00
parent f3b9c48a09
commit ad04550055
Failed to extract signature
1 changed files with 12 additions and 10 deletions
Download patch file Download diff file Expand all files Collapse all files

22
Git/Tree.hs
View file

@ -120,8 +120,8 @@ treeItemToTreeContent (TreeItem f m s) = TreeBlob f m s
{- Applies an adjustment to items in a tree. {- Applies an adjustment to items in a tree.
- -
- While less flexible than using getTree and recordTree, this avoids - While less flexible than using getTree and recordTree,
- buffering the whole tree in memory. - this avoids buffering the whole tree in memory.
-} -}
adjustTree adjustTree
:: (MonadIO m, MonadMask m) :: (MonadIO m, MonadMask m)
@ -139,9 +139,8 @@ adjustTree adjusttreeitem addtreeitems removefiles r repo =
withMkTreeHandle repo $ \h -> do withMkTreeHandle repo $ \h -> do
(l, cleanup) <- liftIO $ lsTreeWithObjects r repo (l, cleanup) <- liftIO $ lsTreeWithObjects r repo
(l', _, _) <- go h False [] inTopTree l (l', _, _) <- go h False [] inTopTree l
sha <- liftIO $ mkTree h $ l'' <- adjustlist topitem l'
filter (not . removed) $ sha <- liftIO $ mkTree h l''
map treeItemToTreeContent (filter topitem addtreeitems) ++ l'
void $ liftIO cleanup void $ liftIO cleanup
return sha return sha
where where
@ -159,16 +158,19 @@ adjustTree adjusttreeitem addtreeitems removefiles r repo =
in go h modified (blob:c) intree is in go h modified (blob:c) intree is
Just TreeObject -> do Just TreeObject -> do
(sl, modified, is') <- go h False [] (beneathSubTree i) is (sl, modified, is') <- go h False [] (beneathSubTree i) is
let added = filter (inTree i) addtreeitems sl' <- adjustlist (inTree i) sl
let sl' = map treeItemToTreeContent added ++ sl subtree <- if modified || sl' /= sl
let sl'' = filter (not . removed) sl' then liftIO $ recordSubTree h $ NewSubTree (LsTree.file i) sl'
subtree <- if modified || sl'' /= sl
then liftIO $ recordSubTree h $ NewSubTree (LsTree.file i) sl''
else return $ RecordedSubTree (LsTree.file i) (LsTree.sha i) [] else return $ RecordedSubTree (LsTree.file i) (LsTree.sha i) []
let !modified' = modified || wasmodified let !modified' = modified || wasmodified
go h modified' (subtree : c) intree is' go h modified' (subtree : c) intree is'
_ -> error ("unexpected object type \"" ++ LsTree.typeobj i ++ "\"") _ -> error ("unexpected object type \"" ++ LsTree.typeobj i ++ "\"")
| otherwise = return (c, wasmodified, i:is) | otherwise = return (c, wasmodified, i:is)
adjustlist ishere l = do
let added = filter ishere addtreeitems
let l' = map treeItemToTreeContent added ++ l
let l'' = filter (not . removed) l'
return l''
topitem (TreeItem f _ _) = inTopTree' f topitem (TreeItem f _ _) = inTopTree' f
removeset = S.fromList removefiles removeset = S.fromList removefiles
removed (TreeBlob f _ _) = S.member f removeset removed (TreeBlob f _ _) = S.member f removeset