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

avoid hardcoded slashes; broke on windows

Browse source
This commit is contained in:
Joey Hess 2016-05-03 18:56:06 -04:00
parent c746b7531a
commit db9269712f
Failed to extract signature
1 changed files with 4 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
Git/Tree.hs
View file

@ -117,9 +117,9 @@ treeItemToTreeContent (TreeItem f m s) = TreeBlob f m s
treeItemsToTree :: [TreeItem] -> Tree treeItemsToTree :: [TreeItem] -> Tree
treeItemsToTree = go M.empty treeItemsToTree = go M.empty
where where
go m [] = Tree $ filter (notElem '/' . gitPath) (M.elems m) go m [] = Tree $ filter inTopTree (M.elems m)
go m (i:is) go m (i:is)
| '/' `notElem` p = | inTopTree p =
go (M.insert p (treeItemToTreeContent i) m) is go (M.insert p (treeItemToTreeContent i) m) is
| otherwise = case M.lookup idir m of | otherwise = case M.lookup idir m of
Just (NewSubTree d l) -> Just (NewSubTree d l) ->
@ -132,7 +132,7 @@ treeItemsToTree = go M.empty
c = treeItemToTreeContent i c = treeItemToTreeContent i
addsubtree d m t addsubtree d m t
| elem '/' d = | not (inTopTree d) =
let m' = M.insert d t m let m' = M.insert d t m
in case M.lookup parent m' of in case M.lookup parent m' of
Just (NewSubTree d' l) -> Just (NewSubTree d' l) ->
@ -259,4 +259,4 @@ beneathSubTree :: (GitPath t, GitPath f) => t -> f -> Bool
beneathSubTree t f = prefix `isPrefixOf` gitPath f beneathSubTree t f = prefix `isPrefixOf` gitPath f
where where
tp = gitPath t tp = gitPath t
prefix = if null tp then tp else tp ++ "/" prefix = if null tp then tp else addTrailingPathSeparator tp