finished converting all the main options

This commit is contained in:
Joey Hess 2015-07-10 13:18:46 -04:00
parent 5cc882a35e
commit 6a4f2087be
22 changed files with 165 additions and 122 deletions

View file

@ -33,7 +33,7 @@ import Command
import Types.Messages
{- Runs the passed command line. -}
dispatch :: Bool -> CmdParams -> [Command] -> [Parser GlobalSetter] -> [(String, String)] -> IO Git.Repo -> String -> String -> IO ()
dispatch :: Bool -> CmdParams -> [Command] -> [GlobalOption] -> [(String, String)] -> IO Git.Repo -> String -> String -> IO ()
dispatch fuzzyok allargs allcmds globaloptions fields getgitrepo progname progdesc = do
setupConsole
go =<< (E.try getgitrepo :: IO (Either E.SomeException Git.Repo))
@ -81,7 +81,7 @@ dispatch fuzzyok allargs allcmds globaloptions fields getgitrepo progname progde
Just n -> n:args
{- Parses command line, selecting one of the commands from the list. -}
parseCmd :: String -> String -> [Parser GlobalSetter] -> CmdParams -> [Command] -> (Command -> O.Parser v) -> O.ParserResult (Command, v, GlobalSetter)
parseCmd :: String -> String -> [GlobalOption] -> CmdParams -> [Command] -> (Command -> O.Parser v) -> O.ParserResult (Command, v, GlobalSetter)
parseCmd progname progdesc globaloptions allargs allcmds getparser =
O.execParserPure (O.prefs O.idm) pinfo allargs
where
@ -93,7 +93,7 @@ parseCmd progname progdesc globaloptions allargs allcmds getparser =
mkparser c = (,,)
<$> pure c
<*> getparser c
<*> combineGlobalSetters globaloptions
<*> combineGlobalOptions globaloptions
synopsis n d = n ++ " - " ++ d
intro = mconcat $ concatMap (\l -> [H.text l, H.line])
(synopsis progname progdesc : commandList allcmds)

View file

@ -60,7 +60,7 @@ import qualified Command.Find
--import qualified Command.FindRef
--import qualified Command.Whereis
--import qualified Command.List
import qualified Command.Log
--import qualified Command.Log
import qualified Command.Merge
import qualified Command.ResolveMerge
--import qualified Command.Info
@ -87,7 +87,7 @@ import qualified Command.AddUrl
import qualified Command.ImportFeed
#endif
import qualified Command.RmUrl
import qualified Command.Import
--import qualified Command.Import
import qualified Command.Map
import qualified Command.Direct
import qualified Command.Indirect
@ -136,7 +136,7 @@ cmds =
, Command.ImportFeed.cmd
#endif
, Command.RmUrl.cmd
, Command.Import.cmd
-- , Command.Import.cmd
, Command.Init.cmd
, Command.Describe.cmd
, Command.InitRemote.cmd
@ -187,7 +187,7 @@ cmds =
-- , Command.FindRef.cmd
-- , Command.Whereis.cmd
-- , Command.List.cmd
, Command.Log.cmd
-- , Command.Log.cmd
, Command.Merge.cmd
, Command.ResolveMerge.cmd
-- , Command.Info.cmd

View file

@ -7,7 +7,6 @@
module CmdLine.GitAnnex.Options where
import System.Console.GetOpt
import Options.Applicative
import Common.Annex
@ -30,7 +29,7 @@ import CmdLine.GlobalSetter
-- Global options that are accepted by all git-annex sub-commands,
-- although not always used.
gitAnnexGlobalOptions :: [Parser GlobalSetter]
gitAnnexGlobalOptions :: [GlobalOption]
gitAnnexGlobalOptions = commonGlobalOptions ++
[ globalSetter setnumcopies $ option auto
( long "numcopies" <> short 'N' <> metavar paramNumber
@ -86,6 +85,20 @@ gitAnnexGlobalOptions = commonGlobalOptions ++
>>= Annex.changeGitRepo
setdesktopnotify v = Annex.changeState $ \s -> s { Annex.desktopnotify = Annex.desktopnotify s <> v }
{- Parser that accepts all non-option params. -}
cmdParams :: CmdParamsDesc -> Parser CmdParams
cmdParams paramdesc = many $ argument str
( metavar paramdesc
-- Let bash completion complete files
<> action "file"
)
parseAutoOption :: Parser Bool
parseAutoOption = switch
( long "auto" <> short 'a'
<> help "automatic mode"
)
parseRemoteOption :: Parser RemoteName -> Parser (DeferredParse Remote)
parseRemoteOption p = DeferredParse . (fromJust <$$> Remote.byNameWithUUID) . Just <$> p
@ -150,96 +163,125 @@ parseKey :: Monad m => String -> m Key
parseKey = maybe (fail "invalid key") return . file2key
-- Options to match properties of annexed files.
annexedMatchingOptions :: [Option]
annexedMatchingOptions :: [GlobalOption]
annexedMatchingOptions = concat
[ nonWorkTreeMatchingOptions'
, fileMatchingOptions'
-- , combiningOptions
-- , [timeLimitOption]
, combiningOptions
, [timeLimitOption]
]
-- Matching options that don't need to examine work tree files.
nonWorkTreeMatchingOptions :: [Option]
nonWorkTreeMatchingOptions = nonWorkTreeMatchingOptions' -- ++ combiningOptions
nonWorkTreeMatchingOptions :: [GlobalOption]
nonWorkTreeMatchingOptions = nonWorkTreeMatchingOptions' ++ combiningOptions
nonWorkTreeMatchingOptions' :: [Option]
nonWorkTreeMatchingOptions' :: [GlobalOption]
nonWorkTreeMatchingOptions' =
[ Option ['i'] ["in"] (ReqArg Limit.addIn paramRemote)
"match files present in a remote"
, Option ['C'] ["copies"] (ReqArg Limit.addCopies paramNumber)
"skip files with fewer copies"
, Option [] ["lackingcopies"] (ReqArg (Limit.addLackingCopies False) paramNumber)
"match files that need more copies"
, Option [] ["approxlackingcopies"] (ReqArg (Limit.addLackingCopies True) paramNumber)
"match files that need more copies (faster)"
, Option ['B'] ["inbackend"] (ReqArg Limit.addInBackend paramName)
"match files using a key-value backend"
, Option [] ["inallgroup"] (ReqArg Limit.addInAllGroup paramGroup)
"match files present in all remotes in a group"
, Option [] ["metadata"] (ReqArg Limit.addMetaData "FIELD=VALUE")
"match files with attached metadata"
, Option [] ["want-get"] (NoArg Limit.Wanted.addWantGet)
"match files the repository wants to get"
, Option [] ["want-drop"] (NoArg Limit.Wanted.addWantDrop)
"match files the repository wants to drop"
[ globalSetter Limit.addIn $ strOption
( long "in" <> short 'i' <> metavar paramRemote
<> help "match files present in a remote"
<> hidden
)
, globalSetter Limit.addCopies $ strOption
( long "copies" <> short 'C' <> metavar paramRemote
<> help "skip files with fewer copies"
<> hidden
)
, globalSetter (Limit.addLackingCopies False) $ strOption
( long "lackingcopies" <> metavar paramNumber
<> help "match files that need more copies"
<> hidden
)
, globalSetter (Limit.addLackingCopies True) $ strOption
( long "approxlackingcopies" <> metavar paramNumber
<> help "match files that need more copies (faster)"
<> hidden
)
, globalSetter Limit.addInBackend $ strOption
( long "inbackend" <> short 'B' <> metavar paramName
<> help "match files using a key-value backend"
<> hidden
)
, globalSetter Limit.addInAllGroup $ strOption
( long "inallgroup" <> metavar paramGroup
<> help "match files present in all remotes in a group"
<> hidden
)
, globalSetter Limit.addMetaData $ strOption
( long "metadata" <> metavar "FIELD=VALUE"
<> help "match files with attached metadata"
<> hidden
)
, globalFlag Limit.Wanted.addWantGet
( long "want-get"
<> help "match files the repository wants to get"
<> hidden
)
, globalFlag Limit.Wanted.addWantDrop
( long "want-drop"
<> help "match files the repository wants to drop"
<> hidden
)
]
-- Options to match files which may not yet be annexed.
fileMatchingOptions :: [Option]
fileMatchingOptions = fileMatchingOptions' -- ++ combiningOptions
fileMatchingOptions :: [GlobalOption]
fileMatchingOptions = fileMatchingOptions' ++ combiningOptions
fileMatchingOptions' :: [Option]
fileMatchingOptions' :: [GlobalOption]
fileMatchingOptions' =
[ Option ['x'] ["exclude"] (ReqArg Limit.addExclude paramGlob)
"skip files matching the glob pattern"
, Option ['I'] ["include"] (ReqArg Limit.addInclude paramGlob)
"limit to files matching the glob pattern"
, Option [] ["largerthan"] (ReqArg Limit.addLargerThan paramSize)
"match files larger than a size"
, Option [] ["smallerthan"] (ReqArg Limit.addSmallerThan paramSize)
"match files smaller than a size"
[ globalSetter Limit.addExclude $ strOption
( long "exclude" <> short 'x' <> metavar paramGlob
<> help "skip files matching the glob pattern"
<> hidden
)
, globalSetter Limit.addInclude $ strOption
( long "include" <> short 'I' <> metavar paramGlob
<> help "limit to files matching the glob pattern"
<> hidden
)
, globalSetter Limit.addLargerThan $ strOption
( long "largerthan" <> metavar paramSize
<> help "match files larger than a size"
<> hidden
)
, globalSetter Limit.addSmallerThan $ strOption
( long "smallerthan" <> metavar paramSize
<> help "match files smaller than a size"
<> hidden
)
]
combiningOptions :: Parser [GlobalSetter]
combiningOptions :: [GlobalOption]
combiningOptions =
many $ longopt "not" "negate next option"
<|> longopt "and" "both previous and next option must match"
<|> longopt "or" "either previous or next option must match"
<|> shortopt '(' "open group of options"
<|> shortopt ')' "close group of options"
[ longopt "not" "negate next option"
, longopt "and" "both previous and next option must match"
, longopt "or" "either previous or next option must match"
, shortopt '(' "open group of options"
, shortopt ')' "close group of options"
]
where
longopt o h = globalFlag (Limit.addToken o) ( long o <> help h )
shortopt o h = globalFlag (Limit.addToken [o]) ( short o <> help h)
longopt o h = globalFlag (Limit.addToken o) ( long o <> help h <> hidden )
shortopt o h = globalFlag (Limit.addToken [o]) ( short o <> help h <> hidden )
jsonOption :: Parser GlobalSetter
jsonOption :: GlobalOption
jsonOption = globalFlag (Annex.setOutput JSONOutput)
( long "json" <> short 'j'
<> help "enable JSON output"
<> hidden
)
parseJobsOption :: Parser GlobalSetter
parseJobsOption = globalSetter (Annex.setOutput . ParallelOutput) $
jobsOption :: GlobalOption
jobsOption = globalSetter (Annex.setOutput . ParallelOutput) $
option auto
( long "jobs" <> short 'J' <> metavar paramNumber
<> help "enable concurrent jobs"
<> hidden
)
parseTimeLimitOption :: Parser GlobalSetter
parseTimeLimitOption = globalSetter Limit.addTimeLimit $ strOption
timeLimitOption :: GlobalOption
timeLimitOption = globalSetter Limit.addTimeLimit $ strOption
( long "time-limit" <> short 'T' <> metavar paramTime
<> help "stop after the specified amount of time"
)
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
-- Let bash completion complete files
<> action "file"
<> hidden
)

View file

@ -54,7 +54,7 @@ cmds = map adddirparam $ cmds_readonly ++ cmds_notreadonly
where
adddirparam c = c { cmdparamdesc = "DIRECTORY " ++ cmdparamdesc c }
globalOptions :: [Parser GlobalSetter]
globalOptions :: [GlobalOption]
globalOptions =
globalSetter checkUUID (strOption
( long "uuid" <> metavar paramUUID

View file

@ -13,12 +13,12 @@ import Annex
import Options.Applicative
globalFlag :: Annex () -> Mod FlagFields GlobalSetter -> Parser GlobalSetter
globalFlag :: Annex () -> Mod FlagFields GlobalSetter -> GlobalOption
globalFlag setter = flag' (DeferredParse setter)
globalSetter :: (v -> Annex ()) -> Parser v -> Parser GlobalSetter
globalSetter :: (v -> Annex ()) -> Parser v -> GlobalOption
globalSetter setter parser = DeferredParse . setter <$> parser
combineGlobalSetters :: [Parser GlobalSetter] -> Parser GlobalSetter
combineGlobalSetters l = DeferredParse . sequence_ . map getParsed
combineGlobalOptions :: [GlobalOption] -> Parser GlobalSetter
combineGlobalOptions l = DeferredParse . sequence_ . map getParsed
<$> many (foldl1 (<|>) l)

View file

@ -26,7 +26,7 @@ import Types.Messages
import Types.DeferredParse
-- Global options accepted by both git-annex and git-annex-shell sub-commands.
commonGlobalOptions :: [Parser GlobalSetter]
commonGlobalOptions :: [GlobalOption]
commonGlobalOptions =
[ globalFlag (setforce True)
( long "force"

View file

@ -83,12 +83,12 @@ withOptions o c = c { cmdoptions = cmdoptions c ++ o }
{- Adds global options to a command's option parser, and modifies its seek
- option to first run actions for them.
-}
withGlobalOptions :: [Parser GlobalSetter] -> Command -> Command
withGlobalOptions :: [GlobalOption] -> Command -> Command
withGlobalOptions os c = c { cmdparser = apply <$> mixin (cmdparser c) }
where
mixin p = (,)
<$> p
<*> combineGlobalSetters os
<*> combineGlobalOptions os
apply (seek, globalsetters) = do
void $ getParsed globalsetters
seek

View file

@ -35,28 +35,34 @@ import Utility.Tmp
import Control.Exception (IOException)
cmd :: Command
cmd = notBareRepo $ withOptions addOptions $
cmd = notBareRepo $ withGlobalOptions fileMatchingOptions $
command "add" SectionCommon "add files to annex"
paramPaths (withParams seek)
paramPaths (seek <$$> optParser)
addOptions :: [Option]
addOptions = includeDotFilesOption : fileMatchingOptions
data AddOptions = AddOptions
{ addThese :: CmdParams
, includeDotFiles :: Bool
}
includeDotFilesOption :: Option
includeDotFilesOption = flagOption [] "include-dotfiles" "don't skip dotfiles"
optParser :: CmdParamsDesc -> Parser AddOptions
optParser desc = AddOptions
<$> cmdParams desc
<*> switch
( long "include-dotfiles"
<> help "don't skip dotfiles"
)
{- 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 :: CmdParams -> CommandSeek
seek ps = do
seek :: AddOptions -> CommandSeek
seek o = do
matcher <- largeFilesMatcher
let go a = flip a ps $ \file -> ifM (checkFileMatcher matcher file <||> Annex.getState Annex.force)
let go a = flip a (addThese o) $ \file -> ifM (checkFileMatcher matcher file <||> Annex.getState Annex.force)
( start file
, startSmall file
)
skipdotfiles <- not <$> Annex.getFlag (optionName includeDotFilesOption)
go $ withFilesNotInGit skipdotfiles
go $ withFilesNotInGit (not $ includeDotFiles o)
ifM isDirect
( go withFilesMaybeModified
, go withFilesUnlocked

View file

@ -23,9 +23,10 @@ import Annex.Notification
import qualified Data.Set as S
cmd :: Command
cmd = command "drop" SectionCommon
"remove content of files from repository"
paramPaths (seek <$$> optParser)
cmd = withGlobalOptions annexedMatchingOptions $
command "drop" SectionCommon
"remove content of files from repository"
paramPaths (seek <$$> optParser)
data DropOptions = DropOptions
{ dropFiles :: CmdParams
@ -34,8 +35,6 @@ data DropOptions = DropOptions
, keyOptions :: Maybe KeyOptions
}
-- TODO: annexedMatchingOptions
optParser :: CmdParamsDesc -> Parser DropOptions
optParser desc = DropOptions
<$> cmdParams desc

View file

@ -19,7 +19,7 @@ import Utility.DataUnits
import Types.Key
cmd :: Command
cmd = withOptions annexedMatchingOptions $ mkCommand $
cmd = withGlobalOptions annexedMatchingOptions $ mkCommand $
command "find" SectionQuery "lists available files"
paramPaths (seek <$$> optParser)

View file

@ -19,7 +19,7 @@ import Utility.Touch
#endif
cmd :: Command
cmd = notDirect $ noCommit $ withOptions annexedMatchingOptions $
cmd = notDirect $ noCommit $ withGlobalOptions annexedMatchingOptions $
command "fix" SectionMaintenance
"fix up symlinks to point to annexed content"
paramPaths (withParams seek)

View file

@ -41,9 +41,10 @@ import Data.Time.Clock.POSIX
import System.Posix.Types (EpochTime)
cmd :: Command
cmd = command "fsck" SectionMaintenance
"find and fix problems"
paramPaths (seek <$$> optParser)
cmd = withGlobalOptions annexedMatchingOptions $
command "fsck" SectionMaintenance
"find and fix problems"
paramPaths (seek <$$> optParser)
data FsckOptions = FsckOptions
{ fsckFiles :: CmdParams
@ -52,8 +53,6 @@ data FsckOptions = FsckOptions
, keyOptions :: Maybe KeyOptions
}
-- TODO: annexedMatchingOptions
data IncrementalOpt
= StartIncrementalO
| MoreIncrementalO

View file

@ -17,9 +17,10 @@ import Annex.Wanted
import qualified Command.Move
cmd :: Command
cmd = command "get" SectionCommon
"make content of annexed files available"
paramPaths (seek <$$> optParser)
cmd = withGlobalOptions (jobsOption : annexedMatchingOptions) $
command "get" SectionCommon
"make content of annexed files available"
paramPaths (seek <$$> optParser)
data GetOptions = GetOptions
{ getFiles :: CmdParams
@ -35,8 +36,6 @@ optParser desc = GetOptions
<*> parseAutoOption
<*> optional (parseKeyOptions True)
-- TODO: jobsOption, annexedMatchingOptions
seek :: GetOptions -> CommandSeek
seek o = do
from <- maybe (pure Nothing) (Just <$$> getParsed) (getFrom o)

View file

@ -28,7 +28,7 @@ cmd = withOptions opts $ notBareRepo $
"move and add files from outside git working copy"
paramPaths (withParams seek)
opts :: [Option]
opts :: [GlobalOption]
opts = duplicateModeOptions ++ fileMatchingOptions
data DuplicateMode = Default | Duplicate | DeDuplicate | CleanDuplicates | SkipDuplicates

View file

@ -13,7 +13,7 @@ import qualified Annex.Queue
import qualified Annex
cmd :: Command
cmd = notDirect $ withOptions annexedMatchingOptions $
cmd = notDirect $ withGlobalOptions annexedMatchingOptions $
command "lock" SectionCommon
"undo unlock command"
paramPaths (withParams seek)

View file

@ -39,11 +39,11 @@ data RefChange = RefChange
type Outputter = Bool -> POSIXTime -> [UUID] -> Annex ()
cmd :: Command
cmd = withOptions options $
cmd = withGlobalOptions options $
command "log" SectionQuery "shows location log"
paramPaths (withParams seek)
options :: [Option]
options :: [GlobalOption]
options = passthruOptions ++ [gourceOption] ++ annexedMatchingOptions
passthruOptions :: [Option]

View file

@ -19,7 +19,7 @@ import qualified Command.Fsck
import qualified Annex
cmd :: Command
cmd = notDirect $ withOptions annexedMatchingOptions $
cmd = notDirect $ withGlobalOptions annexedMatchingOptions $
command "migrate" SectionUtility
"switch data to different backend"
paramPaths (withParams seek)

View file

@ -18,9 +18,10 @@ import Annex.Transfer
import Logs.Presence
cmd :: Command
cmd = command "move" SectionCommon
"move content of files to/from another repository"
paramPaths (seek <--< optParser)
cmd = withGlobalOptions (jobsOption : annexedMatchingOptions) $
command "move" SectionCommon
"move content of files to/from another repository"
paramPaths (seek <--< optParser)
data MoveOptions = MoveOptions
{ moveFiles :: CmdParams
@ -28,8 +29,6 @@ data MoveOptions = MoveOptions
, keyOptions :: Maybe KeyOptions
}
-- TODO: jobsOption, annexedMatchingOptions
optParser :: CmdParamsDesc -> Parser MoveOptions
optParser desc = MoveOptions
<$> cmdParams desc

View file

@ -23,7 +23,7 @@ import Utility.CopyFile
import Command.PreCommit (lockPreCommitHook)
cmd :: Command
cmd = withOptions annexedMatchingOptions $
cmd = withGlobalOptions annexedMatchingOptions $
command "unannex" SectionUtility
"undo accidential add command"
paramPaths (withParams seek)

View file

@ -20,7 +20,7 @@ editcmd :: Command
editcmd = mkcmd "edit" "same as unlock"
mkcmd :: String -> String -> Command
mkcmd n d = notDirect $ withOptions annexedMatchingOptions $
mkcmd n d = notDirect $ withGlobalOptions annexedMatchingOptions $
command n SectionCommon d paramPaths (withParams seek)
seek :: CmdParams -> CommandSeek

View file

@ -16,7 +16,7 @@ import Logs.Trust
import Logs.Web
cmd :: Command
cmd = noCommit $ withOptions (jsonOption : annexedMatchingOptions ++ keyOptions) $
cmd = noCommit $ withGlobalOptions (jsonOption : annexedMatchingOptions) $
command "whereis" SectionQuery
"lists repositories that have file content"
paramPaths (withParams seek)
@ -27,8 +27,6 @@ data WhereisOptions = WhereisOptions
, keyOptions :: Maybe KeyOptions
}
-- TODO: annexedMatchingOptions
seek :: CmdParams -> CommandSeek
seek ps = do
m <- remoteMap id

View file

@ -39,3 +39,4 @@ instance DeferredParseClass [DeferredParse a] where
-- Use when the Annex action modifies Annex state.
type GlobalSetter = DeferredParse ()
type GlobalOption = Parser GlobalSetter