summaryrefslogtreecommitdiff
path: root/CmdLine
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2015-07-08 17:59:06 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2015-07-08 17:59:06 -0400
commite5fadb1bbcd0bafc9d2e9c5ded2e644e532baafc (patch)
tree9c616f65306c3eb49cd616bb213002ca4811963d /CmdLine
parent249e0861520a2904f70bf4b79a4ebddc009c3683 (diff)
wip
Diffstat (limited to 'CmdLine')
-rw-r--r--CmdLine/GitAnnex/Options.hs84
-rw-r--r--CmdLine/Seek.hs29
2 files changed, 79 insertions, 34 deletions
diff --git a/CmdLine/GitAnnex/Options.hs b/CmdLine/GitAnnex/Options.hs
index 320268f6a..1472a4d2b 100644
--- a/CmdLine/GitAnnex/Options.hs
+++ b/CmdLine/GitAnnex/Options.hs
@@ -1,4 +1,4 @@
-{- git-annex options
+{- git-annex command-line option parsing
-
- Copyright 2010-2015 Joey Hess <id@joeyh.name>
-
@@ -8,6 +8,7 @@
module CmdLine.GitAnnex.Options where
import System.Console.GetOpt
+import Options.Applicative
import Common.Annex
import qualified Git.Config
@@ -15,6 +16,8 @@ import Git.Types
import Types.TrustLevel
import Types.NumCopies
import Types.Messages
+import Types.Key
+import Types.Command
import qualified Annex
import qualified Remote
import qualified Limit
@@ -51,24 +54,50 @@ gitAnnexOptions = commonOptions ++
>>= pure . (\r -> r { gitGlobalOpts = gitGlobalOpts r ++ [Param "-c", Param v] })
>>= Annex.changeGitRepo
--- Options for matching on annexed keys, rather than work tree files.
-keyOptions :: [Option]
-keyOptions = [ allOption, unusedOption, keyOption]
-
-allOption :: Option
-allOption = Option ['A'] ["all"] (NoArg (Annex.setFlag "all"))
- "operate on all versions of all files"
-
-unusedOption :: Option
-unusedOption = Option ['U'] ["unused"] (NoArg (Annex.setFlag "unused"))
- "operate on files found by last run of git-annex unused"
-
-keyOption :: Option
-keyOption = Option [] ["key"] (ReqArg (Annex.setField "key") paramKey)
- "operate on specified key"
-
-incompleteOption :: Option
-incompleteOption = flagOption [] "incomplete" "resume previous downloads"
+-- Options for acting on keys, rather than work tree files.
+data KeyOptions = KeyOptions
+ { wantAllKeys :: Bool
+ , wantUnusedKeys :: Bool
+ , wantIncompleteKeys :: Bool
+ , wantSpecificKey :: Maybe Key
+ }
+
+parseKeyOptions :: Bool -> Parser KeyOptions
+parseKeyOptions allowincomplete = KeyOptions
+ <$> parseAllKeysOption
+ <*> parseUnusedKeysOption
+ <*> (if allowincomplete then parseIncompleteOption else pure False)
+ <*> parseSpecificKeyOption
+
+parseAllKeysOption :: Parser Bool
+parseAllKeysOption = switch
+ ( long "all"
+ <> short 'A'
+ <> help "operate on all versions of all files"
+ )
+
+parseUnusedKeysOption :: Parser Bool
+parseUnusedKeysOption = switch
+ ( long "unused"
+ <> short 'U'
+ <> help "operate on files found by last run of git-annex unused"
+ )
+
+parseSpecificKeyOption :: Parser (Maybe Key)
+parseSpecificKeyOption = finalOpt $ option (str >>= parseKey)
+ ( long "key"
+ <> help "operate on specified key"
+ <> metavar paramKey
+ )
+
+parseKey :: Monad m => String -> m Key
+parseKey = maybe (fail "invalid key") return . file2key
+
+parseIncompleteOption :: Parser Bool
+parseIncompleteOption = switch
+ ( long "incomplete"
+ <> help "resume previous downloads"
+ )
-- Options to match properties of annexed files.
annexedMatchingOptions :: [Option]
@@ -161,3 +190,20 @@ timeLimitOption = Option ['T'] ["time-limit"]
autoOption :: Option
autoOption = flagOption ['a'] "auto" "automatic mode"
+
+parseAutoOption :: Parser Bool
+parseAutoOption = switch
+ ( long "auto"
+ <> short 'a'
+ <> help "automatic mode"
+ )
+
+{- Parser that accepts all non-option params. -}
+cmdParams :: CmdParamsDesc -> Parser CmdParams
+cmdParams paramdesc = many (argument str (metavar paramdesc))
+
+{- Makes an option parser that is normally required be optional;
+ - - its switch can be given zero or more times, and the last one
+ - - given will be used. -}
+finalOpt :: Parser a -> Parser (Maybe a)
+finalOpt = lastMaybe <$$> many
diff --git a/CmdLine/Seek.hs b/CmdLine/Seek.hs
index 66f57e1b0..1d6708191 100644
--- a/CmdLine/Seek.hs
+++ b/CmdLine/Seek.hs
@@ -23,6 +23,7 @@ import qualified Git.LsTree as LsTree
import Git.FilePath
import qualified Limit
import CmdLine.Option
+import CmdLine.GitAnnex.Options
import CmdLine.Action
import Logs.Location
import Logs.Unused
@@ -171,40 +172,38 @@ withNothing _ _ = error "This command takes no parameters."
-
- Otherwise falls back to a regular CommandSeek action on
- whatever params were passed. -}
-withKeyOptions :: Bool -> (Key -> CommandStart) -> (CmdParams -> CommandSeek) -> CmdParams -> CommandSeek
-withKeyOptions auto keyop = withKeyOptions' auto $ \getkeys -> do
+withKeyOptions :: KeyOptions -> Bool -> (Key -> CommandStart) -> (CmdParams -> CommandSeek) -> CmdParams -> CommandSeek
+withKeyOptions ko auto keyaction = withKeyOptions' ko auto $ \getkeys -> do
matcher <- Limit.getMatcher
seekActions $ map (process matcher) <$> getkeys
where
process matcher k = ifM (matcher $ MatchingKey k)
- ( keyop k
+ ( keyaction k
, return Nothing
)
-withKeyOptions' :: Bool -> (Annex [Key] -> Annex ()) -> (CmdParams -> CommandSeek) -> CmdParams -> CommandSeek
-withKeyOptions' auto keyop fallbackop params = do
+withKeyOptions' :: KeyOptions -> Bool -> (Annex [Key] -> Annex ()) -> (CmdParams -> CommandSeek) -> CmdParams -> CommandSeek
+withKeyOptions' ko auto keyaction fallbackaction params = do
bare <- fromRepo Git.repoIsLocalBare
- allkeys <- Annex.getFlag "all"
- unused <- Annex.getFlag "unused"
- incomplete <- Annex.getFlag "incomplete"
- specifickey <- Annex.getField "key"
+ let allkeys = wantAllKeys ko
+ let unused = wantUnusedKeys ko
+ let incomplete = wantIncompleteKeys ko
+ let specifickey = wantSpecificKey ko
when (auto && bare) $
error "Cannot use --auto in a bare repository"
case (allkeys, unused, incomplete, null params, specifickey) of
(False , False , False , True , Nothing)
| bare -> go auto loggedKeys
- | otherwise -> fallbackop params
- (False , False , False , _ , Nothing) -> fallbackop params
+ | otherwise -> fallbackaction params
+ (False , False , False , _ , Nothing) -> fallbackaction params
(True , False , False , True , Nothing) -> go auto loggedKeys
(False , True , False , True , Nothing) -> go auto unusedKeys'
(False , False , True , True , Nothing) -> go auto incompletekeys
- (False , False , False , True , Just ks) -> case file2key ks of
- Nothing -> error "Invalid key"
- Just k -> go auto $ return [k]
+ (False , False , False , True , Just k) -> go auto $ return [k]
_ -> error "Can only specify one of file names, --all, --unused, --key, or --incomplete"
where
go True _ = error "Cannot use --auto with --all or --unused or --key or --incomplete"
- go False getkeys = keyop getkeys
+ go False getkeys = keyaction getkeys
incompletekeys = staleKeysPrune gitAnnexTmpObjectDir True
prepFiltered :: (FilePath -> CommandStart) -> Annex [FilePath] -> Annex [CommandStart]