diff options
author | Joey Hess <joey@kitenet.net> | 2011-01-31 20:14:08 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2011-01-31 20:15:23 -0400 |
commit | 27056daccd1a2f541cd104a835a32523a532d4da (patch) | |
tree | b4b595f287efb3496f21a5f74c034e897e5da075 | |
parent | 37c62eebb72fa0c216336435669cf8a05c2dbc88 (diff) |
cleanup last change
-rw-r--r-- | Command.hs | 38 | ||||
-rw-r--r-- | Utility.hs | 15 | ||||
-rw-r--r-- | debian/changelog | 3 |
3 files changed, 33 insertions, 23 deletions
diff --git a/Command.hs b/Command.hs index 859f713a0..0bbc6088c 100644 --- a/Command.hs +++ b/Command.hs @@ -14,7 +14,6 @@ import Control.Monad (filterM) import System.Path.WildMatch import Text.Regex.PCRE.Light.Char8 import Data.List -import System.Path import Types import qualified Backend @@ -22,6 +21,7 @@ import Messages import qualified Annex import qualified GitRepo as Git import Locations +import Utility {- A command runs in four stages. - @@ -109,20 +109,20 @@ isAnnexed file a = do withFilesInGit :: CommandSeekStrings withFilesInGit a params = do repo <- Annex.gitRepo - files <- liftIO $ runPreserverOrder (Git.inRepo repo) params + files <- liftIO $ runPreserveOrder (Git.inRepo repo) params files' <- filterFiles files return $ map a files' withAttrFilesInGit :: String -> CommandSeekAttrFiles withAttrFilesInGit attr a params = do repo <- Annex.gitRepo - files <- liftIO $ runPreserverOrder (Git.inRepo repo) params + files <- liftIO $ runPreserveOrder (Git.inRepo repo) params files' <- filterFiles files pairs <- liftIO $ Git.checkAttr repo attr files' return $ map a pairs withBackendFilesInGit :: CommandSeekBackendFiles withBackendFilesInGit a params = do repo <- Annex.gitRepo - files <- liftIO $ runPreserverOrder (Git.inRepo repo) params + files <- liftIO $ runPreserveOrder (Git.inRepo repo) params files' <- filterFiles files backendPairs a files' withFilesMissing :: CommandSeekStrings @@ -137,7 +137,7 @@ withFilesMissing a params = do withFilesNotInGit :: CommandSeekBackendFiles withFilesNotInGit a params = do repo <- Annex.gitRepo - newfiles <- liftIO $ runPreserverOrder (Git.notInRepo repo) params + newfiles <- liftIO $ runPreserveOrder (Git.notInRepo repo) params newfiles' <- filterFiles newfiles backendPairs a newfiles' withString :: CommandSeekStrings @@ -147,7 +147,7 @@ withStrings a params = return $ map a params withFilesToBeCommitted :: CommandSeekStrings withFilesToBeCommitted a params = do repo <- Annex.gitRepo - tocommit <- liftIO $ runPreserverOrder (Git.stagedFiles repo) params + tocommit <- liftIO $ runPreserveOrder (Git.stagedFiles repo) params tocommit' <- filterFiles tocommit return $ map a tocommit' withFilesUnlocked :: CommandSeekBackendFiles @@ -158,7 +158,7 @@ withFilesUnlocked' :: (Git.Repo -> [FilePath] -> IO [FilePath]) -> CommandSeekBa withFilesUnlocked' typechanged a params = do -- unlocked files have changed type from a symlink to a regular file repo <- Annex.gitRepo - typechangedfiles <- liftIO $ runPreserverOrder (typechanged repo) params + typechangedfiles <- liftIO $ runPreserveOrder (typechanged repo) params unlockedfiles <- liftIO $ filterM notSymlink $ map (\f -> Git.workTree repo ++ "/" ++ f) typechangedfiles unlockedfiles' <- filterFiles unlockedfiles @@ -256,20 +256,14 @@ preserveOrder orig new = collect orig new collect (l:ls) n = found ++ collect ls rest where (found, rest)=partition (l `dirContains`) n -runPreserverOrder :: ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath] -runPreserverOrder a files = do +{- Runs an action that takes a list of FilePaths, and ensures that + - 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 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 diff --git a/Utility.hs b/Utility.hs index 96bbc89ee..2bb623532 100644 --- a/Utility.hs +++ b/Utility.hs @@ -18,6 +18,7 @@ module Utility ( unsetFileMode, readMaybe, safeWriteFile, + dirContains, prop_idempotent_shellEscape, prop_idempotent_shellEscape_multiword, @@ -36,6 +37,7 @@ import System.Path import System.FilePath import System.Directory import Foreign (complement) +import Data.List {- A version of hgetContents that is not lazy. Ensures file is - all read before it gets closed. -} @@ -65,6 +67,19 @@ prop_parentDir_basics dir where 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. -} absPath :: FilePath -> IO FilePath absPath file = do diff --git a/debian/changelog b/debian/changelog index eee71a5e9..d7edc1733 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,7 +1,8 @@ git-annex (0.20) UNRELEASED; urgency=low * 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 |