diff options
Diffstat (limited to 'Command')
-rw-r--r-- | Command/Add.hs | 10 | ||||
-rw-r--r-- | Command/FromKey.hs | 14 | ||||
-rw-r--r-- | Command/ReKey.hs | 36 | ||||
-rw-r--r-- | Command/RmUrl.hs | 32 |
4 files changed, 67 insertions, 25 deletions
diff --git a/Command/Add.hs b/Command/Add.hs index eeaaf5d34..f9cfbb9a1 100644 --- a/Command/Add.hs +++ b/Command/Add.hs @@ -41,9 +41,6 @@ optParser desc = AddOptions ) <*> parseBatchOption -{- Add acts on both files not checked into git yet, and unlocked files. - - - - In direct mode, it acts on any files that have changed. -} seek :: AddOptions -> CommandSeek seek o = allowConcurrentOutput $ do matcher <- largeFilesMatcher @@ -59,10 +56,9 @@ seek o = allowConcurrentOutput $ do NoBatch -> do let go a = a gofile (addThese o) go (withFilesNotInGit (not $ includeDotFiles o)) - ifM (versionSupportsUnlockedPointers <||> isDirect) - ( go withFilesMaybeModified - , go withFilesOldUnlocked - ) + go withFilesMaybeModified + unlessM (versionSupportsUnlockedPointers <||> isDirect) $ + go withFilesOldUnlocked {- Pass file off to git-add. -} startSmall :: FilePath -> CommandStart diff --git a/Command/FromKey.hs b/Command/FromKey.hs index 670e9e6a6..dca63aabe 100644 --- a/Command/FromKey.hs +++ b/Command/FromKey.hs @@ -20,16 +20,17 @@ import Network.URI cmd :: Command cmd = notDirect $ notBareRepo $ command "fromkey" SectionPlumbing "adds a file using a specific key" - (paramPair paramKey paramPath) + (paramRepeating (paramPair paramKey paramPath)) (withParams seek) seek :: CmdParams -> CommandSeek +seek [] = withNothing startMass [] seek ps = do force <- Annex.getState Annex.force - withWords (start force) ps + withPairs (start force) ps -start :: Bool -> [String] -> CommandStart -start force (keyname:file:[]) = do +start :: Bool -> (String, FilePath) -> CommandStart +start force (keyname, file) = do let key = mkKey keyname unless force $ do inbackend <- inAnnex key @@ -37,10 +38,11 @@ start force (keyname:file:[]) = do "key ("++ keyname ++") is not present in backend (use --force to override this sanity check)" showStart "fromkey" file next $ perform key file -start _ [] = do + +startMass :: CommandStart +startMass = do showStart "fromkey" "stdin" next massAdd -start _ _ = giveup "specify a key and a dest file" massAdd :: CommandPerform massAdd = go True =<< map (separate (== ' ')) . lines <$> liftIO getContents diff --git a/Command/ReKey.hs b/Command/ReKey.hs index 33734ebe7..4ddbd68b6 100644 --- a/Command/ReKey.hs +++ b/Command/ReKey.hs @@ -25,15 +25,39 @@ cmd = notDirect $ command "rekey" SectionPlumbing "change keys used for files" (paramRepeating $ paramPair paramPath paramKey) - (withParams seek) + (seek <$$> optParser) -seek :: CmdParams -> CommandSeek -seek = withPairs start +data ReKeyOptions = ReKeyOptions + { reKeyThese :: CmdParams + , batchOption :: BatchMode + } -start :: (FilePath, String) -> CommandStart -start (file, keyname) = ifAnnexed file go stop +optParser :: CmdParamsDesc -> Parser ReKeyOptions +optParser desc = ReKeyOptions + <$> cmdParams desc + <*> parseBatchOption + +-- Split on the last space, since a FilePath can contain whitespace, +-- but a Key very rarely does. +batchParser :: String -> Either String (FilePath, Key) +batchParser s = case separate (== ' ') (reverse s) of + (rk, rf) + | null rk || null rf -> Left "Expected: \"file key\"" + | otherwise -> case file2key (reverse rk) of + Nothing -> Left "bad key" + Just k -> Right (reverse rf, k) + +seek :: ReKeyOptions -> CommandSeek +seek o = case batchOption o of + Batch -> batchInput batchParser (batchCommandAction . start) + NoBatch -> withPairs (start . parsekey) (reKeyThese o) + where + parsekey (file, skey) = + (file, fromMaybe (giveup "bad key") (file2key skey)) + +start :: (FilePath, Key) -> CommandStart +start (file, newkey) = ifAnnexed file go stop where - newkey = fromMaybe (giveup "bad key") $ file2key keyname go oldkey | oldkey == newkey = stop | otherwise = do diff --git a/Command/RmUrl.hs b/Command/RmUrl.hs index eb78f7ba7..1a547a71e 100644 --- a/Command/RmUrl.hs +++ b/Command/RmUrl.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2013 Joey Hess <id@joeyh.name> + - Copyright 2013-2016 Joey Hess <id@joeyh.name> - - Licensed under the GNU GPL version 3 or higher. -} @@ -15,13 +15,33 @@ cmd :: Command cmd = notBareRepo $ command "rmurl" SectionCommon "record file is not available at url" - (paramPair paramFile paramUrl) - (withParams seek) + (paramRepeating (paramPair paramFile paramUrl)) + (seek <$$> optParser) -seek :: CmdParams -> CommandSeek -seek = withPairs start +data RmUrlOptions = RmUrlOptions + { rmThese :: CmdParams + , batchOption :: BatchMode + } -start :: (FilePath, String) -> CommandStart +optParser :: CmdParamsDesc -> Parser RmUrlOptions +optParser desc = RmUrlOptions + <$> cmdParams desc + <*> parseBatchOption + +seek :: RmUrlOptions -> CommandSeek +seek o = case batchOption o of + Batch -> batchInput batchParser (batchCommandAction . start) + NoBatch -> withPairs start (rmThese o) + +-- Split on the last space, since a FilePath can contain whitespace, +-- but a url should not. +batchParser :: String -> Either String (FilePath, URLString) +batchParser s = case separate (== ' ') (reverse s) of + (ru, rf) + | null ru || null rf -> Left "Expected: \"file url\"" + | otherwise -> Right (reverse rf, reverse ru) + +start :: (FilePath, URLString) -> CommandStart start (file, url) = flip whenAnnexed file $ \_ key -> do showStart "rmurl" file next $ next $ cleanup url key |