reorganize some files and imports
This commit is contained in:
parent
3149a62a35
commit
86ffeb73d1
34 changed files with 92 additions and 120 deletions
182
CmdLine/Seek.hs
Normal file
182
CmdLine/Seek.hs
Normal file
|
@ -0,0 +1,182 @@
|
|||
{- 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-2014 Joey Hess <joey@kitenet.net>
|
||||
-
|
||||
- Licensed under the GNU GPL version 3 or higher.
|
||||
-}
|
||||
|
||||
module CmdLine.Seek where
|
||||
|
||||
import System.PosixCompat.Files
|
||||
|
||||
import Common.Annex
|
||||
import Types.Command
|
||||
import Types.Key
|
||||
import Types.FileMatcher
|
||||
import qualified Annex
|
||||
import qualified Git
|
||||
import qualified Git.Command
|
||||
import qualified Git.LsFiles as LsFiles
|
||||
import qualified Limit
|
||||
import CmdLine.Option
|
||||
import Logs.Location
|
||||
import Logs.Unused
|
||||
import Annex.CatFile
|
||||
import RunCommand
|
||||
|
||||
withFilesInGit :: (FilePath -> CommandStart) -> CommandSeek
|
||||
withFilesInGit a params = seekActions $ prepFiltered a $
|
||||
seekHelper LsFiles.inRepo params
|
||||
|
||||
withFilesNotInGit :: (FilePath -> CommandStart) -> CommandSeek
|
||||
withFilesNotInGit a params = do
|
||||
{- dotfiles are not acted on unless explicitly listed -}
|
||||
files <- filter (not . dotfile) <$>
|
||||
seekunless (null ps && not (null params)) ps
|
||||
dotfiles <- seekunless (null dotps) dotps
|
||||
seekActions $ prepFiltered a $
|
||||
return $ concat $ segmentPaths params (files++dotfiles)
|
||||
where
|
||||
(dotps, ps) = partition dotfile params
|
||||
seekunless True _ = return []
|
||||
seekunless _ l = do
|
||||
force <- Annex.getState Annex.force
|
||||
g <- gitRepo
|
||||
liftIO $ Git.Command.leaveZombie <$> LsFiles.notInRepo force l g
|
||||
|
||||
withPathContents :: ((FilePath, FilePath) -> CommandStart) -> CommandSeek
|
||||
withPathContents a params = seekActions $
|
||||
map a . concat <$> liftIO (mapM get params)
|
||||
where
|
||||
get p = ifM (isDirectory <$> getFileStatus p)
|
||||
( map (\f -> (f, makeRelative (parentDir p) f))
|
||||
<$> dirContentsRecursiveSkipping (".git" `isSuffixOf`) True p
|
||||
, return [(p, takeFileName p)]
|
||||
)
|
||||
|
||||
withWords :: ([String] -> CommandStart) -> CommandSeek
|
||||
withWords a params = seekActions $ return [a params]
|
||||
|
||||
withStrings :: (String -> CommandStart) -> CommandSeek
|
||||
withStrings a params = seekActions $ return $ map a params
|
||||
|
||||
withPairs :: ((String, String) -> CommandStart) -> CommandSeek
|
||||
withPairs a params = seekActions $ return $ map a $ pairs [] params
|
||||
where
|
||||
pairs c [] = reverse c
|
||||
pairs c (x:y:xs) = pairs ((x,y):c) xs
|
||||
pairs _ _ = error "expected pairs"
|
||||
|
||||
withFilesToBeCommitted :: (String -> CommandStart) -> CommandSeek
|
||||
withFilesToBeCommitted a params = seekActions $ prepFiltered a $
|
||||
seekHelper LsFiles.stagedNotDeleted params
|
||||
|
||||
withFilesUnlocked :: (FilePath -> CommandStart) -> CommandSeek
|
||||
withFilesUnlocked = withFilesUnlocked' LsFiles.typeChanged
|
||||
|
||||
withFilesUnlockedToBeCommitted :: (FilePath -> CommandStart) -> CommandSeek
|
||||
withFilesUnlockedToBeCommitted = withFilesUnlocked' LsFiles.typeChangedStaged
|
||||
|
||||
{- Unlocked files have changed type from a symlink to a regular file.
|
||||
-
|
||||
- Furthermore, unlocked files used to be a git-annex symlink,
|
||||
- not some other sort of symlink.
|
||||
-}
|
||||
withFilesUnlocked' :: ([FilePath] -> Git.Repo -> IO ([FilePath], IO Bool)) -> (FilePath -> CommandStart) -> CommandSeek
|
||||
withFilesUnlocked' typechanged a params = seekActions $
|
||||
prepFiltered a unlockedfiles
|
||||
where
|
||||
check f = liftIO (notSymlink f) <&&>
|
||||
(isJust <$> catKeyFile f <||> isJust <$> catKeyFileHEAD f)
|
||||
unlockedfiles = filterM check =<< seekHelper typechanged params
|
||||
|
||||
{- Finds files that may be modified. -}
|
||||
withFilesMaybeModified :: (FilePath -> CommandStart) -> CommandSeek
|
||||
withFilesMaybeModified a params = seekActions $
|
||||
prepFiltered a $ seekHelper LsFiles.modified params
|
||||
|
||||
withKeys :: (Key -> CommandStart) -> CommandSeek
|
||||
withKeys a params = seekActions $ return $ map (a . parse) params
|
||||
where
|
||||
parse p = fromMaybe (error "bad key") $ file2key p
|
||||
|
||||
{- Gets the value of a field options, which is fed into
|
||||
- a conversion function.
|
||||
-}
|
||||
getOptionField :: Option -> (Maybe String -> Annex a) -> Annex a
|
||||
getOptionField option converter = converter <=< Annex.getField $ optionName option
|
||||
|
||||
getOptionFlag :: Option -> Annex Bool
|
||||
getOptionFlag option = Annex.getFlag (optionName option)
|
||||
|
||||
withNothing :: CommandStart -> CommandSeek
|
||||
withNothing a [] = seekActions $ return [a]
|
||||
withNothing _ _ = error "This command takes no parameters."
|
||||
|
||||
{- If --all is specified, or in a bare repo, runs an action on all
|
||||
- known keys.
|
||||
-
|
||||
- If --unused is specified, runs an action on all keys found by
|
||||
- the last git annex unused scan.
|
||||
-
|
||||
- If --key is specified, operates only on that key.
|
||||
-
|
||||
- Otherwise, fall back to a regular CommandSeek action on
|
||||
- whatever params were passed. -}
|
||||
withKeyOptions :: (Key -> CommandStart) -> CommandSeek -> CommandSeek
|
||||
withKeyOptions keyop fallbackop params = do
|
||||
bare <- fromRepo Git.repoIsLocalBare
|
||||
allkeys <- Annex.getFlag "all"
|
||||
unused <- Annex.getFlag "unused"
|
||||
specifickey <- Annex.getField "key"
|
||||
auto <- Annex.getState Annex.auto
|
||||
when (auto && bare) $
|
||||
error "Cannot use --auto in a bare repository"
|
||||
case (allkeys, unused, null params, specifickey) of
|
||||
(False , False , True , Nothing)
|
||||
| bare -> go auto loggedKeys
|
||||
| otherwise -> fallbackop params
|
||||
(False , False , _ , Nothing) -> fallbackop params
|
||||
(True , False , True , Nothing) -> go auto loggedKeys
|
||||
(False , True , True , Nothing) -> go auto unusedKeys'
|
||||
(False , False , True , Just ks) -> case file2key ks of
|
||||
Nothing -> error "Invalid key"
|
||||
Just k -> go auto $ return [k]
|
||||
_ -> error "Can only specify one of file names, --all, --unused, or --key"
|
||||
where
|
||||
go True _ = error "Cannot use --auto with --all or --unused or --key"
|
||||
go False a = do
|
||||
matcher <- Limit.getMatcher
|
||||
seekActions $ map (process matcher) <$> a
|
||||
process matcher k = ifM (matcher $ MatchingKey k)
|
||||
( keyop k , return Nothing)
|
||||
|
||||
prepFiltered :: (FilePath -> CommandStart) -> Annex [FilePath] -> Annex [CommandStart]
|
||||
prepFiltered a fs = do
|
||||
matcher <- Limit.getMatcher
|
||||
map (process matcher) <$> fs
|
||||
where
|
||||
process matcher f = ifM (matcher $ MatchingFile $ FileInfo f f)
|
||||
( a f , return Nothing )
|
||||
|
||||
seekActions :: Annex [CommandStart] -> Annex ()
|
||||
seekActions gen = do
|
||||
as <- gen
|
||||
mapM_ commandAction as
|
||||
|
||||
seekHelper :: ([FilePath] -> Git.Repo -> IO ([FilePath], IO Bool)) -> [FilePath] -> Annex [FilePath]
|
||||
seekHelper a params = do
|
||||
ll <- inRepo $ \g ->
|
||||
runSegmentPaths (\fs -> Git.Command.leaveZombie <$> a fs g) params
|
||||
{- Show warnings only for files/directories that do not exist. -}
|
||||
forM_ (map fst $ filter (null . snd) $ zip params ll) $ \p ->
|
||||
unlessM (isJust <$> liftIO (catchMaybeIO $ getSymbolicLinkStatus p)) $
|
||||
fileNotFound p
|
||||
return $ concat ll
|
||||
|
||||
notSymlink :: FilePath -> IO Bool
|
||||
notSymlink f = liftIO $ not . isSymbolicLink <$> getSymbolicLinkStatus f
|
Loading…
Add table
Add a link
Reference in a new issue