cleanup last change

This commit is contained in:
Joey Hess 2011-01-31 20:14:08 -04:00
parent 37c62eebb7
commit 27056daccd
3 changed files with 33 additions and 23 deletions

View file

@ -14,7 +14,6 @@ import Control.Monad (filterM)
import System.Path.WildMatch import System.Path.WildMatch
import Text.Regex.PCRE.Light.Char8 import Text.Regex.PCRE.Light.Char8
import Data.List import Data.List
import System.Path
import Types import Types
import qualified Backend import qualified Backend
@ -22,6 +21,7 @@ import Messages
import qualified Annex import qualified Annex
import qualified GitRepo as Git import qualified GitRepo as Git
import Locations import Locations
import Utility
{- A command runs in four stages. {- A command runs in four stages.
- -
@ -109,20 +109,20 @@ isAnnexed file a = do
withFilesInGit :: CommandSeekStrings withFilesInGit :: CommandSeekStrings
withFilesInGit a params = do withFilesInGit a params = do
repo <- Annex.gitRepo repo <- Annex.gitRepo
files <- liftIO $ runPreserverOrder (Git.inRepo repo) params files <- liftIO $ runPreserveOrder (Git.inRepo repo) params
files' <- filterFiles files files' <- filterFiles files
return $ map a files' return $ map a files'
withAttrFilesInGit :: String -> CommandSeekAttrFiles withAttrFilesInGit :: String -> CommandSeekAttrFiles
withAttrFilesInGit attr a params = do withAttrFilesInGit attr a params = do
repo <- Annex.gitRepo repo <- Annex.gitRepo
files <- liftIO $ runPreserverOrder (Git.inRepo repo) params files <- liftIO $ runPreserveOrder (Git.inRepo repo) params
files' <- filterFiles files files' <- filterFiles files
pairs <- liftIO $ Git.checkAttr repo attr files' pairs <- liftIO $ Git.checkAttr repo attr files'
return $ map a pairs return $ map a pairs
withBackendFilesInGit :: CommandSeekBackendFiles withBackendFilesInGit :: CommandSeekBackendFiles
withBackendFilesInGit a params = do withBackendFilesInGit a params = do
repo <- Annex.gitRepo repo <- Annex.gitRepo
files <- liftIO $ runPreserverOrder (Git.inRepo repo) params files <- liftIO $ runPreserveOrder (Git.inRepo repo) params
files' <- filterFiles files files' <- filterFiles files
backendPairs a files' backendPairs a files'
withFilesMissing :: CommandSeekStrings withFilesMissing :: CommandSeekStrings
@ -137,7 +137,7 @@ withFilesMissing a params = do
withFilesNotInGit :: CommandSeekBackendFiles withFilesNotInGit :: CommandSeekBackendFiles
withFilesNotInGit a params = do withFilesNotInGit a params = do
repo <- Annex.gitRepo repo <- Annex.gitRepo
newfiles <- liftIO $ runPreserverOrder (Git.notInRepo repo) params newfiles <- liftIO $ runPreserveOrder (Git.notInRepo repo) params
newfiles' <- filterFiles newfiles newfiles' <- filterFiles newfiles
backendPairs a newfiles' backendPairs a newfiles'
withString :: CommandSeekStrings withString :: CommandSeekStrings
@ -147,7 +147,7 @@ withStrings a params = return $ map a params
withFilesToBeCommitted :: CommandSeekStrings withFilesToBeCommitted :: CommandSeekStrings
withFilesToBeCommitted a params = do withFilesToBeCommitted a params = do
repo <- Annex.gitRepo repo <- Annex.gitRepo
tocommit <- liftIO $ runPreserverOrder (Git.stagedFiles repo) params tocommit <- liftIO $ runPreserveOrder (Git.stagedFiles repo) params
tocommit' <- filterFiles tocommit tocommit' <- filterFiles tocommit
return $ map a tocommit' return $ map a tocommit'
withFilesUnlocked :: CommandSeekBackendFiles withFilesUnlocked :: CommandSeekBackendFiles
@ -158,7 +158,7 @@ withFilesUnlocked' :: (Git.Repo -> [FilePath] -> IO [FilePath]) -> CommandSeekBa
withFilesUnlocked' typechanged a params = do withFilesUnlocked' typechanged a params = do
-- unlocked files have changed type from a symlink to a regular file -- unlocked files have changed type from a symlink to a regular file
repo <- Annex.gitRepo repo <- Annex.gitRepo
typechangedfiles <- liftIO $ runPreserverOrder (typechanged repo) params typechangedfiles <- liftIO $ runPreserveOrder (typechanged repo) params
unlockedfiles <- liftIO $ filterM notSymlink $ unlockedfiles <- liftIO $ filterM notSymlink $
map (\f -> Git.workTree repo ++ "/" ++ f) typechangedfiles map (\f -> Git.workTree repo ++ "/" ++ f) typechangedfiles
unlockedfiles' <- filterFiles unlockedfiles unlockedfiles' <- filterFiles unlockedfiles
@ -256,20 +256,14 @@ preserveOrder orig new = collect orig new
collect (l:ls) n = found ++ collect ls rest collect (l:ls) n = found ++ collect ls rest
where (found, rest)=partition (l `dirContains`) n where (found, rest)=partition (l `dirContains`) n
runPreserverOrder :: ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath] {- Runs an action that takes a list of FilePaths, and ensures that
runPreserverOrder a files = do - its return list preserves order.
-
- This assumes that it's cheaper to call preserveOrder on the result,
- than it would be to run the action once with each param. In the case
- of git file list commands, that assumption tends to hold.
-}
runPreserveOrder :: ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
runPreserveOrder a files = do
r <- a files r <- a files
return $ preserveOrder files r return $ preserveOrder files r
{- Checks if the first FilePath is, or could be said to contain the second.
- For example, "foo/" contains "foo/bar". Also, "foo", "./foo", "foo/" etc
- are all equivilant.
-}
dirContains :: FilePath -> FilePath -> Bool
dirContains a b = a == b || a' == b' || (a'++"/") `isPrefixOf` b'
where
norm p = case (absNormPath p ".") of
Just r -> r
Nothing -> ""
a' = norm a
b' = norm b

View file

@ -18,6 +18,7 @@ module Utility (
unsetFileMode, unsetFileMode,
readMaybe, readMaybe,
safeWriteFile, safeWriteFile,
dirContains,
prop_idempotent_shellEscape, prop_idempotent_shellEscape,
prop_idempotent_shellEscape_multiword, prop_idempotent_shellEscape_multiword,
@ -36,6 +37,7 @@ import System.Path
import System.FilePath import System.FilePath
import System.Directory import System.Directory
import Foreign (complement) import Foreign (complement)
import Data.List
{- A version of hgetContents that is not lazy. Ensures file is {- A version of hgetContents that is not lazy. Ensures file is
- all read before it gets closed. -} - all read before it gets closed. -}
@ -65,6 +67,19 @@ prop_parentDir_basics dir
where where
p = parentDir dir p = parentDir dir
{- Checks if the first FilePath is, or could be said to contain the second.
- For example, "foo/" contains "foo/bar". Also, "foo", "./foo", "foo/" etc
- are all equivilant.
-}
dirContains :: FilePath -> FilePath -> Bool
dirContains a b = a == b || a' == b' || (a'++"/") `isPrefixOf` b'
where
norm p = case (absNormPath p ".") of
Just r -> r
Nothing -> ""
a' = norm a
b' = norm b
{- Converts a filename into a normalized, absolute path. -} {- Converts a filename into a normalized, absolute path. -}
absPath :: FilePath -> IO FilePath absPath :: FilePath -> IO FilePath
absPath file = do absPath file = do

3
debian/changelog vendored
View file

@ -1,7 +1,8 @@
git-annex (0.20) UNRELEASED; urgency=low git-annex (0.20) UNRELEASED; urgency=low
* Preserve specified file ordering when instructed to act on multiple * Preserve specified file ordering when instructed to act on multiple
files or directories. files or directories. For example, "git annex get a b" will now always
get "a" before "b". Previously it could operate in either order.
-- Joey Hess <joeyh@debian.org> Mon, 31 Jan 2011 20:06:02 -0400 -- Joey Hess <joeyh@debian.org> Mon, 31 Jan 2011 20:06:02 -0400