0a36f92a31
Made --from and --to command-specific options. Added generic storage for values of command-specific options, which allows removing some of the special case fields in AnnexState. (Also added generic storage for command-specific flags, although there are not yet any.) Note that this storage uses a Map, so repeatedly looking up the same value is slightly more expensive than looking up an AnnexState field. But, the value can be looked up once in the seek stage, transformed as necessary, and passed in a closure to the start stage, and this avoids that overhead. Still, I'm hesitant to use this for things like force or fast flags. It's probably best to reserve it for flags that are only used by a few commands, or options like --from and --to that it's important only be allowed to be used with commands that implement them, to avoid user confusion.
127 lines
4.5 KiB
Haskell
127 lines
4.5 KiB
Haskell
{- git-annex command seeking
|
|
-
|
|
- These functions find appropriate files or other things based on
|
|
- the values a user passes to a command, and prepare actions operating
|
|
- on them.
|
|
-
|
|
- Copyright 2010-2011 Joey Hess <joey@kitenet.net>
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
module Seek where
|
|
|
|
import Common.Annex
|
|
import Types.Command
|
|
import Types.Key
|
|
import Backend
|
|
import qualified Annex
|
|
import qualified Git
|
|
import qualified Git.LsFiles as LsFiles
|
|
import qualified Git.CheckAttr
|
|
import qualified Limit
|
|
|
|
seekHelper :: ([FilePath] -> Git.Repo -> IO [FilePath]) -> [FilePath] -> Annex [FilePath]
|
|
seekHelper a params = do
|
|
g <- gitRepo
|
|
liftIO $ runPreserveOrder (`a` g) params
|
|
|
|
withFilesInGit :: (FilePath -> CommandStart) -> CommandSeek
|
|
withFilesInGit a params = prepFiltered a $ seekHelper LsFiles.inRepo params
|
|
|
|
withAttrFilesInGit :: String -> ((FilePath, String) -> CommandStart) -> CommandSeek
|
|
withAttrFilesInGit attr a params = do
|
|
files <- seekHelper LsFiles.inRepo params
|
|
prepFilteredGen a fst $ inRepo $ Git.CheckAttr.lookup attr files
|
|
|
|
withNumCopies :: (Maybe Int -> FilePath -> CommandStart) -> CommandSeek
|
|
withNumCopies a params = withAttrFilesInGit "annex.numcopies" go params
|
|
where
|
|
go (file, v) = a (readMaybe v) file
|
|
|
|
withBackendFilesInGit :: (BackendFile -> CommandStart) -> CommandSeek
|
|
withBackendFilesInGit a params = do
|
|
files <- seekHelper LsFiles.inRepo params
|
|
prepBackendPairs a files
|
|
|
|
withFilesNotInGit :: (BackendFile -> CommandStart) -> CommandSeek
|
|
withFilesNotInGit a params = do
|
|
{- dotfiles are not acted on unless explicitly listed -}
|
|
files <- filter (not . dotfile) <$> seek ps
|
|
dotfiles <- if null dotps then return [] else seek dotps
|
|
prepBackendPairs a $ preserveOrder params (files++dotfiles)
|
|
where
|
|
(dotps, ps) = partition dotfile params
|
|
seek l = do
|
|
force <- Annex.getState Annex.force
|
|
g <- gitRepo
|
|
liftIO $ (\p -> LsFiles.notInRepo force p g) l
|
|
|
|
withWords :: ([String] -> CommandStart) -> CommandSeek
|
|
withWords a params = return [a params]
|
|
|
|
withStrings :: (String -> CommandStart) -> CommandSeek
|
|
withStrings a params = return $ map a params
|
|
|
|
withFilesToBeCommitted :: (String -> CommandStart) -> CommandSeek
|
|
withFilesToBeCommitted a params = prepFiltered a $
|
|
seekHelper LsFiles.stagedNotDeleted params
|
|
|
|
withFilesUnlocked :: (BackendFile -> CommandStart) -> CommandSeek
|
|
withFilesUnlocked = withFilesUnlocked' LsFiles.typeChanged
|
|
|
|
withFilesUnlockedToBeCommitted :: (BackendFile -> CommandStart) -> CommandSeek
|
|
withFilesUnlockedToBeCommitted = withFilesUnlocked' LsFiles.typeChangedStaged
|
|
|
|
withFilesUnlocked' :: ([FilePath] -> Git.Repo -> IO [FilePath]) -> (BackendFile -> CommandStart) -> CommandSeek
|
|
withFilesUnlocked' typechanged a params = do
|
|
-- unlocked files have changed type from a symlink to a regular file
|
|
top <- fromRepo Git.workTree
|
|
typechangedfiles <- seekHelper typechanged params
|
|
unlockedfiles <- liftIO $ filterM notSymlink $
|
|
map (\f -> top ++ "/" ++ f) typechangedfiles
|
|
prepBackendPairs a unlockedfiles
|
|
|
|
withKeys :: (Key -> CommandStart) -> CommandSeek
|
|
withKeys a params = return $ map (a . parse) params
|
|
where
|
|
parse p = fromMaybe (error "bad key") $ readKey p
|
|
|
|
{- Modifies a seek action using the value of a field, which is fed into
|
|
- a conversion function, and then is passed into the seek action.
|
|
- This ensures that the conversion function only runs once.
|
|
-}
|
|
withField :: String -> (Maybe String -> a) -> (a -> CommandSeek) -> CommandSeek
|
|
withField field converter a ps = do
|
|
f <- converter <$> Annex.getField field
|
|
a f ps
|
|
|
|
withNothing :: CommandStart -> CommandSeek
|
|
withNothing a [] = return [a]
|
|
withNothing _ _ = error "This command takes no parameters."
|
|
|
|
|
|
prepFiltered :: (FilePath -> CommandStart) -> Annex [FilePath] -> Annex [CommandStart]
|
|
prepFiltered a = prepFilteredGen a id
|
|
|
|
prepBackendPairs :: (BackendFile -> CommandStart) -> CommandSeek
|
|
prepBackendPairs a fs = prepFilteredGen a snd (chooseBackends fs)
|
|
|
|
prepFilteredGen :: (b -> CommandStart) -> (b -> FilePath) -> Annex [b] -> Annex [CommandStart]
|
|
prepFilteredGen a d fs = do
|
|
matcher <- Limit.getMatcher
|
|
prepStart (proc matcher) fs
|
|
where
|
|
proc matcher v = do
|
|
let f = d v
|
|
ok <- matcher f
|
|
if ok then a v else return Nothing
|
|
|
|
{- Generates a list of CommandStart actions that will be run to perform a
|
|
- command, using a list (ie of files) coming from an action. The list
|
|
- will be produced and consumed lazily. -}
|
|
prepStart :: (b -> CommandStart) -> Annex [b] -> Annex [CommandStart]
|
|
prepStart a = liftM (map a)
|
|
|
|
notSymlink :: FilePath -> IO Bool
|
|
notSymlink f = liftIO $ not . isSymbolicLink <$> getSymbolicLinkStatus f
|