blob: 59a85be88682044c3011bd4ad9a3267c90106148 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
|
{- 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
import qualified Option
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
withValue :: Annex v -> (v -> CommandSeek) -> CommandSeek
withValue v a params = do
r <- v
a r params
{- Modifies a seek action using the value of a field option, 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 :: Option -> (Maybe String -> Annex a) -> (a -> CommandSeek) -> CommandSeek
withField option converter = withValue $
converter =<< Annex.getField (Option.name option)
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
|
