cleanup last change
This commit is contained in:
parent
37c62eebb7
commit
27056daccd
3 changed files with 33 additions and 23 deletions
38
Command.hs
38
Command.hs
|
@ -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
|
|
||||||
|
|
15
Utility.hs
15
Utility.hs
|
@ -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
3
debian/changelog
vendored
|
@ -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
|
||||||
|
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue