few strictness improvemnets

This commit is contained in:
Joey Hess 2016-02-23 22:03:47 -04:00
parent 85b05a29df
commit 4ea36b8c63
Failed to extract signature

View file

@ -119,7 +119,6 @@ adjustTree adjust r repo = do
(l, cleanup) <- liftIO $ lsTreeWithObjects r repo (l, cleanup) <- liftIO $ lsTreeWithObjects r repo
h <- liftIO $ startRecordTree repo h <- liftIO $ startRecordTree repo
(l', _, _) <- go h False [] topTree l (l', _, _) <- go h False [] topTree l
liftIO $ print l'
sha <- liftIO $ mkTree h l' sha <- liftIO $ mkTree h l'
liftIO $ CoProcess.stop h liftIO $ CoProcess.stop h
void $ liftIO cleanup void $ liftIO cleanup
@ -135,15 +134,16 @@ adjustTree adjust r repo = do
case v of case v of
Nothing -> go h True c intree is Nothing -> go h True c intree is
Just ti'@(TreeItem f m s) -> Just ti'@(TreeItem f m s) ->
let modified = ti' /= ti let !modified = wasmodified || ti' /= ti
blob = TreeBlob f m s blob = TreeBlob f m s
in go h (wasmodified || 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 [] (subTree i) is (sl, modified, is') <- go h False [] (subTree i) is
subtree <- if modified subtree <- if modified
then liftIO $ recordSubTree h $ NewSubTree (LsTree.file i) 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) []
go h (modified || wasmodified) (subtree : c) intree is' let !modified' = modified || wasmodified
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)
@ -177,6 +177,6 @@ topTree :: InTree
topTree = notElem '/' . getTopFilePath . LsTree.file topTree = notElem '/' . getTopFilePath . LsTree.file
subTree :: LsTree.TreeItem -> InTree subTree :: LsTree.TreeItem -> InTree
subTree i = subTree t =
let prefix = getTopFilePath (LsTree.file i) ++ "/" let prefix = getTopFilePath (LsTree.file t) ++ "/"
in (\i -> prefix `isPrefixOf` getTopFilePath (LsTree.file i)) in (\i -> prefix `isPrefixOf` getTopFilePath (LsTree.file i))