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 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
|
||||
|
|
15
Utility.hs
15
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
|
||||
|
|
3
debian/changelog
vendored
3
debian/changelog
vendored
|
@ -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
|
||||
|
||||
|
|
Loading…
Reference in a new issue