Merge branch 'optparse-applicative'

This commit is contained in:
Joey Hess 2015-07-13 13:25:57 -04:00
commit 36b37311e4
122 changed files with 2095 additions and 1549 deletions

View file

@ -57,7 +57,6 @@ import Types.UUID
import Types.FileMatcher
import Types.NumCopies
import Types.LockCache
import Types.MetaData
import Types.DesktopNotify
import Types.CleanupActions
#ifdef WITH_QUVI
@ -121,7 +120,6 @@ data AnnexState = AnnexState
, lockcache :: LockCache
, flags :: M.Map String Bool
, fields :: M.Map String String
, modmeta :: [ModMeta]
, cleanup :: M.Map CleanupAction (Annex ())
, sentinalstatus :: Maybe SentinalStatus
, useragent :: Maybe String
@ -166,7 +164,6 @@ newState c r = AnnexState
, lockcache = M.empty
, flags = M.empty
, fields = M.empty
, modmeta = []
, cleanup = M.empty
, sentinalstatus = Nothing
, useragent = Nothing

View file

@ -45,7 +45,7 @@ while (<>) {
if ($inNAME) {
# make lexgrog happy
s/^git-annex /git-annex-/;
s/^git-annex (\w)/git-annex-$1/;
}
if ($_ eq ".SH NAME\n") {
$inNAME=1;

View file

@ -1,6 +1,6 @@
{- git-annex command line parsing and dispatch
-
- Copyright 2010-2012 Joey Hess <id@joeyh.name>
- Copyright 2010-2015 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@ -13,10 +13,11 @@ module CmdLine (
shutdown
) where
import qualified Options.Applicative as O
import qualified Options.Applicative.Help as H
import qualified Control.Exception as E
import qualified Data.Map as M
import Control.Exception (throw)
import System.Console.GetOpt
#ifndef mingw32_HOST_OS
import System.Posix.Signals
#endif
@ -32,48 +33,81 @@ import Command
import Types.Messages
{- Runs the passed command line. -}
dispatch :: Bool -> CmdParams -> [Command] -> [Option] -> [(String, String)] -> String -> IO Git.Repo -> IO ()
dispatch fuzzyok allargs allcmds commonoptions fields header getgitrepo = do
dispatch :: Bool -> CmdParams -> [Command] -> [GlobalOption] -> [(String, String)] -> IO Git.Repo -> String -> String -> IO ()
dispatch fuzzyok allargs allcmds globaloptions fields getgitrepo progname progdesc = do
setupConsole
case getOptCmd args cmd commonoptions of
Right (flags, params) -> go flags params
=<< (E.try getgitrepo :: IO (Either E.SomeException Git.Repo))
Left parseerr -> error parseerr
go =<< (E.try getgitrepo :: IO (Either E.SomeException Git.Repo))
where
go flags params (Right g) = do
go (Right g) = do
state <- Annex.new g
Annex.eval state $ do
checkEnvironment
when fuzzy $
inRepo $ autocorrect . Just
forM_ fields $ uncurry Annex.setField
(cmd, seek, globalconfig) <- parsewith cmdparser
(\a -> inRepo $ a . Just)
when (cmdnomessages cmd) $
Annex.setOutput QuietOutput
sequence_ flags
getParsed globalconfig
whenM (annexDebug <$> Annex.getGitConfig) $
liftIO enableDebugOutput
startup
performCommandAction cmd params $
performCommandAction cmd seek $
shutdown $ cmdnocommit cmd
go _flags params (Left e) = do
when fuzzy $
autocorrect =<< Git.Config.global
maybe (throw e) (\a -> a params) (cmdnorepo cmd)
err msg = msg ++ "\n\n" ++ usage header allcmds
cmd = Prelude.head cmds
(fuzzy, cmds, name, args) = findCmd fuzzyok allargs allcmds err
autocorrect = Git.AutoCorrect.prepare name cmdname cmds
go (Left norepo) = do
(_, a, _globalconfig) <- parsewith
(fromMaybe (throw norepo) . cmdnorepo)
(\a -> a =<< Git.Config.global)
a
parsewith getparser ingitrepo =
case parseCmd progname progdesc globaloptions allargs allcmds getparser of
O.Failure _ -> do
-- parse failed, so fall back to
-- fuzzy matching, or to showing usage
when fuzzy $
ingitrepo autocorrect
liftIO (O.handleParseResult (parseCmd progname progdesc globaloptions correctedargs allcmds getparser))
res -> liftIO (O.handleParseResult res)
where
autocorrect = Git.AutoCorrect.prepare (fromJust inputcmdname) cmdname cmds
(fuzzy, cmds, inputcmdname, args) = findCmd fuzzyok allargs allcmds
name
| fuzzy = case cmds of
(c:_) -> Just (cmdname c)
_ -> inputcmdname
| otherwise = inputcmdname
correctedargs = case name of
Nothing -> allargs
Just n -> n:args
{- Parses command line, selecting one of the commands from the list. -}
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
pinfo = O.info (O.helper <*> subcmds) (O.progDescDoc (Just intro))
subcmds = O.hsubparser $ mconcat $ map mkcommand allcmds
mkcommand c = O.command (cmdname c) $ O.info (mkparser c) $ O.fullDesc
<> O.header (synopsis (progname ++ " " ++ cmdname c) (cmddesc c))
<> O.footer ("For details, run: " ++ progname ++ " help " ++ cmdname c)
mkparser c = (,,)
<$> pure c
<*> getparser c
<*> combineGlobalOptions globaloptions
synopsis n d = n ++ " - " ++ d
intro = mconcat $ concatMap (\l -> [H.text l, H.line])
(synopsis progname progdesc : commandList allcmds)
{- Parses command line params far enough to find the Command to run, and
- returns the remaining params.
- Does fuzzy matching if necessary, which may result in multiple Commands. -}
findCmd :: Bool -> CmdParams -> [Command] -> (String -> String) -> (Bool, [Command], String, CmdParams)
findCmd fuzzyok argv cmds err
| isNothing name = error $ err "missing command"
| not (null exactcmds) = (False, exactcmds, fromJust name, args)
| fuzzyok && not (null inexactcmds) = (True, inexactcmds, fromJust name, args)
| otherwise = error $ err $ "unknown command " ++ fromJust name
findCmd :: Bool -> CmdParams -> [Command] -> (Bool, [Command], Maybe String, CmdParams)
findCmd fuzzyok argv cmds
| not (null exactcmds) = ret (False, exactcmds)
| fuzzyok && not (null inexactcmds) = ret (True, inexactcmds)
| otherwise = ret (False, [])
where
ret (fuzzy, matches) = (fuzzy, matches, name, args)
(name, args) = findname argv []
findname [] c = (Nothing, reverse c)
findname (a:as) c
@ -84,18 +118,6 @@ findCmd fuzzyok argv cmds err
Nothing -> []
Just n -> Git.AutoCorrect.fuzzymatches n cmdname cmds
{- Parses command line options, and returns actions to run to configure flags
- and the remaining parameters for the command. -}
getOptCmd :: CmdParams -> Command -> [Option] -> Either String ([Annex ()], CmdParams)
getOptCmd argv cmd commonoptions = check $
getOpt Permute (commonoptions ++ cmdoptions cmd) argv
where
check (flags, rest, []) = Right (flags, rest)
check (_, _, errs) = Left $ unlines
[ concat errs
, commandUsage cmd
]
{- Actions to perform each time ran. -}
startup :: Annex ()
startup =

View file

@ -22,11 +22,11 @@ import Data.Either
{- Runs a command, starting with the check stage, and then
- the seek stage. Finishes by running the continutation, and
- then showing a count of any failures. -}
performCommandAction :: Command -> CmdParams -> Annex () -> Annex ()
performCommandAction Command { cmdseek = seek, cmdcheck = c, cmdname = name } params cont = do
performCommandAction :: Command -> CommandSeek -> Annex () -> Annex ()
performCommandAction Command { cmdcheck = c, cmdname = name } seek cont = do
mapM_ runCheck c
Annex.changeState $ \s -> s { Annex.errcounter = 0 }
seek params
seek
finishCommandActions
cont
showerrcount =<< Annex.getState Annex.errcounter

View file

@ -10,29 +10,42 @@ module CmdLine.Batch where
import Common.Annex
import Command
batchOption :: Option
batchOption = flagOption [] "batch" "enable batch mode"
data BatchMode = Batch | NoBatch
batchOption :: Parser BatchMode
batchOption = flag NoBatch Batch
( long "batch"
<> help "enable batch mode"
)
type Batchable t = BatchMode -> t -> CommandStart
-- A Batchable command can run in batch mode, or not.
-- In batch mode, one line at a time is read, parsed, and a reply output to
-- stdout. In non batch mode, the command's parameters are parsed and
-- a reply output for each.
batchable :: ((t -> CommandStart) -> CommandSeek) -> Batchable t -> CommandSeek
batchable seeker starter params = ifM (getOptionFlag batchOption)
( batchloop
, seeker (starter NoBatch) params
)
batchable :: (opts -> String -> Annex Bool) -> Parser opts -> CmdParamsDesc -> CommandParser
batchable handler parser paramdesc = batchseeker <$> batchparser
where
batchloop = do
batchparser = (,,)
<$> parser
<*> batchOption
<*> cmdParams paramdesc
batchseeker (opts, NoBatch, params) = mapM_ (go NoBatch opts) params
batchseeker (opts, Batch, _) = batchloop opts
batchloop opts = do
mp <- liftIO $ catchMaybeIO getLine
case mp of
Nothing -> return ()
Just p -> do
seeker (starter Batch) [p]
batchloop
go Batch opts p
batchloop opts
go batchmode opts p =
unlessM (handler opts p) $
batchBadInput batchmode
-- bad input is indicated by an empty line in batch mode. In non batch
-- mode, exit on bad input.

View file

@ -1,6 +1,6 @@
{- git-annex main program
-
- Copyright 2010-2014 Joey Hess <id@joeyh.name>
- Copyright 2010-2015 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@ -14,13 +14,16 @@ import CmdLine
import Command
import Utility.Env
import Annex.Ssh
import Types.Test
import qualified Command.Help
import qualified Command.Add
import qualified Command.Unannex
import qualified Command.Drop
import qualified Command.Move
import qualified Command.Copy
import qualified Command.Get
import qualified Command.Fsck
import qualified Command.LookupKey
import qualified Command.ContentLocation
import qualified Command.ExamineKey
@ -46,7 +49,6 @@ import qualified Command.Init
import qualified Command.Describe
import qualified Command.InitRemote
import qualified Command.EnableRemote
import qualified Command.Fsck
import qualified Command.Expire
import qualified Command.Repair
import qualified Command.Unused
@ -96,7 +98,6 @@ import qualified Command.Proxy
import qualified Command.DiffDriver
import qualified Command.Undo
import qualified Command.Version
import qualified Command.Help
#ifdef WITH_ASSISTANT
import qualified Command.Watch
import qualified Command.Assistant
@ -117,14 +118,17 @@ import qualified Command.TestRemote
import System.Remote.Monitoring
#endif
cmds :: [Command]
cmds = concat
[ Command.Add.cmd
cmds :: Parser TestOptions -> Maybe TestRunner -> [Command]
cmds testoptparser testrunner =
[ Command.Help.cmd
, Command.Add.cmd
, Command.Get.cmd
, Command.Drop.cmd
, Command.Move.cmd
, Command.Copy.cmd
, Command.Fsck.cmd
, Command.Unlock.cmd
, Command.Unlock.editcmd
, Command.Lock.cmd
, Command.Sync.cmd
, Command.Mirror.cmd
@ -175,7 +179,6 @@ cmds = concat
, Command.VPop.cmd
, Command.VCycle.cmd
, Command.Fix.cmd
, Command.Fsck.cmd
, Command.Expire.cmd
, Command.Repair.cmd
, Command.Unused.cmd
@ -200,7 +203,6 @@ cmds = concat
, Command.DiffDriver.cmd
, Command.Undo.cmd
, Command.Version.cmd
, Command.Help.cmd
#ifdef WITH_ASSISTANT
, Command.Watch.cmd
, Command.Assistant.cmd
@ -212,24 +214,25 @@ cmds = concat
#endif
, Command.RemoteDaemon.cmd
#endif
, Command.Test.cmd
, Command.Test.cmd testoptparser testrunner
#ifdef WITH_TESTSUITE
, Command.FuzzTest.cmd
, Command.TestRemote.cmd
#endif
]
header :: String
header = "git-annex command [option ...]"
run :: [String] -> IO ()
run args = do
run :: Parser TestOptions -> Maybe TestRunner -> [String] -> IO ()
run testoptparser testrunner args = do
#ifdef WITH_EKG
_ <- forkServer "localhost" 4242
#endif
go envmodes
where
go [] = dispatch True args cmds gitAnnexOptions [] header Git.CurrentRepo.get
go [] = dispatch True args
(cmds testoptparser testrunner)
gitAnnexGlobalOptions [] Git.CurrentRepo.get
"git-annex"
"manage files with git, without checking their contents in"
go ((v, a):rest) = maybe (go rest) a =<< getEnv v
envmodes =
[ (sshOptionsEnv, runSshOptions args)

View file

@ -1,4 +1,4 @@
{- git-annex options
{- git-annex command-line option parsing
-
- Copyright 2010-2015 Joey Hess <id@joeyh.name>
-
@ -7,7 +7,7 @@
module CmdLine.GitAnnex.Options where
import System.Console.GetOpt
import Options.Applicative
import Common.Annex
import qualified Git.Config
@ -15,63 +15,155 @@ import Git.Types
import Types.TrustLevel
import Types.NumCopies
import Types.Messages
import Types.Key
import Types.Command
import Types.DeferredParse
import Types.DesktopNotify
import qualified Annex
import qualified Remote
import qualified Limit
import qualified Limit.Wanted
import CmdLine.Option
import CmdLine.Usage
import CmdLine.GlobalSetter
-- Options that are accepted by all git-annex sub-commands,
-- Global options that are accepted by all git-annex sub-commands,
-- although not always used.
gitAnnexOptions :: [Option]
gitAnnexOptions = commonOptions ++
[ Option ['N'] ["numcopies"] (ReqArg setnumcopies paramNumber)
"override default number of copies"
, Option [] ["trust"] (trustArg Trusted)
"override trust setting"
, Option [] ["semitrust"] (trustArg SemiTrusted)
"override trust setting back to default"
, Option [] ["untrust"] (trustArg UnTrusted)
"override trust setting to untrusted"
, Option ['c'] ["config"] (ReqArg setgitconfig "NAME=VALUE")
"override git configuration setting"
, Option [] ["user-agent"] (ReqArg setuseragent paramName)
"override default User-Agent"
, Option [] ["trust-glacier"] (NoArg (Annex.setFlag "trustglacier"))
"Trust Amazon Glacier inventory"
gitAnnexGlobalOptions :: [GlobalOption]
gitAnnexGlobalOptions = commonGlobalOptions ++
[ globalSetter setnumcopies $ option auto
( long "numcopies" <> short 'N' <> metavar paramNumber
<> help "override default number of copies"
<> hidden
)
, globalSetter (Remote.forceTrust Trusted) $ strOption
( long "trust" <> metavar paramRemote
<> help "override trust setting"
<> hidden
)
, globalSetter (Remote.forceTrust SemiTrusted) $ strOption
( long "semitrust" <> metavar paramRemote
<> help "override trust setting back to default"
<> hidden
)
, globalSetter (Remote.forceTrust UnTrusted) $ strOption
( long "untrust" <> metavar paramRemote
<> help "override trust setting to untrusted"
<> hidden
)
, globalSetter setgitconfig $ strOption
( long "config" <> short 'c' <> metavar "NAME=VALUE"
<> help "override git configuration setting"
<> hidden
)
, globalSetter setuseragent $ strOption
( long "user-agent" <> metavar paramName
<> help "override default User-Agent"
<> hidden
)
, globalFlag (Annex.setFlag "trustglacier")
( long "trust-glacier"
<> help "Trust Amazon Glacier inventory"
<> hidden
)
, globalFlag (setdesktopnotify mkNotifyFinish)
( long "notify-finish"
<> help "show desktop notification after transfer finishes"
<> hidden
)
, globalFlag (setdesktopnotify mkNotifyStart)
( long "notify-start"
<> help "show desktop notification after transfer completes"
<> hidden
)
]
where
trustArg t = ReqArg (Remote.forceTrust t) paramRemote
setnumcopies v = maybe noop
(\n -> Annex.changeState $ \s -> s { Annex.forcenumcopies = Just $ NumCopies n })
(readish v)
setnumcopies n = Annex.changeState $ \s -> s { Annex.forcenumcopies = Just $ NumCopies n }
setuseragent v = Annex.changeState $ \s -> s { Annex.useragent = Just v }
setgitconfig v = inRepo (Git.Config.store v)
>>= pure . (\r -> r { gitGlobalOpts = gitGlobalOpts r ++ [Param "-c", Param v] })
>>= Annex.changeGitRepo
setdesktopnotify v = Annex.changeState $ \s -> s { Annex.desktopnotify = Annex.desktopnotify s <> v }
-- Options for matching on annexed keys, rather than work tree files.
keyOptions :: [Option]
keyOptions = [ allOption, unusedOption, keyOption]
{- 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"
)
allOption :: Option
allOption = Option ['A'] ["all"] (NoArg (Annex.setFlag "all"))
"operate on all versions of all files"
parseAutoOption :: Parser Bool
parseAutoOption = switch
( long "auto" <> short 'a'
<> help "automatic mode"
)
unusedOption :: Option
unusedOption = Option ['U'] ["unused"] (NoArg (Annex.setFlag "unused"))
"operate on files found by last run of git-annex unused"
parseRemoteOption :: Parser RemoteName -> Parser (DeferredParse Remote)
parseRemoteOption p = DeferredParse . (fromJust <$$> Remote.byNameWithUUID) . Just <$> p
keyOption :: Option
keyOption = Option [] ["key"] (ReqArg (Annex.setField "key") paramKey)
"operate on specified key"
data FromToOptions
= FromRemote (DeferredParse Remote)
| ToRemote (DeferredParse Remote)
incompleteOption :: Option
incompleteOption = flagOption [] "incomplete" "resume previous downloads"
instance DeferredParseClass FromToOptions where
finishParse (FromRemote v) = FromRemote <$> finishParse v
finishParse (ToRemote v) = ToRemote <$> finishParse v
parseFromToOptions :: Parser FromToOptions
parseFromToOptions =
(FromRemote <$> parseFromOption)
<|> (ToRemote <$> parseToOption)
parseFromOption :: Parser (DeferredParse Remote)
parseFromOption = parseRemoteOption $ strOption
( long "from" <> short 'f' <> metavar paramRemote
<> help "source remote"
)
parseToOption :: Parser (DeferredParse Remote)
parseToOption = parseRemoteOption $ strOption
( long "to" <> short 't' <> metavar paramRemote
<> help "destination remote"
)
-- Options for acting on keys, rather than work tree files.
data KeyOptions
= WantAllKeys
| WantUnusedKeys
| WantSpecificKey Key
| WantIncompleteKeys
parseKeyOptions :: Bool -> Parser KeyOptions
parseKeyOptions allowincomplete = if allowincomplete
then base
<|> flag' WantIncompleteKeys
( long "incomplete"
<> help "resume previous downloads"
)
else base
where
base = parseAllOption
<|> flag' WantUnusedKeys
( long "unused" <> short 'U'
<> help "operate on files found by last run of git-annex unused"
)
<|> (WantSpecificKey <$> option (str >>= parseKey)
( long "key" <> metavar paramKey
<> help "operate on specified key"
))
parseAllOption :: Parser KeyOptions
parseAllOption = flag' WantAllKeys
( long "all" <> short 'A'
<> help "operate on all versions of all files"
)
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'
@ -80,84 +172,132 @@ annexedMatchingOptions = concat
]
-- Matching options that don't need to examine work tree files.
nonWorkTreeMatchingOptions :: [Option]
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 :: [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 :: [Option]
combiningOptions =
combiningOptions :: [GlobalOption]
combiningOptions =
[ 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"
, shortopt '(' "open group of options"
, shortopt ')' "close group of options"
]
where
longopt o = Option [] [o] $ NoArg $ Limit.addToken o
shortopt o = Option o [] $ NoArg $ Limit.addToken o
longopt o h = globalFlag (Limit.addToken o) ( long o <> help h <> hidden )
shortopt o h = globalFlag (Limit.addToken [o]) ( short o <> help h <> hidden )
fromOption :: Option
fromOption = fieldOption ['f'] "from" paramRemote "source remote"
jsonOption :: GlobalOption
jsonOption = globalFlag (Annex.setOutput JSONOutput)
( long "json" <> short 'j'
<> help "enable JSON output"
<> hidden
)
toOption :: Option
toOption = fieldOption ['t'] "to" paramRemote "destination remote"
jobsOption :: GlobalOption
jobsOption = globalSetter (Annex.setOutput . ParallelOutput) $
option auto
( long "jobs" <> short 'J' <> metavar paramNumber
<> help "enable concurrent jobs"
<> hidden
)
fromToOptions :: [Option]
fromToOptions = [fromOption, toOption]
timeLimitOption :: GlobalOption
timeLimitOption = globalSetter Limit.addTimeLimit $ strOption
( long "time-limit" <> short 'T' <> metavar paramTime
<> help "stop after the specified amount of time"
<> hidden
)
jsonOption :: Option
jsonOption = Option ['j'] ["json"] (NoArg (Annex.setOutput JSONOutput))
"enable JSON output"
data DaemonOptions = DaemonOptions
{ foregroundDaemonOption :: Bool
, stopDaemonOption :: Bool
}
jobsOption :: Option
jobsOption = Option ['J'] ["jobs"] (ReqArg set paramNumber)
"enable concurrent jobs"
where
set s = case readish s of
Nothing -> error "Bad --jobs number"
Just n -> Annex.setOutput (ParallelOutput n)
timeLimitOption :: Option
timeLimitOption = Option ['T'] ["time-limit"]
(ReqArg Limit.addTimeLimit paramTime)
"stop after the specified amount of time"
autoOption :: Option
autoOption = flagOption ['a'] "auto" "automatic mode"
parseDaemonOptions :: Parser DaemonOptions
parseDaemonOptions = DaemonOptions
<$> switch
( long "foreground"
<> help "do not daemonize"
)
<*> switch
( long "stop"
<> help "stop daemon"
)

View file

@ -8,15 +8,14 @@
module CmdLine.GitAnnexShell where
import System.Environment
import System.Console.GetOpt
import Common.Annex
import qualified Git.Construct
import qualified Git.Config
import CmdLine
import CmdLine.GlobalSetter
import Command
import Annex.UUID
import Annex (setField)
import CmdLine.GitAnnexShell.Fields
import Utility.UserInfo
import Remote.GCrypt (getGCryptUUID)
@ -34,7 +33,7 @@ import qualified Command.NotifyChanges
import qualified Command.GCryptSetup
cmds_readonly :: [Command]
cmds_readonly = concat
cmds_readonly =
[ gitAnnexShellCheck Command.ConfigList.cmd
, gitAnnexShellCheck Command.InAnnex.cmd
, gitAnnexShellCheck Command.SendKey.cmd
@ -43,7 +42,7 @@ cmds_readonly = concat
]
cmds_notreadonly :: [Command]
cmds_notreadonly = concat
cmds_notreadonly =
[ gitAnnexShellCheck Command.RecvKey.cmd
, gitAnnexShellCheck Command.DropKey.cmd
, gitAnnexShellCheck Command.Commit.cmd
@ -55,10 +54,13 @@ cmds = map adddirparam $ cmds_readonly ++ cmds_notreadonly
where
adddirparam c = c { cmdparamdesc = "DIRECTORY " ++ cmdparamdesc c }
options :: [OptDescr (Annex ())]
options = commonOptions ++
[ Option [] ["uuid"] (ReqArg checkUUID paramUUID) "local repository uuid"
]
globalOptions :: [GlobalOption]
globalOptions =
globalSetter checkUUID (strOption
( long "uuid" <> metavar paramUUID
<> help "local repository uuid"
))
: commonGlobalOptions
where
checkUUID expected = getUUID >>= check
where
@ -74,9 +76,6 @@ options = commonOptions ++
unexpected expected s = error $
"expected repository UUID " ++ expected ++ " but found " ++ s
header :: String
header = "git-annex-shell [-c] command [parameters ...] [option ...]"
run :: [String] -> IO ()
run [] = failure
-- skip leading -c options, passed by eg, ssh
@ -100,12 +99,12 @@ builtin cmd dir params = do
checkNotReadOnly cmd
checkDirectory $ Just dir
let (params', fieldparams, opts) = partitionParams params
fields = filter checkField $ parseFields fieldparams
cmds' = map (newcmd $ unwords opts) cmds
dispatch False (cmd : params') cmds' options fields header mkrepo
rsyncopts = ("RsyncOptions", unwords opts)
fields = rsyncopts : filter checkField (parseFields fieldparams)
dispatch False (cmd : params') cmds globalOptions fields mkrepo
"git-annex-shell"
"Restricted login shell for git-annex only SSH access"
where
addrsyncopts opts seek k = setField "RsyncOptions" opts >> seek k
newcmd opts c = c { cmdseek = addrsyncopts opts (cmdseek c) }
mkrepo = do
r <- Git.Construct.repoAbsPath dir >>= Git.Construct.fromAbsPath
Git.Config.read r
@ -143,14 +142,16 @@ parseFields = map (separate (== '='))
{- Only allow known fields to be set, ignore others.
- Make sure that field values make sense. -}
checkField :: (String, String) -> Bool
checkField (field, value)
| field == fieldName remoteUUID = fieldCheck remoteUUID value
| field == fieldName associatedFile = fieldCheck associatedFile value
| field == fieldName direct = fieldCheck direct value
checkField (field, val)
| field == fieldName remoteUUID = fieldCheck remoteUUID val
| field == fieldName associatedFile = fieldCheck associatedFile val
| field == fieldName direct = fieldCheck direct val
| otherwise = False
failure :: IO ()
failure = error $ "bad parameters\n\n" ++ usage header cmds
failure = error $ "bad parameters\n\n" ++ usage h cmds
where
h = "git-annex-shell [-c] command [parameters ...] [option ...]"
checkNotLimited :: IO ()
checkNotLimited = checkEnv "GIT_ANNEX_SHELL_LIMITED"
@ -200,8 +201,8 @@ checkEnv var = do
{- Modifies a Command to check that it is run in either a git-annex
- repository, or a repository with a gcrypt-id set. -}
gitAnnexShellCheck :: [Command] -> [Command]
gitAnnexShellCheck = map $ addCheck okforshell . dontCheck repoExists
gitAnnexShellCheck :: Command -> Command
gitAnnexShellCheck = addCheck okforshell . dontCheck repoExists
where
okforshell = unlessM (isInitialized <||> isJust . gcryptId <$> Annex.getGitConfig) $
error "Not a git-annex or gcrypt repository."

24
CmdLine/GlobalSetter.hs Normal file
View file

@ -0,0 +1,24 @@
{- git-annex global options
-
- Copyright 2015 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module CmdLine.GlobalSetter where
import Types.DeferredParse
import Common
import Annex
import Options.Applicative
globalFlag :: Annex () -> Mod FlagFields GlobalSetter -> GlobalOption
globalFlag setter = flag' (DeferredParse setter)
globalSetter :: (v -> Annex ()) -> Parser v -> GlobalOption
globalSetter setter parser = DeferredParse . setter <$> parser
combineGlobalOptions :: [GlobalOption] -> Parser GlobalSetter
combineGlobalOptions l = DeferredParse . sequence_ . map getParsed
<$> many (foldl1 (<|>) l)

View file

@ -5,45 +5,55 @@
- Licensed under the GNU GPL version 3 or higher.
-}
module CmdLine.Option (
commonOptions,
flagOption,
fieldOption,
optionName,
optionParam,
ArgDescr(..),
OptDescr(..),
) where
module CmdLine.Option where
import System.Console.GetOpt
import Options.Applicative
import Common.Annex
import CmdLine.Usage
import CmdLine.GlobalSetter
import qualified Annex
import Types.Messages
import Types.DesktopNotify
import CmdLine.Usage
import Types.DeferredParse
-- Options accepted by both git-annex and git-annex-shell sub-commands.
commonOptions :: [Option]
commonOptions =
[ Option [] ["force"] (NoArg (setforce True))
"allow actions that may lose annexed data"
, Option ['F'] ["fast"] (NoArg (setfast True))
"avoid slow operations"
, Option ['q'] ["quiet"] (NoArg (Annex.setOutput QuietOutput))
"avoid verbose output"
, Option ['v'] ["verbose"] (NoArg (Annex.setOutput NormalOutput))
"allow verbose output (default)"
, Option ['d'] ["debug"] (NoArg setdebug)
"show debug messages"
, Option [] ["no-debug"] (NoArg unsetdebug)
"don't show debug messages"
, Option ['b'] ["backend"] (ReqArg setforcebackend paramName)
"specify key-value backend to use"
, Option [] ["notify-finish"] (NoArg (setdesktopnotify mkNotifyFinish))
"show desktop notification after transfer finishes"
, Option [] ["notify-start"] (NoArg (setdesktopnotify mkNotifyStart))
"show desktop notification after transfer completes"
-- Global options accepted by both git-annex and git-annex-shell sub-commands.
commonGlobalOptions :: [GlobalOption]
commonGlobalOptions =
[ globalFlag (setforce True)
( long "force"
<> help "allow actions that may lose annexed data"
<> hidden
)
, globalFlag (setfast True)
( long "fast" <> short 'F'
<> help "avoid slow operations"
<> hidden
)
, globalFlag (Annex.setOutput QuietOutput)
( long "quiet" <> short 'q'
<> help "avoid verbose output"
<> hidden
)
, globalFlag (Annex.setOutput NormalOutput)
( long "verbose" <> short 'v'
<> help "allow verbose output (default)"
<> hidden
)
, globalFlag setdebug
( long "debug" <> short 'd'
<> help "show debug messages"
<> hidden
)
, globalFlag unsetdebug
( long "no-debug"
<> help "don't show debug messages"
<> hidden
)
, globalSetter setforcebackend $ strOption
( long "backend" <> short 'b' <> metavar paramName
<> help "specify key-value backend to use"
<> hidden
)
]
where
setforce v = Annex.changeState $ \s -> s { Annex.force = v }
@ -51,21 +61,3 @@ commonOptions =
setforcebackend v = Annex.changeState $ \s -> s { Annex.forcebackend = Just v }
setdebug = Annex.changeGitConfig $ \c -> c { annexDebug = True }
unsetdebug = Annex.changeGitConfig $ \c -> c { annexDebug = False }
setdesktopnotify v = Annex.changeState $ \s -> s { Annex.desktopnotify = Annex.desktopnotify s <> v }
{- An option that sets a flag. -}
flagOption :: String -> String -> String -> Option
flagOption short opt description =
Option short [opt] (NoArg (Annex.setFlag opt)) description
{- An option that sets a field. -}
fieldOption :: String -> String -> String -> String -> Option
fieldOption short opt paramdesc description =
Option short [opt] (ReqArg (Annex.setField opt) paramdesc) description
{- The flag or field name used for an option. -}
optionName :: Option -> String
optionName (Option _ o _ _) = Prelude.head o
optionParam :: Option -> String
optionParam o = "--" ++ optionName o

View file

@ -22,18 +22,18 @@ import qualified Git.LsFiles as LsFiles
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
import Annex.CatFile
import Annex.Content
withFilesInGit :: (FilePath -> CommandStart) -> CommandSeek
withFilesInGit :: (FilePath -> CommandStart) -> CmdParams -> CommandSeek
withFilesInGit a params = seekActions $ prepFiltered a $
seekHelper LsFiles.inRepo params
withFilesInGitNonRecursive :: (FilePath -> CommandStart) -> CommandSeek
withFilesInGitNonRecursive :: (FilePath -> CommandStart) -> CmdParams -> CommandSeek
withFilesInGitNonRecursive a params = ifM (Annex.getState Annex.force)
( withFilesInGit a params
, if null params
@ -54,7 +54,7 @@ withFilesInGitNonRecursive a params = ifM (Annex.getState Annex.force)
_ -> needforce
needforce = error "Not recursively setting metadata. Use --force to do that."
withFilesNotInGit :: Bool -> (FilePath -> CommandStart) -> CommandSeek
withFilesNotInGit :: Bool -> (FilePath -> CommandStart) -> CmdParams -> CommandSeek
withFilesNotInGit skipdotfiles a params
| skipdotfiles = do
{- dotfiles are not acted on unless explicitly listed -}
@ -73,7 +73,7 @@ withFilesNotInGit skipdotfiles a params
go l = seekActions $ prepFiltered a $
return $ concat $ segmentPaths params l
withFilesInRefs :: (FilePath -> Key -> CommandStart) -> CommandSeek
withFilesInRefs :: (FilePath -> Key -> CommandStart) -> CmdParams -> CommandSeek
withFilesInRefs a = mapM_ go
where
go r = do
@ -87,7 +87,7 @@ withFilesInRefs a = mapM_ go
Just k -> whenM (matcher $ MatchingKey k) $
commandAction $ a f k
withPathContents :: ((FilePath, FilePath) -> CommandStart) -> CommandSeek
withPathContents :: ((FilePath, FilePath) -> CommandStart) -> CmdParams -> CommandSeek
withPathContents a params = do
matcher <- Limit.getMatcher
seekActions $ map a <$> (filterM (checkmatch matcher) =<< ps)
@ -103,27 +103,27 @@ withPathContents a params = do
, matchFile = relf
}
withWords :: ([String] -> CommandStart) -> CommandSeek
withWords :: ([String] -> CommandStart) -> CmdParams -> CommandSeek
withWords a params = seekActions $ return [a params]
withStrings :: (String -> CommandStart) -> CommandSeek
withStrings :: (String -> CommandStart) -> CmdParams -> CommandSeek
withStrings a params = seekActions $ return $ map a params
withPairs :: ((String, String) -> CommandStart) -> CommandSeek
withPairs :: ((String, String) -> CommandStart) -> CmdParams -> 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 :: (String -> CommandStart) -> CmdParams -> CommandSeek
withFilesToBeCommitted a params = seekActions $ prepFiltered a $
seekHelper LsFiles.stagedNotDeleted params
withFilesUnlocked :: (FilePath -> CommandStart) -> CommandSeek
withFilesUnlocked :: (FilePath -> CommandStart) -> CmdParams -> CommandSeek
withFilesUnlocked = withFilesUnlocked' LsFiles.typeChanged
withFilesUnlockedToBeCommitted :: (FilePath -> CommandStart) -> CommandSeek
withFilesUnlockedToBeCommitted :: (FilePath -> CommandStart) -> CmdParams -> CommandSeek
withFilesUnlockedToBeCommitted = withFilesUnlocked' LsFiles.typeChangedStaged
{- Unlocked files have changed type from a symlink to a regular file.
@ -131,7 +131,7 @@ withFilesUnlockedToBeCommitted = withFilesUnlocked' LsFiles.typeChangedStaged
- 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' :: ([FilePath] -> Git.Repo -> IO ([FilePath], IO Bool)) -> (FilePath -> CommandStart) -> CmdParams -> CommandSeek
withFilesUnlocked' typechanged a params = seekActions $
prepFiltered a unlockedfiles
where
@ -142,25 +142,16 @@ isUnlocked f = liftIO (notSymlink f) <&&>
(isJust <$> catKeyFile f <||> isJust <$> catKeyFileHEAD f)
{- Finds files that may be modified. -}
withFilesMaybeModified :: (FilePath -> CommandStart) -> CommandSeek
withFilesMaybeModified :: (FilePath -> CommandStart) -> CmdParams -> CommandSeek
withFilesMaybeModified a params = seekActions $
prepFiltered a $ seekHelper LsFiles.modified params
withKeys :: (Key -> CommandStart) -> CommandSeek
withKeys :: (Key -> CommandStart) -> CmdParams -> 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 :: CommandStart -> CmdParams -> CommandSeek
withNothing a [] = seekActions $ return [a]
withNothing _ _ = error "This command takes no parameters."
@ -171,40 +162,34 @@ withNothing _ _ = error "This command takes no parameters."
-
- Otherwise falls back to a regular CommandSeek action on
- whatever params were passed. -}
withKeyOptions :: Bool -> (Key -> CommandStart) -> CommandSeek -> CommandSeek
withKeyOptions auto keyop = withKeyOptions' auto $ \getkeys -> do
withKeyOptions :: Maybe 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 ()) -> CommandSeek -> CommandSeek
withKeyOptions' auto keyop fallbackop params = do
withKeyOptions' :: Maybe 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"
when (auto && bare) $
error "Cannot use --auto in a bare repository"
case (allkeys, unused, incomplete, null params, specifickey) of
(False , False , False , True , Nothing)
case (null params, ko) of
(True, Nothing)
| bare -> go auto loggedKeys
| otherwise -> fallbackop params
(False , False , False , _ , Nothing) -> fallbackop 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]
_ -> error "Can only specify one of file names, --all, --unused, --key, or --incomplete"
| otherwise -> fallbackaction params
(False, Nothing) -> fallbackaction params
(True, Just WantAllKeys) -> go auto loggedKeys
(True, Just WantUnusedKeys) -> go auto unusedKeys'
(True, Just (WantSpecificKey k)) -> go auto $ return [k]
(True, Just WantIncompleteKeys) -> go auto incompletekeys
(False, Just _) -> 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]

View file

@ -1,6 +1,6 @@
{- git-annex usage messages
-
- Copyright 2010-2011 Joey Hess <id@joeyh.name>
- Copyright 2010-2015 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@ -8,17 +8,17 @@
module CmdLine.Usage where
import Common.Annex
import Types.Command
import System.Console.GetOpt
usageMessage :: String -> String
usageMessage s = "Usage: " ++ s
{- Usage message with lists of commands by section. -}
usage :: String -> [Command] -> String
usage header cmds = unlines $ usageMessage header : concatMap go [minBound..]
usage header cmds = unlines $ usageMessage header : commandList cmds
{- Commands listed by section, with breif usage and description. -}
commandList :: [Command] -> [String]
commandList cmds = concatMap go [minBound..]
where
go section
| null cs = []
@ -42,23 +42,10 @@ usage header cmds = unlines $ usageMessage header : concatMap go [minBound..]
longest f = foldl max 0 $ map (length . f) cmds
scmds = sort cmds
{- Usage message for a single command. -}
commandUsage :: Command -> String
commandUsage cmd = unlines
[ usageInfo header (cmdoptions cmd)
, "To see additional options common to all commands, run: git annex help options"
]
where
header = usageMessage $ unwords
[ "git-annex"
, cmdname cmd
, cmdparamdesc cmd
, "[option ...]"
]
{- Descriptions of params used in usage messages. -}
paramPaths :: String
paramPaths = paramOptional $ paramRepeating paramPath -- most often used
paramPaths = paramRepeating paramPath -- most often used
paramPath :: String
paramPath = "PATH"
paramKey :: String
@ -114,6 +101,6 @@ paramNothing = ""
paramRepeating :: String -> String
paramRepeating s = s ++ " ..."
paramOptional :: String -> String
paramOptional s = "[" ++ s ++ "]"
paramOptional s = s
paramPair :: String -> String -> String
paramPair a b = a ++ " " ++ b

View file

@ -1,16 +1,18 @@
{- git-annex command infrastructure
-
- Copyright 2010-2014 Joey Hess <id@joeyh.name>
- Copyright 2010-2015 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Command (
command,
withParams,
(<--<),
noRepo,
noCommit,
noMessages,
withOptions,
withGlobalOptions,
next,
stop,
stopUnless,
@ -25,16 +27,38 @@ import qualified Backend
import qualified Git
import Types.Command as ReExported
import Types.Option as ReExported
import Types.DeferredParse as ReExported
import CmdLine.Seek as ReExported
import Checks as ReExported
import CmdLine.Usage as ReExported
import CmdLine.Action as ReExported
import CmdLine.Option as ReExported
import CmdLine.GlobalSetter as ReExported
import CmdLine.GitAnnex.Options as ReExported
import Options.Applicative as ReExported hiding (command)
{- Generates a normal command -}
command :: String -> String -> CommandSeek -> CommandSection -> String -> Command
command = Command [] Nothing commonChecks False False
import qualified Options.Applicative as O
{- Generates a normal Command -}
command :: String -> CommandSection -> String -> CmdParamsDesc -> (CmdParamsDesc -> CommandParser) -> Command
command name section desc paramdesc mkparser =
Command commonChecks False False name paramdesc
section desc (mkparser paramdesc) Nothing
{- Simple option parser that takes all non-option params as-is. -}
withParams :: (CmdParams -> v) -> CmdParamsDesc -> O.Parser v
withParams mkseek paramdesc = mkseek <$> cmdParams paramdesc
{- Uses the supplied option parser, which yields a deferred parse,
- and calls finishParse on the result before passing it to the
- CommandSeek constructor. -}
(<--<) :: DeferredParseClass a
=> (a -> CommandSeek)
-> (CmdParamsDesc -> Parser a)
-> CmdParamsDesc
-> Parser CommandSeek
(<--<) mkseek optparser paramsdesc =
(mkseek <=< finishParse) <$> optparser paramsdesc
{- Indicates that a command doesn't need to commit any changes to
- the git-annex branch. -}
@ -48,12 +72,21 @@ noMessages c = c { cmdnomessages = True }
{- Adds a fallback action to a command, that will be run if it's used
- outside a git repository. -}
noRepo :: (CmdParams -> IO ()) -> Command -> Command
noRepo a c = c { cmdnorepo = Just a }
noRepo :: (String -> O.Parser (IO ())) -> Command -> Command
noRepo a c = c { cmdnorepo = Just (a (cmdparamdesc c)) }
{- Adds options to a command. -}
withOptions :: [Option] -> Command -> Command
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 :: [GlobalOption] -> Command -> Command
withGlobalOptions os c = c { cmdparser = apply <$> mixin (cmdparser c) }
where
mixin p = (,)
<$> p
<*> combineGlobalOptions os
apply (seek, globalsetters) = do
void $ getParsed globalsetters
seek
{- For start and perform stages to indicate what step to run next. -}
next :: a -> Annex (Maybe a)

View file

@ -34,28 +34,35 @@ import Utility.Tmp
import Control.Exception (IOException)
cmd :: [Command]
cmd = [notBareRepo $ withOptions addOptions $
command "add" paramPaths seek SectionCommon "add files to annex"]
cmd :: Command
cmd = notBareRepo $ withGlobalOptions fileMatchingOptions $
command "add" SectionCommon "add files to annex"
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 :: 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
@ -70,8 +77,8 @@ startSmall file = do
performAdd :: FilePath -> CommandPerform
performAdd file = do
params <- forceParams
Annex.Queue.addCommand "add" (params++[Param "--"]) [file]
ps <- forceParams
Annex.Queue.addCommand "add" (ps++[Param "--"]) [file]
next $ return True
{- The add subcommand annexes a file, generating a key for it using a
@ -278,8 +285,8 @@ addLink :: FilePath -> Key -> Maybe InodeCache -> Annex ()
addLink file key mcache = ifM (coreSymlinks <$> Annex.getGitConfig)
( do
_ <- link file key mcache
params <- forceParams
Annex.Queue.addCommand "add" (params++[Param "--"]) [file]
ps <- forceParams
Annex.Queue.addCommand "add" (ps++[Param "--"]) [file]
, do
l <- link file key mcache
addAnnexLink l file

View file

@ -14,11 +14,13 @@ import qualified Command.Add
import Command.Unused (withUnusedMaps, UnusedMaps(..), startUnused)
import Types.Key
cmd :: [Command]
cmd = [notDirect $ command "addunused" (paramRepeating paramNumRange)
seek SectionMaintenance "add back unused files"]
cmd :: Command
cmd = notDirect $
command "addunused" SectionMaintenance
"add back unused files"
(paramRepeating paramNumRange) (withParams seek)
seek :: CommandSeek
seek :: CmdParams -> CommandSeek
seek = withUnusedMaps start
start :: UnusedMaps -> Int -> CommandStart

View file

@ -37,34 +37,51 @@ import Annex.Quvi
import qualified Utility.Quvi as Quvi
#endif
cmd :: [Command]
cmd = [notBareRepo $ withOptions [fileOption, pathdepthOption, relaxedOption, rawOption] $
command "addurl" (paramRepeating paramUrl) seek
SectionCommon "add urls to annex"]
cmd :: Command
cmd = notBareRepo $
command "addurl" SectionCommon "add urls to annex"
(paramRepeating paramUrl) (seek <$$> optParser)
fileOption :: Option
fileOption = fieldOption [] "file" paramFile "specify what file the url is added to"
data AddUrlOptions = AddUrlOptions
{ addUrls :: CmdParams
, fileOption :: Maybe FilePath
, pathdepthOption :: Maybe Int
, relaxedOption :: Bool
, rawOption :: Bool
}
pathdepthOption :: Option
pathdepthOption = fieldOption [] "pathdepth" paramNumber "path components to use in filename"
optParser :: CmdParamsDesc -> Parser AddUrlOptions
optParser desc = AddUrlOptions
<$> cmdParams desc
<*> optional (strOption
( long "file" <> metavar paramFile
<> help "specify what file the url is added to"
))
<*> optional (option auto
( long "pathdepth" <> metavar paramNumber
<> help "path components to use in filename"
))
<*> parseRelaxedOption
<*> parseRawOption
relaxedOption :: Option
relaxedOption = flagOption [] "relaxed" "skip size check"
parseRelaxedOption :: Parser Bool
parseRelaxedOption = switch
( long "relaxed"
<> help "skip size check"
)
rawOption :: Option
rawOption = flagOption [] "raw" "disable special handling for torrents, quvi, etc"
parseRawOption :: Parser Bool
parseRawOption = switch
( long "raw"
<> help "disable special handling for torrents, quvi, etc"
)
seek :: CommandSeek
seek us = do
optfile <- getOptionField fileOption return
relaxed <- getOptionFlag relaxedOption
raw <- getOptionFlag rawOption
pathdepth <- getOptionField pathdepthOption (return . maybe Nothing readish)
forM_ us $ \u -> do
r <- Remote.claimingUrl u
if Remote.uuid r == webUUID || raw
then void $ commandAction $ startWeb relaxed optfile pathdepth u
else checkUrl r u optfile relaxed pathdepth
seek :: AddUrlOptions -> CommandSeek
seek o = forM_ (addUrls o) $ \u -> do
r <- Remote.claimingUrl u
if Remote.uuid r == webUUID || rawOption o
then void $ commandAction $ startWeb (relaxedOption o) (fileOption o) (pathdepthOption o) u
else checkUrl r u (fileOption o) (relaxedOption o) (pathdepthOption o)
checkUrl :: Remote -> URLString -> Maybe FilePath -> Bool -> Maybe Int -> Annex ()
checkUrl r u optfile relaxed pathdepth = do

View file

@ -1,6 +1,6 @@
{- git-annex assistant
-
- Copyright 2012 Joey Hess <id@joeyh.name>
- Copyright 2012-2015 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@ -17,65 +17,60 @@ import qualified Build.SysConfig
import Utility.HumanTime
import Assistant.Install
import System.Environment
cmd :: Command
cmd = dontCheck repoExists $ notBareRepo $
noRepo (startNoRepo <$$> optParser) $
command "assistant" SectionCommon
"automatically sync changes"
paramNothing (seek <$$> optParser)
cmd :: [Command]
cmd = [noRepo checkNoRepoOpts $ dontCheck repoExists $ withOptions options $
notBareRepo $ command "assistant" paramNothing seek SectionCommon
"automatically sync changes"]
data AssistantOptions = AssistantOptions
{ daemonOptions :: DaemonOptions
, autoStartOption :: Bool
, startDelayOption :: Maybe Duration
, autoStopOption :: Bool
}
options :: [Option]
options =
[ Command.Watch.foregroundOption
, Command.Watch.stopOption
, autoStartOption
, startDelayOption
, autoStopOption
]
optParser :: CmdParamsDesc -> Parser AssistantOptions
optParser _ = AssistantOptions
<$> parseDaemonOptions
<*> switch
( long "autostart"
<> help "start in known repositories"
)
<*> optional (option (str >>= parseDuration)
( long "startdelay" <> metavar paramNumber
<> help "delay before running startup scan"
))
<*> switch
( long "autostop"
<> help "stop in known repositories"
)
autoStartOption :: Option
autoStartOption = flagOption [] "autostart" "start in known repositories"
seek :: AssistantOptions -> CommandSeek
seek = commandAction . start
autoStopOption :: Option
autoStopOption = flagOption [] "autostop" "stop in known repositories"
startDelayOption :: Option
startDelayOption = fieldOption [] "startdelay" paramNumber "delay before running startup scan"
seek :: CommandSeek
seek ps = do
stopdaemon <- getOptionFlag Command.Watch.stopOption
foreground <- getOptionFlag Command.Watch.foregroundOption
autostart <- getOptionFlag autoStartOption
autostop <- getOptionFlag autoStopOption
startdelay <- getOptionField startDelayOption (pure . maybe Nothing parseDuration)
withNothing (start foreground stopdaemon autostart autostop startdelay) ps
start :: Bool -> Bool -> Bool -> Bool -> Maybe Duration -> CommandStart
start foreground stopdaemon autostart autostop startdelay
| autostart = do
liftIO $ autoStart startdelay
start :: AssistantOptions -> CommandStart
start o
| autoStartOption o = do
liftIO $ autoStart o
stop
| autostop = do
| autoStopOption o = do
liftIO autoStop
stop
| otherwise = do
liftIO ensureInstalled
ensureInitialized
Command.Watch.start True foreground stopdaemon startdelay
Command.Watch.start True (daemonOptions o) (startDelayOption o)
{- Run outside a git repository; support autostart and autostop mode. -}
checkNoRepoOpts :: CmdParams -> IO ()
checkNoRepoOpts _ = ifM (elem "--autostart" <$> getArgs)
( autoStart Nothing
, ifM (elem "--autostop" <$> getArgs)
( autoStop
, error "Not in a git repository."
)
)
startNoRepo :: AssistantOptions -> IO ()
startNoRepo o
| autoStartOption o = autoStart o
| autoStopOption o = autoStop
| otherwise = error "Not in a git repository."
autoStart :: Maybe Duration -> IO ()
autoStart startdelay = do
autoStart :: AssistantOptions -> IO ()
autoStart o = do
dirs <- liftIO readAutoStartFile
when (null dirs) $ do
f <- autoStartFile
@ -103,7 +98,7 @@ autoStart startdelay = do
where
baseparams =
[ Param "assistant"
, Param $ "--startdelay=" ++ fromDuration (fromMaybe (Duration 5) startdelay)
, Param $ "--startdelay=" ++ fromDuration (fromMaybe (Duration 5) (startDelayOption o))
]
autoStop :: IO ()

View file

@ -14,11 +14,14 @@ import qualified Remote
import Annex
import Types.Messages
cmd :: [Command]
cmd = [noCommit $ command "checkpresentkey" (paramPair paramKey paramRemote) seek
SectionPlumbing "check if key is present in remote"]
cmd :: Command
cmd = noCommit $
command "checkpresentkey" SectionPlumbing
"check if key is present in remote"
(paramPair paramKey paramRemote)
(withParams seek)
seek :: CommandSeek
seek :: CmdParams -> CommandSeek
seek = withWords start
start :: [String] -> CommandStart

View file

@ -12,11 +12,12 @@ import Command
import qualified Annex.Branch
import qualified Git
cmd :: [Command]
cmd = [command "commit" paramNothing seek
SectionPlumbing "commits any staged changes to the git-annex branch"]
cmd :: Command
cmd = command "commit" SectionPlumbing
"commits any staged changes to the git-annex branch"
paramNothing (withParams seek)
seek :: CommandSeek
seek :: CmdParams -> CommandSeek
seek = withNothing start
start :: CommandStart

View file

@ -15,11 +15,13 @@ import qualified Annex.Branch
import qualified Git.Config
import Remote.GCrypt (coreGCryptId)
cmd :: [Command]
cmd = [noCommit $ command "configlist" paramNothing seek
SectionPlumbing "outputs relevant git configuration"]
cmd :: Command
cmd = noCommit $
command "configlist" SectionPlumbing
"outputs relevant git configuration"
paramNothing (withParams seek)
seek :: CommandSeek
seek :: CmdParams -> CommandSeek
seek = withNothing start
start :: CommandStart

View file

@ -11,20 +11,20 @@ import Common.Annex
import Command
import CmdLine.Batch
import Annex.Content
import Types.Key
cmd :: [Command]
cmd = [withOptions [batchOption] $ noCommit $ noMessages $
command "contentlocation" (paramRepeating paramKey) seek
SectionPlumbing "looks up content for a key"]
cmd :: Command
cmd = noCommit $ noMessages $
command "contentlocation" SectionPlumbing
"looks up content for a key"
(paramRepeating paramKey)
(batchable run (pure ()))
seek :: CommandSeek
seek = batchable withKeys start
start :: Batchable Key
start batchmode k = do
maybe (batchBadInput batchmode) (liftIO . putStrLn)
run :: () -> String -> Annex Bool
run _ p = do
let k = fromMaybe (error "bad key") $ file2key p
maybe (return False) (\f -> liftIO (putStrLn f) >> return True)
=<< inAnnex' (pure True) Nothing check k
stop
where
check f = ifM (liftIO (doesFileExist f))
( return (Just f)

View file

@ -14,33 +14,44 @@ import qualified Remote
import Annex.Wanted
import Annex.NumCopies
cmd :: [Command]
cmd = [withOptions copyOptions $ command "copy" paramPaths seek
SectionCommon "copy content of files to/from another repository"]
cmd :: Command
cmd = command "copy" SectionCommon
"copy content of files to/from another repository"
paramPaths (seek <--< optParser)
copyOptions :: [Option]
copyOptions = Command.Move.moveOptions ++ [autoOption]
data CopyOptions = CopyOptions
{ moveOptions :: Command.Move.MoveOptions
, autoMode :: Bool
}
seek :: CommandSeek
seek ps = do
to <- getOptionField toOption Remote.byNameWithUUID
from <- getOptionField fromOption Remote.byNameWithUUID
auto <- getOptionFlag autoOption
withKeyOptions auto
(Command.Move.startKey to from False)
(withFilesInGit $ whenAnnexed $ start auto to from)
ps
optParser :: CmdParamsDesc -> Parser CopyOptions
optParser desc = CopyOptions
<$> Command.Move.optParser desc
<*> parseAutoOption
instance DeferredParseClass CopyOptions where
finishParse v = CopyOptions
<$> finishParse (moveOptions v)
<*> pure (autoMode v)
seek :: CopyOptions -> CommandSeek
seek o = withKeyOptions (Command.Move.keyOptions $ moveOptions o) (autoMode o)
(Command.Move.startKey (moveOptions o) False)
(withFilesInGit $ whenAnnexed $ start o)
(Command.Move.moveFiles $ moveOptions o)
{- A copy is just a move that does not delete the source file.
- However, auto mode avoids unnecessary copies, and avoids getting or
- sending non-preferred content. -}
start :: Bool -> Maybe Remote -> Maybe Remote -> FilePath -> Key -> CommandStart
start auto to from file key = stopUnless shouldCopy $
Command.Move.start to from False file key
start :: CopyOptions -> FilePath -> Key -> CommandStart
start o file key = stopUnless shouldCopy $
Command.Move.start (moveOptions o) False file key
where
shouldCopy
| auto = want <||> numCopiesCheck file key (<)
| autoMode o = want <||> numCopiesCheck file key (<)
| otherwise = return True
want = case to of
Nothing -> wantGet False (Just key) (Just file)
Just r -> wantSend False (Just key) (Just file) (Remote.uuid r)
want = case Command.Move.fromToOptions (moveOptions o) of
ToRemote _ ->
wantGet False (Just key) (Just file)
FromRemote dest -> (Remote.uuid <$> getParsed dest) >>=
wantSend False (Just key) (Just file)

View file

@ -9,26 +9,29 @@ module Command.Dead where
import Command
import Common.Annex
import qualified Annex
import Types.TrustLevel
import Types.Key
import Command.Trust (trustCommand)
import Logs.Location
import Remote (keyLocations)
import Git.Types
cmd :: [Command]
cmd = [withOptions [keyOption] $
command "dead" (paramRepeating paramRemote) seek
SectionSetup "hide a lost repository or key"]
cmd :: Command
cmd = command "dead" SectionSetup "hide a lost repository or key"
(paramRepeating paramRemote) (seek <$$> optParser)
seek :: CommandSeek
seek ps = maybe (trustCommand "dead" DeadTrusted ps) (flip seekKey ps)
=<< Annex.getField "key"
data DeadOptions = DeadRemotes [RemoteName] | DeadKeys [Key]
seekKey :: String -> CommandSeek
seekKey ks = case file2key ks of
Nothing -> error "Invalid key"
Just key -> withNothing (startKey key)
optParser :: CmdParamsDesc -> Parser DeadOptions
optParser desc = (DeadRemotes <$> cmdParams desc)
<|> (DeadKeys <$> many (option (str >>= parseKey)
( long "key" <> metavar paramKey
<> help "keys whose content has been irretrievably lost"
)))
seek :: DeadOptions -> CommandSeek
seek (DeadRemotes rs) = trustCommand "dead" DeadTrusted rs
seek (DeadKeys ks) = seekActions $ pure $ map startKey ks
startKey :: Key -> CommandStart
startKey key = do

View file

@ -12,11 +12,13 @@ import Command
import qualified Remote
import Logs.UUID
cmd :: [Command]
cmd = [command "describe" (paramPair paramRemote paramDesc) seek
SectionSetup "change description of a repository"]
cmd :: Command
cmd = command "describe" SectionSetup
"change description of a repository"
(paramPair paramRemote paramDesc)
(withParams seek)
seek :: CommandSeek
seek :: CmdParams -> CommandSeek
seek = withWords start
start :: [String] -> CommandStart

View file

@ -13,12 +13,13 @@ import Annex.Content
import Annex.Link
import Git.Types
cmd :: [Command]
cmd = [dontCheck repoExists $
command "diffdriver" ("[-- cmd --]") seek
SectionPlumbing "external git diff driver shim"]
cmd :: Command
cmd = dontCheck repoExists $
command "diffdriver" SectionPlumbing
"external git diff driver shim"
("-- cmd --") (withParams seek)
seek :: CommandSeek
seek :: CmdParams -> CommandSeek
seek = withWords start
start :: [String] -> CommandStart

View file

@ -15,12 +15,12 @@ import qualified Git.Branch
import Config
import Annex.Direct
cmd :: [Command]
cmd = [notBareRepo $ noDaemonRunning $
command "direct" paramNothing seek
SectionSetup "switch repository to direct mode"]
cmd :: Command
cmd = notBareRepo $ noDaemonRunning $
command "direct" SectionSetup "switch repository to direct mode"
paramNothing (withParams seek)
seek :: CommandSeek
seek :: CmdParams -> CommandSeek
seek = withNothing start
start :: CommandStart

View file

@ -22,45 +22,60 @@ import Annex.Notification
import qualified Data.Set as S
cmd :: [Command]
cmd = [withOptions (dropOptions) $ command "drop" paramPaths seek
SectionCommon "indicate content of files not currently wanted"]
cmd :: Command
cmd = withGlobalOptions annexedMatchingOptions $
command "drop" SectionCommon
"remove content of files from repository"
paramPaths (seek <$$> optParser)
dropOptions :: [Option]
dropOptions = dropFromOption : annexedMatchingOptions ++ [autoOption] ++ keyOptions
data DropOptions = DropOptions
{ dropFiles :: CmdParams
, dropFrom :: Maybe (DeferredParse Remote)
, autoMode :: Bool
, keyOptions :: Maybe KeyOptions
}
dropFromOption :: Option
dropFromOption = fieldOption ['f'] "from" paramRemote "drop content from a remote"
optParser :: CmdParamsDesc -> Parser DropOptions
optParser desc = DropOptions
<$> cmdParams desc
<*> optional parseDropFromOption
<*> parseAutoOption
<*> optional (parseKeyOptions False)
seek :: CommandSeek
seek ps = do
from <- getOptionField dropFromOption Remote.byNameWithUUID
auto <- getOptionFlag autoOption
withKeyOptions auto
(startKeys auto from)
(withFilesInGit $ whenAnnexed $ start auto from)
ps
parseDropFromOption :: Parser (DeferredParse Remote)
parseDropFromOption = parseRemoteOption $ strOption
( long "from" <> short 'f' <> metavar paramRemote
<> help "drop content from a remote"
)
start :: Bool -> Maybe Remote -> FilePath -> Key -> CommandStart
start auto from file key = start' auto from key (Just file)
seek :: DropOptions -> CommandSeek
seek o = withKeyOptions (keyOptions o) (autoMode o)
(startKeys o)
(withFilesInGit $ whenAnnexed $ start o)
(dropFiles o)
start' :: Bool -> Maybe Remote -> Key -> AssociatedFile -> CommandStart
start' auto from key afile = checkDropAuto auto from afile key $ \numcopies ->
stopUnless want $
case from of
Nothing -> startLocal afile numcopies key Nothing
Just remote -> do
u <- getUUID
if Remote.uuid remote == u
then startLocal afile numcopies key Nothing
else startRemote afile numcopies key remote
where
want
| auto = wantDrop False (Remote.uuid <$> from) (Just key) afile
| otherwise = return True
start :: DropOptions -> FilePath -> Key -> CommandStart
start o file key = start' o key (Just file)
startKeys :: Bool -> Maybe Remote -> Key -> CommandStart
startKeys auto from key = start' auto from key Nothing
start' :: DropOptions -> Key -> AssociatedFile -> CommandStart
start' o key afile = do
from <- maybe (pure Nothing) (Just <$$> getParsed) (dropFrom o)
checkDropAuto (autoMode o) from afile key $ \numcopies ->
stopUnless (want from) $
case from of
Nothing -> startLocal afile numcopies key Nothing
Just remote -> do
u <- getUUID
if Remote.uuid remote == u
then startLocal afile numcopies key Nothing
else startRemote afile numcopies key remote
where
want from
| autoMode o = wantDrop False (Remote.uuid <$> from) (Just key) afile
| otherwise = return True
startKeys :: DropOptions -> Key -> CommandStart
startKeys o key = start' o key Nothing
startLocal :: AssociatedFile -> NumCopies -> Key -> Maybe Remote -> CommandStart
startLocal afile numcopies key knownpresentremote = stopUnless (inAnnex key) $ do
@ -164,10 +179,10 @@ requiredContent = do
{- In auto mode, only runs the action if there are enough
- copies on other semitrusted repositories. -}
checkDropAuto :: Bool -> Maybe Remote -> AssociatedFile -> Key -> (NumCopies -> CommandStart) -> CommandStart
checkDropAuto auto mremote afile key a = go =<< maybe getNumCopies getFileNumCopies afile
checkDropAuto automode mremote afile key a = go =<< maybe getNumCopies getFileNumCopies afile
where
go numcopies
| auto = do
| automode = do
locs <- Remote.keyLocations key
uuid <- getUUID
let remoteuuid = fromMaybe uuid $ Remote.uuid <$> mremote

View file

@ -13,11 +13,14 @@ import qualified Annex
import Logs.Location
import Annex.Content
cmd :: [Command]
cmd = [noCommit $ command "dropkey" (paramRepeating paramKey) seek
SectionPlumbing "drops annexed content for specified keys"]
cmd :: Command
cmd = noCommit $
command "dropkey" SectionPlumbing
"drops annexed content for specified keys"
(paramRepeating paramKey)
(withParams seek)
seek :: CommandSeek
seek :: CmdParams -> CommandSeek
seek = withKeys start
start :: Key -> CommandStart

View file

@ -9,34 +9,42 @@ module Command.DropUnused where
import Common.Annex
import Command
import qualified Annex
import qualified Command.Drop
import qualified Remote
import qualified Git
import Command.Unused (withUnusedMaps, UnusedMaps(..), startUnused)
import Annex.NumCopies
cmd :: [Command]
cmd = [withOptions [Command.Drop.dropFromOption] $
command "dropunused" (paramRepeating paramNumRange)
seek SectionMaintenance "drop unused file content"]
cmd :: Command
cmd = command "dropunused" SectionMaintenance
"drop unused file content"
(paramRepeating paramNumRange) (seek <$$> optParser)
seek :: CommandSeek
seek ps = do
data DropUnusedOptions = DropUnusedOptions
{ rangesToDrop :: CmdParams
, dropFrom :: Maybe (DeferredParse Remote)
}
optParser :: CmdParamsDesc -> Parser DropUnusedOptions
optParser desc = DropUnusedOptions
<$> cmdParams desc
<*> optional (Command.Drop.parseDropFromOption)
seek :: DropUnusedOptions -> CommandSeek
seek o = do
numcopies <- getNumCopies
withUnusedMaps (start numcopies) ps
from <- maybe (pure Nothing) (Just <$$> getParsed) (dropFrom o)
withUnusedMaps (start from numcopies) (rangesToDrop o)
start :: NumCopies -> UnusedMaps -> Int -> CommandStart
start numcopies = startUnused "dropunused" (perform numcopies) (performOther gitAnnexBadLocation) (performOther gitAnnexTmpObjectLocation)
start :: Maybe Remote -> NumCopies -> UnusedMaps -> Int -> CommandStart
start from numcopies = startUnused "dropunused" (perform from numcopies) (performOther gitAnnexBadLocation) (performOther gitAnnexTmpObjectLocation)
perform :: NumCopies -> Key -> CommandPerform
perform numcopies key = maybe droplocal dropremote =<< Remote.byNameWithUUID =<< from
where
dropremote r = do
perform :: Maybe Remote -> NumCopies -> Key -> CommandPerform
perform from numcopies key = case from of
Just r -> do
showAction $ "from " ++ Remote.name r
Command.Drop.performRemote key Nothing numcopies r
droplocal = Command.Drop.performLocal key Nothing numcopies Nothing
from = Annex.getField $ optionName Command.Drop.dropFromOption
Nothing -> Command.Drop.performLocal key Nothing numcopies Nothing
performOther :: (Key -> Git.Repo -> FilePath) -> Key -> CommandPerform
performOther filespec key = do

View file

@ -15,12 +15,13 @@ import qualified Command.InitRemote as InitRemote
import qualified Data.Map as M
cmd :: [Command]
cmd = [command "enableremote"
cmd :: Command
cmd = command "enableremote" SectionSetup
"enables use of an existing special remote"
(paramPair paramName $ paramOptional $ paramRepeating paramKeyValue)
seek SectionSetup "enables use of an existing special remote"]
(withParams seek)
seek :: CommandSeek
seek :: CmdParams -> CommandSeek
seek = withWords start
start :: [String] -> CommandStart

View file

@ -11,20 +11,18 @@ import Common.Annex
import Command
import CmdLine.Batch
import qualified Utility.Format
import Command.Find (formatOption, getFormat, showFormatted, keyVars)
import Command.Find (parseFormatOption, showFormatted, keyVars)
import Types.Key
cmd :: [Command]
cmd = [noCommit $ noMessages $ withOptions [formatOption, jsonOption, batchOption] $
command "examinekey" (paramRepeating paramKey) seek
SectionPlumbing "prints information from a key"]
cmd :: Command
cmd = noCommit $ noMessages $ withGlobalOptions [jsonOption] $
command "examinekey" SectionPlumbing
"prints information from a key"
(paramRepeating paramKey)
(batchable run (optional parseFormatOption))
seek :: CommandSeek
seek ps = do
format <- getFormat
batchable withKeys (start format) ps
start :: Maybe Utility.Format.Format -> Batchable Key
start format _ key = do
showFormatted format (key2file key) (keyVars key)
stop
run :: Maybe Utility.Format.Format -> String -> Annex Bool
run format p = do
let k = fromMaybe (error "bad key") $ file2key p
showFormatted format (key2file k) (keyVars k)
return True

View file

@ -20,29 +20,40 @@ import Utility.HumanTime
import Data.Time.Clock.POSIX
import qualified Data.Map as M
cmd :: [Command]
cmd = [withOptions [activityOption, noActOption] $ command "expire" paramExpire seek
SectionMaintenance "expire inactive repositories"]
cmd :: Command
cmd = command "expire" SectionMaintenance
"expire inactive repositories"
paramExpire (seek <$$> optParser)
paramExpire :: String
paramExpire = (paramRepeating $ paramOptional paramRemote ++ ":" ++ paramTime)
activityOption :: Option
activityOption = fieldOption [] "activity" "Name" "specify activity"
data ExpireOptions = ExpireOptions
{ expireParams :: CmdParams
, activityOption :: Maybe Activity
, noActOption :: Bool
}
noActOption :: Option
noActOption = flagOption [] "no-act" "don't really do anything"
optParser :: CmdParamsDesc -> Parser ExpireOptions
optParser desc = ExpireOptions
<$> cmdParams desc
<*> optional (option (str >>= parseActivity)
( long "activity" <> metavar paramName
<> help "specify activity that prevents expiry"
))
<*> switch
( long "no-act"
<> help "don't really do anything"
)
seek :: CommandSeek
seek ps = do
expire <- parseExpire ps
wantact <- getOptionField activityOption (pure . parseActivity)
noact <- getOptionFlag noActOption
actlog <- lastActivities wantact
seek :: ExpireOptions -> CommandSeek
seek o = do
expire <- parseExpire (expireParams o)
actlog <- lastActivities (activityOption o)
u <- getUUID
us <- filter (/= u) . M.keys <$> uuidMap
descs <- uuidMap
seekActions $ pure $ map (start expire noact actlog descs) us
seekActions $ pure $ map (start expire (noActOption o) actlog descs) us
start :: Expire -> Bool -> Log Activity -> M.Map UUID String -> UUID -> CommandStart
start (Expire expire) noact actlog descs u =
@ -97,10 +108,9 @@ parseExpire ps = do
Nothing -> error $ "bad expire time: " ++ s
Just d -> Just (now - durationToPOSIXTime d)
parseActivity :: Maybe String -> Maybe Activity
parseActivity Nothing = Nothing
parseActivity (Just s) = case readish s of
Nothing -> error $ "Unknown activity. Choose from: " ++
parseActivity :: Monad m => String -> m Activity
parseActivity s = case readish s of
Nothing -> fail $ "Unknown activity. Choose from: " ++
unwords (map show [minBound..maxBound :: Activity])
Just v -> Just v
Just v -> return v

View file

@ -14,41 +14,48 @@ import Common.Annex
import Command
import Annex.Content
import Limit
import qualified Annex
import qualified Utility.Format
import Utility.DataUnits
import Types.Key
cmd :: [Command]
cmd = [withOptions annexedMatchingOptions $ mkCommand $
command "find" paramPaths seek SectionQuery "lists available files"]
cmd :: Command
cmd = withGlobalOptions annexedMatchingOptions $ mkCommand $
command "find" SectionQuery "lists available files"
paramPaths (seek <$$> optParser)
mkCommand :: Command -> Command
mkCommand = noCommit . noMessages . withOptions [formatOption, print0Option, jsonOption]
mkCommand = noCommit . noMessages . withGlobalOptions [jsonOption]
formatOption :: Option
formatOption = fieldOption [] "format" paramFormat "control format of output"
data FindOptions = FindOptions
{ findThese :: CmdParams
, formatOption :: Maybe Utility.Format.Format
}
getFormat :: Annex (Maybe Utility.Format.Format)
getFormat = getOptionField formatOption $ return . fmap Utility.Format.gen
optParser :: CmdParamsDesc -> Parser FindOptions
optParser desc = FindOptions
<$> cmdParams desc
<*> optional parseFormatOption
print0Option :: Option
print0Option = Option [] ["print0"] (NoArg set)
"terminate output with null"
where
set = Annex.setField (optionName formatOption) "${file}\0"
parseFormatOption :: Parser Utility.Format.Format
parseFormatOption =
option (Utility.Format.gen <$> str)
( long "format" <> metavar paramFormat
<> help "control format of output"
)
<|> flag' (Utility.Format.gen "${file}\0")
( long "print0"
<> help "output filenames terminated with nulls"
)
seek :: CommandSeek
seek ps = do
format <- getFormat
withFilesInGit (whenAnnexed $ start format) ps
seek :: FindOptions -> CommandSeek
seek o = withFilesInGit (whenAnnexed $ start o) (findThese o)
start :: Maybe Utility.Format.Format -> FilePath -> Key -> CommandStart
start format file key = do
start :: FindOptions -> FilePath -> Key -> CommandStart
start o file key = do
-- only files inAnnex are shown, unless the user has requested
-- others via a limit
whenM (limited <||> inAnnex key) $
showFormatted format file $ ("file", file) : keyVars key
showFormatted (formatOption o) file $ ("file", file) : keyVars key
stop
showFormatted :: Maybe Utility.Format.Format -> String -> [(String, String)] -> Annex ()

View file

@ -7,15 +7,15 @@
module Command.FindRef where
import Common.Annex
import Command
import qualified Command.Find as Find
cmd :: [Command]
cmd = [withOptions nonWorkTreeMatchingOptions $ Find.mkCommand $
command "findref" paramRef seek SectionPlumbing
"lists files in a git ref"]
cmd :: Command
cmd = withGlobalOptions nonWorkTreeMatchingOptions $ Find.mkCommand $
command "findref" SectionPlumbing
"lists files in a git ref"
paramRef (seek <$$> Find.optParser)
seek :: CommandSeek
seek refs = do
format <- Find.getFormat
Find.start format `withFilesInRefs` refs
seek :: Find.FindOptions -> CommandSeek
seek o = Find.start o `withFilesInRefs` Find.findThese o

View file

@ -18,12 +18,13 @@ import Utility.Touch
#endif
#endif
cmd :: [Command]
cmd = [notDirect $ noCommit $ withOptions annexedMatchingOptions $
command "fix" paramPaths seek
SectionMaintenance "fix up symlinks to point to annexed content"]
cmd :: Command
cmd = notDirect $ noCommit $ withGlobalOptions annexedMatchingOptions $
command "fix" SectionMaintenance
"fix up symlinks to point to annexed content"
paramPaths (withParams seek)
seek :: CommandSeek
seek :: CmdParams -> CommandSeek
seek = withFilesInGit $ whenAnnexed start
{- Fixes the symlink to an annexed file. -}

View file

@ -15,27 +15,31 @@ import qualified Annex
import Data.Time.Clock.POSIX
cmd :: [Command]
cmd = [withOptions forgetOptions $ command "forget" paramNothing seek
SectionMaintenance "prune git-annex branch history"]
cmd :: Command
cmd = command "forget" SectionMaintenance
"prune git-annex branch history"
paramNothing (seek <$$> optParser)
forgetOptions :: [Option]
forgetOptions = [dropDeadOption]
data ForgetOptions = ForgetOptions
{ dropDead :: Bool
}
dropDeadOption :: Option
dropDeadOption = flagOption [] "drop-dead" "drop references to dead repositories"
optParser :: CmdParamsDesc -> Parser ForgetOptions
optParser _ = ForgetOptions
<$> switch
( long "drop-dead"
<> help "drop references to dead repositories"
)
seek :: CommandSeek
seek ps = do
dropdead <- getOptionFlag dropDeadOption
withNothing (start dropdead) ps
seek :: ForgetOptions -> CommandSeek
seek = commandAction . start
start :: Bool -> CommandStart
start dropdead = do
start :: ForgetOptions -> CommandStart
start o = do
showStart "forget" "git-annex"
now <- liftIO getPOSIXTime
let basets = addTransition now ForgetGitHistory noTransitions
let ts = if dropdead
let ts = if dropDead o
then addTransition now ForgetDeadRemotes basets
else basets
next $ perform ts =<< Annex.getState Annex.force

View file

@ -19,12 +19,13 @@ import qualified Backend.URL
import Network.URI
cmd :: [Command]
cmd = [notDirect $ notBareRepo $
command "fromkey" (paramPair paramKey paramPath) seek
SectionPlumbing "adds a file using a specific key"]
cmd :: Command
cmd = notDirect $ notBareRepo $
command "fromkey" SectionPlumbing "adds a file using a specific key"
(paramPair paramKey paramPath)
(withParams seek)
seek :: CommandSeek
seek :: CmdParams -> CommandSeek
seek ps = do
force <- Annex.getState Annex.force
withWords (start force) ps

View file

@ -40,40 +40,57 @@ import qualified Database.Fsck as FsckDb
import Data.Time.Clock.POSIX
import System.Posix.Types (EpochTime)
cmd :: [Command]
cmd = [withOptions fsckOptions $ command "fsck" paramPaths seek
SectionMaintenance "check for problems"]
cmd :: Command
cmd = withGlobalOptions annexedMatchingOptions $
command "fsck" SectionMaintenance
"find and fix problems"
paramPaths (seek <$$> optParser)
fsckFromOption :: Option
fsckFromOption = fieldOption ['f'] "from" paramRemote "check remote"
data FsckOptions = FsckOptions
{ fsckFiles :: CmdParams
, fsckFromOption :: Maybe (DeferredParse Remote)
, incrementalOpt :: Maybe IncrementalOpt
, keyOptions :: Maybe KeyOptions
}
startIncrementalOption :: Option
startIncrementalOption = flagOption ['S'] "incremental" "start an incremental fsck"
data IncrementalOpt
= StartIncrementalO
| MoreIncrementalO
| ScheduleIncrementalO Duration
moreIncrementalOption :: Option
moreIncrementalOption = flagOption ['m'] "more" "continue an incremental fsck"
optParser :: CmdParamsDesc -> Parser FsckOptions
optParser desc = FsckOptions
<$> cmdParams desc
<*> optional (parseRemoteOption $ strOption
( long "from" <> short 'f' <> metavar paramRemote
<> help "check remote"
))
<*> optional parseincremental
<*> optional (parseKeyOptions False)
where
parseincremental =
flag' StartIncrementalO
( long "incremental" <> short 'S'
<> help "start an incremental fsck"
)
<|> flag' MoreIncrementalO
( long "more" <> short 'm'
<> help "continue an incremental fsck"
)
<|> (ScheduleIncrementalO <$> option (str >>= parseDuration)
( long "incremental-schedule" <> metavar paramTime
<> help "schedule incremental fscking"
))
incrementalScheduleOption :: Option
incrementalScheduleOption = fieldOption [] "incremental-schedule" paramTime
"schedule incremental fscking"
fsckOptions :: [Option]
fsckOptions =
[ fsckFromOption
, startIncrementalOption
, moreIncrementalOption
, incrementalScheduleOption
] ++ keyOptions ++ annexedMatchingOptions
seek :: CommandSeek
seek ps = do
from <- getOptionField fsckFromOption Remote.byNameWithUUID
seek :: FsckOptions -> CommandSeek
seek o = do
from <- maybe (pure Nothing) (Just <$$> getParsed) (fsckFromOption o)
u <- maybe getUUID (pure . Remote.uuid) from
i <- getIncremental u
withKeyOptions False
i <- prepIncremental u (incrementalOpt o)
withKeyOptions (keyOptions o) False
(\k -> startKey i k =<< getNumCopies)
(withFilesInGit $ whenAnnexed $ start from i)
ps
(fsckFiles o)
withFsckDb i FsckDb.closeDb
void $ tryIO $ recordActivity Fsck u
@ -497,37 +514,26 @@ getStartTime u = do
data Incremental = StartIncremental FsckDb.FsckHandle | ContIncremental FsckDb.FsckHandle | NonIncremental
getIncremental :: UUID -> Annex Incremental
getIncremental u = do
i <- maybe (return False) (checkschedule . parseDuration)
=<< Annex.getField (optionName incrementalScheduleOption)
starti <- getOptionFlag startIncrementalOption
morei <- getOptionFlag moreIncrementalOption
case (i, starti, morei) of
(False, False, False) -> return NonIncremental
(False, True, False) -> startIncremental
(False ,False, True) -> contIncremental
(True, False, False) ->
maybe startIncremental (const contIncremental)
=<< getStartTime u
_ -> error "Specify only one of --incremental, --more, or --incremental-schedule"
where
startIncremental = do
recordStartTime u
ifM (FsckDb.newPass u)
( StartIncremental <$> FsckDb.openDb u
, error "Cannot start a new --incremental fsck pass; another fsck process is already running."
)
contIncremental = ContIncremental <$> FsckDb.openDb u
checkschedule Nothing = error "bad --incremental-schedule value"
checkschedule (Just delta) = do
Annex.addCleanup FsckCleanup $ do
v <- getStartTime u
case v of
Nothing -> noop
Just started -> do
now <- liftIO getPOSIXTime
when (now - realToFrac started >= durationToPOSIXTime delta) $
resetStartTime u
return True
prepIncremental :: UUID -> Maybe IncrementalOpt -> Annex Incremental
prepIncremental _ Nothing = pure NonIncremental
prepIncremental u (Just StartIncrementalO) = do
recordStartTime u
ifM (FsckDb.newPass u)
( StartIncremental <$> FsckDb.openDb u
, error "Cannot start a new --incremental fsck pass; another fsck process is already running."
)
prepIncremental u (Just MoreIncrementalO) =
ContIncremental <$> FsckDb.openDb u
prepIncremental u (Just (ScheduleIncrementalO delta)) = do
Annex.addCleanup FsckCleanup $ do
v <- getStartTime u
case v of
Nothing -> noop
Just started -> do
now <- liftIO getPOSIXTime
when (now - realToFrac started >= durationToPOSIXTime delta) $
resetStartTime u
started <- getStartTime u
prepIncremental u $ Just $ case started of
Nothing -> StartIncrementalO
Just _ -> MoreIncrementalO

View file

@ -20,11 +20,13 @@ import System.Random (getStdRandom, random, randomR)
import Test.QuickCheck
import Control.Concurrent
cmd :: [Command]
cmd = [ notBareRepo $ command "fuzztest" paramNothing seek SectionTesting
"generates fuzz test files"]
cmd :: Command
cmd = notBareRepo $
command "fuzztest" SectionTesting
"generates fuzz test files"
paramNothing (withParams seek)
seek :: CommandSeek
seek :: CmdParams -> CommandSeek
seek = withNothing start
start :: CommandStart
@ -53,9 +55,9 @@ guardTest = unlessM (fromMaybe False . Git.Config.isTrue <$> getConfig key "") $
fuzz :: Handle -> Annex ()
fuzz logh = do
action <- genFuzzAction
record logh $ flip Started action
result <- tryNonAsync $ runFuzzAction action
fuzzer <- genFuzzAction
record logh $ flip Started fuzzer
result <- tryNonAsync $ runFuzzAction fuzzer
record logh $ flip Finished $
either (const False) (const True) result

View file

@ -13,12 +13,13 @@ import Annex.UUID
import qualified Remote.GCrypt
import qualified Git
cmd :: [Command]
cmd = [dontCheck repoExists $ noCommit $
command "gcryptsetup" paramValue seek
SectionPlumbing "sets up gcrypt repository"]
cmd :: Command
cmd = dontCheck repoExists $ noCommit $
command "gcryptsetup" SectionPlumbing
"sets up gcrypt repository"
paramValue (withParams seek)
seek :: CommandSeek
seek :: CmdParams -> CommandSeek
seek = withStrings start
start :: String -> CommandStart

View file

@ -16,28 +16,39 @@ import Annex.NumCopies
import Annex.Wanted
import qualified Command.Move
cmd :: [Command]
cmd = [withOptions getOptions $ command "get" paramPaths seek
SectionCommon "make content of annexed files available"]
cmd :: Command
cmd = withGlobalOptions (jobsOption : annexedMatchingOptions) $
command "get" SectionCommon
"make content of annexed files available"
paramPaths (seek <$$> optParser)
getOptions :: [Option]
getOptions = fromOption : autoOption : jobsOption : annexedMatchingOptions
++ incompleteOption : keyOptions
data GetOptions = GetOptions
{ getFiles :: CmdParams
, getFrom :: Maybe (DeferredParse Remote)
, autoMode :: Bool
, keyOptions :: Maybe KeyOptions
}
seek :: CommandSeek
seek ps = do
from <- getOptionField fromOption Remote.byNameWithUUID
auto <- getOptionFlag autoOption
withKeyOptions auto
optParser :: CmdParamsDesc -> Parser GetOptions
optParser desc = GetOptions
<$> cmdParams desc
<*> optional parseFromOption
<*> parseAutoOption
<*> optional (parseKeyOptions True)
seek :: GetOptions -> CommandSeek
seek o = do
from <- maybe (pure Nothing) (Just <$$> getParsed) (getFrom o)
withKeyOptions (keyOptions o) (autoMode o)
(startKeys from)
(withFilesInGit $ whenAnnexed $ start auto from)
ps
(withFilesInGit $ whenAnnexed $ start o from)
(getFiles o)
start :: Bool -> Maybe Remote -> FilePath -> Key -> CommandStart
start auto from file key = start' expensivecheck from key (Just file)
start :: GetOptions -> Maybe Remote -> FilePath -> Key -> CommandStart
start o from file key = start' expensivecheck from key (Just file)
where
expensivecheck
| auto = numCopiesCheck file key (<) <||> wantGet False (Just key) (Just file)
| autoMode o = numCopiesCheck file key (<) <||> wantGet False (Just key) (Just file)
| otherwise = return True
startKeys :: Maybe Remote -> Key -> CommandStart

View file

@ -15,11 +15,11 @@ import Types.Group
import qualified Data.Set as S
cmd :: [Command]
cmd = [command "group" (paramPair paramRemote paramDesc) seek
SectionSetup "add a repository to a group"]
cmd :: Command
cmd = command "group" SectionSetup "add a repository to a group"
(paramPair paramRemote paramDesc) (withParams seek)
seek :: CommandSeek
seek :: CmdParams -> CommandSeek
seek = withWords start
start :: [String] -> CommandStart

View file

@ -12,11 +12,13 @@ import Command
import Logs.PreferredContent
import Command.Wanted (performGet, performSet)
cmd :: [Command]
cmd = [command "groupwanted" (paramPair paramGroup (paramOptional paramExpression)) seek
SectionSetup "get or set groupwanted expression"]
cmd :: Command
cmd = command "groupwanted" SectionSetup
"get or set groupwanted expression"
(paramPair paramGroup (paramOptional paramExpression))
(withParams seek)
seek :: CommandSeek
seek :: CmdParams -> CommandSeek
seek = withWords start
start :: [String] -> CommandStart

View file

@ -19,13 +19,15 @@ import qualified Command.Sync
import qualified Command.Whereis
import qualified Command.Fsck
import System.Console.GetOpt
cmd :: Command
cmd = noCommit $ dontCheck repoExists $
noRepo (parseparams startNoRepo) $
command "help" SectionCommon "display help"
"COMMAND" (parseparams seek)
where
parseparams = withParams
cmd :: [Command]
cmd = [noCommit $ noRepo startNoRepo $ dontCheck repoExists $
command "help" (paramOptional "COMMAND") seek SectionCommon "display help"]
seek :: CommandSeek
seek :: CmdParams -> CommandSeek
seek = withWords start
start :: [String] -> CommandStart
@ -37,17 +39,13 @@ startNoRepo :: CmdParams -> IO ()
startNoRepo = start'
start' :: [String] -> IO ()
start' ["options"] = showCommonOptions
start' [c] = showGitHelp c
start' _ = showGeneralHelp
showCommonOptions :: IO ()
showCommonOptions = putStrLn $ usageInfo "Common options:" gitAnnexOptions
showGeneralHelp :: IO ()
showGeneralHelp = putStrLn $ unlines
[ "The most frequently used git-annex commands are:"
, unlines $ map cmdline $ concat
, unlines $ map cmdline $
[ Command.Init.cmd
, Command.Add.cmd
, Command.Drop.cmd
@ -58,9 +56,8 @@ showGeneralHelp = putStrLn $ unlines
, Command.Whereis.cmd
, Command.Fsck.cmd
]
, "Run 'git-annex' for a complete command list."
, "Run 'git-annex help command' for help on a specific command."
, "Run `git annex help options' for a list of common options."
, "For a complete command list, run: git-annex"
, "For help on a specific command, run: git-annex help COMMAND"
]
where
cmdline c = "\t" ++ cmdname c ++ "\t" ++ cmddesc c

View file

@ -22,52 +22,51 @@ import Annex.NumCopies
import Types.TrustLevel
import Logs.Trust
cmd :: [Command]
cmd = [withOptions opts $ notBareRepo $ command "import" paramPaths seek
SectionCommon "move and add files from outside git working copy"]
opts :: [Option]
opts = duplicateModeOptions ++ fileMatchingOptions
cmd :: Command
cmd = withGlobalOptions fileMatchingOptions $ notBareRepo $
command "import" SectionCommon
"move and add files from outside git working copy"
paramPaths (seek <$$> optParser)
data DuplicateMode = Default | Duplicate | DeDuplicate | CleanDuplicates | SkipDuplicates
deriving (Eq, Enum, Bounded)
deriving (Eq)
associatedOption :: DuplicateMode -> Maybe Option
associatedOption Default = Nothing
associatedOption Duplicate = Just $
flagOption [] "duplicate" "do not delete source files"
associatedOption DeDuplicate = Just $
flagOption [] "deduplicate" "delete source files whose content was imported before"
associatedOption CleanDuplicates = Just $
flagOption [] "clean-duplicates" "delete duplicate source files (import nothing)"
associatedOption SkipDuplicates = Just $
flagOption [] "skip-duplicates" "import only new files"
data ImportOptions = ImportOptions
{ importFiles :: CmdParams
, duplicateMode :: DuplicateMode
}
duplicateModeOptions :: [Option]
duplicateModeOptions = mapMaybe associatedOption [minBound..maxBound]
optParser :: CmdParamsDesc -> Parser ImportOptions
optParser desc = ImportOptions
<$> cmdParams desc
<*> (fromMaybe Default <$> optional duplicateModeParser)
getDuplicateMode :: Annex DuplicateMode
getDuplicateMode = go . catMaybes <$> mapM getflag [minBound..maxBound]
where
getflag m = case associatedOption m of
Nothing -> return Nothing
Just o -> ifM (Annex.getFlag (optionName o))
( return (Just m)
, return Nothing
)
go [] = Default
go [m] = m
go ms = error $ "cannot combine " ++
unwords (map (optionParam . fromJust . associatedOption) ms)
duplicateModeParser :: Parser DuplicateMode
duplicateModeParser =
flag' Duplicate
( long "duplicate"
<> help "do not delete source files"
)
<|> flag' DeDuplicate
( long "deduplicate"
<> help "delete source files whose content was imported before"
)
<|> flag' CleanDuplicates
( long "clean-duplicates"
<> help "delete duplicate source files (import nothing)"
)
<|> flag' SkipDuplicates
( long "skip-duplicates"
<> help "import only new files"
)
seek :: CommandSeek
seek ps = do
mode <- getDuplicateMode
seek :: ImportOptions -> CommandSeek
seek o = do
repopath <- liftIO . absPath =<< fromRepo Git.repoPath
inrepops <- liftIO $ filter (dirContains repopath) <$> mapM absPath ps
inrepops <- liftIO $ filter (dirContains repopath) <$> mapM absPath (importFiles o)
unless (null inrepops) $ do
error $ "cannot import files from inside the working tree (use git annex add instead): " ++ unwords inrepops
withPathContents (start mode) ps
withPathContents (start (duplicateMode o)) (importFiles o)
start :: DuplicateMode -> (FilePath, FilePath) -> CommandStart
start mode (srcfile, destfile) =

View file

@ -30,7 +30,7 @@ import Types.UrlContents
import Logs.Web
import qualified Utility.Format
import Utility.Tmp
import Command.AddUrl (addUrlFile, downloadRemoteFile, relaxedOption, rawOption)
import Command.AddUrl (addUrlFile, downloadRemoteFile, parseRelaxedOption, parseRawOption)
import Annex.Perms
import Annex.UUID
import Backend.URL (fromUrl)
@ -43,34 +43,39 @@ import Types.MetaData
import Logs.MetaData
import Annex.MetaData
cmd :: [Command]
cmd = [notBareRepo $ withOptions [templateOption, relaxedOption, rawOption] $
command "importfeed" (paramRepeating paramUrl) seek
SectionCommon "import files from podcast feeds"]
cmd :: Command
cmd = notBareRepo $
command "importfeed" SectionCommon "import files from podcast feeds"
(paramRepeating paramUrl) (seek <$$> optParser)
templateOption :: Option
templateOption = fieldOption [] "template" paramFormat "template for filenames"
seek :: CommandSeek
seek ps = do
tmpl <- getOptionField templateOption return
relaxed <- getOptionFlag relaxedOption
raw <- getOptionFlag rawOption
let opts = Opts { relaxedOpt = relaxed, rawOpt = raw }
cache <- getCache tmpl
withStrings (start opts cache) ps
data Opts = Opts
{ relaxedOpt :: Bool
, rawOpt :: Bool
data ImportFeedOptions = ImportFeedOptions
{ feedUrls :: CmdParams
, templateOption :: Maybe String
, relaxedOption :: Bool
, rawOption :: Bool
}
start :: Opts -> Cache -> URLString -> CommandStart
optParser :: CmdParamsDesc -> Parser ImportFeedOptions
optParser desc = ImportFeedOptions
<$> cmdParams desc
<*> optional (strOption
( long "template" <> metavar paramFormat
<> help "template for filenames"
))
<*> parseRelaxedOption
<*> parseRawOption
seek :: ImportFeedOptions -> CommandSeek
seek o = do
cache <- getCache (templateOption o)
withStrings (start o cache) (feedUrls o)
start :: ImportFeedOptions -> Cache -> URLString -> CommandStart
start opts cache url = do
showStart "importfeed" url
next $ perform opts cache url
perform :: Opts -> Cache -> URLString -> CommandPerform
perform :: ImportFeedOptions -> Cache -> URLString -> CommandPerform
perform opts cache url = do
v <- findDownloads url
case v of
@ -160,15 +165,15 @@ downloadFeed url
, return Nothing
)
performDownload :: Opts -> Cache -> ToDownload -> Annex Bool
performDownload :: ImportFeedOptions -> Cache -> ToDownload -> Annex Bool
performDownload opts cache todownload = case location todownload of
Enclosure url -> checkknown url $
rundownload url (takeExtension url) $ \f -> do
r <- Remote.claimingUrl url
if Remote.uuid r == webUUID || rawOpt opts
if Remote.uuid r == webUUID || rawOption opts
then do
urlinfo <- Url.withUrlOptions (Url.getUrlInfo url)
maybeToList <$> addUrlFile (relaxedOpt opts) url urlinfo f
maybeToList <$> addUrlFile (relaxedOption opts) url urlinfo f
else do
res <- tryNonAsync $ maybe
(error $ "unable to checkUrl of " ++ Remote.name r)
@ -178,10 +183,10 @@ performDownload opts cache todownload = case location todownload of
Left _ -> return []
Right (UrlContents sz _) ->
maybeToList <$>
downloadRemoteFile r (relaxedOpt opts) url f sz
downloadRemoteFile r (relaxedOption opts) url f sz
Right (UrlMulti l) -> do
kl <- forM l $ \(url', sz, subf) ->
downloadRemoteFile r (relaxedOpt opts) url' (f </> fromSafeFilePath subf) sz
downloadRemoteFile r (relaxedOption opts) url' (f </> fromSafeFilePath subf) sz
return $ if all isJust kl
then catMaybes kl
else []
@ -199,7 +204,7 @@ performDownload opts cache todownload = case location todownload of
let videourl = Quvi.linkUrl link
checkknown videourl $
rundownload videourl ("." ++ fromMaybe "m" (Quvi.linkSuffix link)) $ \f ->
maybeToList <$> addUrlFileQuvi (relaxedOpt opts) quviurl videourl f
maybeToList <$> addUrlFileQuvi (relaxedOption opts) quviurl videourl f
#else
return False
#endif

View file

@ -11,11 +11,14 @@ import Common.Annex
import Command
import Annex.Content
cmd :: [Command]
cmd = [noCommit $ command "inannex" (paramRepeating paramKey) seek
SectionPlumbing "checks if keys are present in the annex"]
cmd :: Command
cmd = noCommit $
command "inannex" SectionPlumbing
"checks if keys are present in the annex"
(paramRepeating paramKey)
(withParams seek)
seek :: CommandSeek
seek :: CmdParams -> CommandSeek
seek = withKeys start
start :: Key -> CommandStart

View file

@ -22,12 +22,12 @@ import Annex.CatFile
import Annex.Init
import qualified Command.Add
cmd :: [Command]
cmd = [notBareRepo $ noDaemonRunning $
command "indirect" paramNothing seek
SectionSetup "switch repository to indirect mode"]
cmd :: Command
cmd = notBareRepo $ noDaemonRunning $
command "indirect" SectionSetup "switch repository to indirect mode"
paramNothing (withParams seek)
seek :: CommandSeek
seek :: CmdParams -> CommandSeek
seek = withNothing start
start :: CommandStart

View file

@ -70,79 +70,94 @@ data StatInfo = StatInfo
, referencedData :: Maybe KeyData
, repoData :: M.Map UUID KeyData
, numCopiesStats :: Maybe NumCopiesStats
, infoOptions :: InfoOptions
}
emptyStatInfo :: StatInfo
emptyStatInfo :: InfoOptions -> StatInfo
emptyStatInfo = StatInfo Nothing Nothing M.empty Nothing
-- a state monad for running Stats in
type StatState = StateT StatInfo Annex
cmd :: [Command]
cmd = [noCommit $ dontCheck repoExists $ withOptions (jsonOption : bytesOption : annexedMatchingOptions) $
command "info" (paramOptional $ paramRepeating paramItem) seek SectionQuery
"shows information about the specified item or the repository as a whole"]
cmd :: Command
cmd = noCommit $ dontCheck repoExists $ withGlobalOptions (jsonOption : annexedMatchingOptions) $
command "info" SectionQuery
"shows information about the specified item or the repository as a whole"
(paramRepeating paramItem) (seek <$$> optParser)
seek :: CommandSeek
seek = withWords start
data InfoOptions = InfoOptions
{ infoFor :: CmdParams
, bytesOption :: Bool
}
start :: [String] -> CommandStart
start [] = do
globalInfo
optParser :: CmdParamsDesc -> Parser InfoOptions
optParser desc = InfoOptions
<$> cmdParams desc
<*> switch
( long "bytes"
<> help "display file sizes in bytes"
)
seek :: InfoOptions -> CommandSeek
seek o = withWords (start o) (infoFor o)
start :: InfoOptions -> [String] -> CommandStart
start o [] = do
globalInfo o
stop
start ps = do
mapM_ itemInfo ps
start o ps = do
mapM_ (itemInfo o) ps
stop
globalInfo :: Annex ()
globalInfo = do
globalInfo :: InfoOptions -> Annex ()
globalInfo o = do
stats <- selStats global_fast_stats global_slow_stats
showCustom "info" $ do
evalStateT (mapM_ showStat stats) emptyStatInfo
evalStateT (mapM_ showStat stats) (emptyStatInfo o)
return True
itemInfo :: String -> Annex ()
itemInfo p = ifM (isdir p)
( dirInfo p
itemInfo :: InfoOptions -> String -> Annex ()
itemInfo o p = ifM (isdir p)
( dirInfo o p
, do
v <- Remote.byName' p
case v of
Right r -> remoteInfo r
Right r -> remoteInfo o r
Left _ -> do
v' <- Remote.nameToUUID' p
case v' of
Right u -> uuidInfo u
Left _ -> maybe noinfo (fileInfo p)
Right u -> uuidInfo o u
Left _ -> maybe noinfo (fileInfo o p)
=<< isAnnexLink p
)
where
isdir = liftIO . catchBoolIO . (isDirectory <$$> getFileStatus)
noinfo = error $ p ++ " is not a directory or an annexed file or a remote or a uuid"
dirInfo :: FilePath -> Annex ()
dirInfo dir = showCustom (unwords ["info", dir]) $ do
dirInfo :: InfoOptions -> FilePath -> Annex ()
dirInfo o dir = showCustom (unwords ["info", dir]) $ do
stats <- selStats (tostats dir_fast_stats) (tostats dir_slow_stats)
evalStateT (mapM_ showStat stats) =<< getDirStatInfo dir
evalStateT (mapM_ showStat stats) =<< getDirStatInfo o dir
return True
where
tostats = map (\s -> s dir)
fileInfo :: FilePath -> Key -> Annex ()
fileInfo file k = showCustom (unwords ["info", file]) $ do
evalStateT (mapM_ showStat (file_stats file k)) emptyStatInfo
fileInfo :: InfoOptions -> FilePath -> Key -> Annex ()
fileInfo o file k = showCustom (unwords ["info", file]) $ do
evalStateT (mapM_ showStat (file_stats file k)) (emptyStatInfo o)
return True
remoteInfo :: Remote -> Annex ()
remoteInfo r = showCustom (unwords ["info", Remote.name r]) $ do
info <- map (\(k, v) -> simpleStat k (pure v)) <$> Remote.getInfo r
l <- selStats (remote_fast_stats r ++ info) (uuid_slow_stats (Remote.uuid r))
evalStateT (mapM_ showStat l) emptyStatInfo
remoteInfo :: InfoOptions -> Remote -> Annex ()
remoteInfo o r = showCustom (unwords ["info", Remote.name r]) $ do
i <- map (\(k, v) -> simpleStat k (pure v)) <$> Remote.getInfo r
l <- selStats (remote_fast_stats r ++ i) (uuid_slow_stats (Remote.uuid r))
evalStateT (mapM_ showStat l) (emptyStatInfo o)
return True
uuidInfo :: UUID -> Annex ()
uuidInfo u = showCustom (unwords ["info", fromUUID u]) $ do
uuidInfo :: InfoOptions -> UUID -> Annex ()
uuidInfo o u = showCustom (unwords ["info", fromUUID u]) $ do
l <- selStats [] ((uuid_slow_stats u))
evalStateT (mapM_ showStat l) emptyStatInfo
evalStateT (mapM_ showStat l) (emptyStatInfo o)
return True
selStats :: [Stat] -> [Stat] -> Annex [Stat]
@ -298,7 +313,7 @@ local_annex_keys = stat "local annex keys" $ json show $
local_annex_size :: Stat
local_annex_size = simpleStat "local annex size" $
lift . showSizeKeys =<< cachedPresentData
showSizeKeys =<< cachedPresentData
remote_annex_keys :: UUID -> Stat
remote_annex_keys u = stat "remote annex keys" $ json show $
@ -306,7 +321,7 @@ remote_annex_keys u = stat "remote annex keys" $ json show $
remote_annex_size :: UUID -> Stat
remote_annex_size u = simpleStat "remote annex size" $
lift . showSizeKeys =<< cachedRemoteData u
showSizeKeys =<< cachedRemoteData u
known_annex_files :: Stat
known_annex_files = stat "annexed files in working tree" $ json show $
@ -314,7 +329,7 @@ known_annex_files = stat "annexed files in working tree" $ json show $
known_annex_size :: Stat
known_annex_size = simpleStat "size of annexed files in working tree" $
lift . showSizeKeys =<< cachedReferencedData
showSizeKeys =<< cachedReferencedData
tmp_size :: Stat
tmp_size = staleSize "temporary object directory size" gitAnnexTmpObjectDir
@ -323,7 +338,7 @@ bad_data_size :: Stat
bad_data_size = staleSize "bad keys size" gitAnnexBadDir
key_size :: Key -> Stat
key_size k = simpleStat "size" $ lift $ showSizeKeys $ foldKeys [k]
key_size k = simpleStat "size" $ showSizeKeys $ foldKeys [k]
key_name :: Key -> Stat
key_name k = simpleStat "key" $ pure $ key2file k
@ -339,7 +354,7 @@ bloom_info = simpleStat "bloom filter size" $ do
-- Two bloom filters are used at the same time when running
-- git-annex unused, so double the size of one.
sizer <- lift mkSizer
sizer <- mkSizer
size <- sizer memoryUnits False . (* 2) . fromIntegral . fst <$>
lift bloomBitsHashes
@ -371,10 +386,10 @@ transfer_list = stat desc $ nojson $ lift $ do
]
disk_size :: Stat
disk_size = simpleStat "available local disk space" $ lift $
disk_size = simpleStat "available local disk space" $
calcfree
<$> (annexDiskReserve <$> Annex.getGitConfig)
<*> inRepo (getDiskFree . gitAnnexDir)
<$> (lift $ annexDiskReserve <$> Annex.getGitConfig)
<*> (lift $ inRepo $ getDiskFree . gitAnnexDir)
<*> mkSizer
where
calcfree reserve (Just have) sizer = unwords
@ -408,7 +423,7 @@ numcopies_stats = stat "numcopies stats" $ json fmt $
reposizes_stats :: Stat
reposizes_stats = stat desc $ nojson $ do
sizer <- lift mkSizer
sizer <- mkSizer
l <- map (\(u, kd) -> (u, sizer storageUnits True (sizeKeys kd)))
. sortBy (flip (comparing (sizeKeys . snd)))
. M.toList
@ -465,14 +480,14 @@ cachedNumCopiesStats = numCopiesStats <$> get
cachedRepoData :: StatState (M.Map UUID KeyData)
cachedRepoData = repoData <$> get
getDirStatInfo :: FilePath -> Annex StatInfo
getDirStatInfo dir = do
getDirStatInfo :: InfoOptions -> FilePath -> Annex StatInfo
getDirStatInfo o dir = do
fast <- Annex.getState Annex.fast
matcher <- Limit.getMatcher
(presentdata, referenceddata, numcopiesstats, repodata) <-
Command.Unused.withKeysFilesReferencedIn dir initial
(update matcher fast)
return $ StatInfo (Just presentdata) (Just referenceddata) repodata (Just numcopiesstats)
return $ StatInfo (Just presentdata) (Just referenceddata) repodata (Just numcopiesstats) o
where
initial = (emptyKeyData, emptyKeyData, emptyNumCopiesStats, M.empty)
update matcher fast key file vs@(presentdata, referenceddata, numcopiesstats, repodata) =
@ -529,7 +544,7 @@ updateNumCopiesStats file (NumCopiesStats m) locs = do
let !ret = NumCopiesStats m'
return ret
showSizeKeys :: KeyData -> Annex String
showSizeKeys :: KeyData -> StatState String
showSizeKeys d = do
sizer <- mkSizer
return $ total sizer ++ missingnote
@ -549,7 +564,7 @@ staleSize label dirspec = go =<< lift (dirKeys dirspec)
onsize 0 = nostat
onsize size = stat label $
json (++ aside "clean up with git-annex unused") $ do
sizer <- lift mkSizer
sizer <- mkSizer
return $ sizer storageUnits False size
keysizes keys = do
dir <- lift $ fromRepo dirspec
@ -562,11 +577,8 @@ aside s = " (" ++ s ++ ")"
multiLine :: [String] -> String
multiLine = concatMap (\l -> "\n\t" ++ l)
mkSizer :: Annex ([Unit] -> Bool -> ByteSize -> String)
mkSizer = ifM (getOptionFlag bytesOption)
mkSizer :: StatState ([Unit] -> Bool -> ByteSize -> String)
mkSizer = ifM (bytesOption . infoOptions <$> get)
( return (const $ const show)
, return roughSize
)
bytesOption :: Option
bytesOption = flagOption [] "bytes" "display file sizes in bytes"

View file

@ -11,11 +11,12 @@ import Common.Annex
import Command
import Annex.Init
cmd :: [Command]
cmd = [dontCheck repoExists $
command "init" paramDesc seek SectionSetup "initialize git-annex"]
cmd :: Command
cmd = dontCheck repoExists $
command "init" SectionSetup "initialize git-annex"
paramDesc (withParams seek)
seek :: CommandSeek
seek :: CmdParams -> CommandSeek
seek = withWords start
start :: [String] -> CommandStart

View file

@ -19,12 +19,13 @@ import Logs.Trust
import Data.Ord
cmd :: [Command]
cmd = [command "initremote"
cmd :: Command
cmd = command "initremote" SectionSetup
"creates a special (non-git) remote"
(paramPair paramName $ paramOptional $ paramRepeating paramKeyValue)
seek SectionSetup "creates a special (non-git) remote"]
(withParams seek)
seek :: CommandSeek
seek :: CmdParams -> CommandSeek
seek = withWords start
start :: [String] -> CommandStart

View file

@ -20,28 +20,37 @@ import Remote
import Logs.Trust
import Logs.UUID
import Annex.UUID
import qualified Annex
import Git.Types (RemoteName)
cmd :: [Command]
cmd = [noCommit $ withOptions (allrepos : annexedMatchingOptions) $
command "list" paramPaths seek
SectionQuery "show which remotes contain files"]
cmd :: Command
cmd = noCommit $ withGlobalOptions annexedMatchingOptions $
command "list" SectionQuery
"show which remotes contain files"
paramPaths (seek <$$> optParser)
allrepos :: Option
allrepos = flagOption [] "allrepos" "show all repositories, not only remotes"
data ListOptions = ListOptions
{ listThese :: CmdParams
, allRepos :: Bool
}
seek :: CommandSeek
seek ps = do
list <- getList
optParser :: CmdParamsDesc -> Parser ListOptions
optParser desc = ListOptions
<$> cmdParams desc
<*> switch
( long "allrepos"
<> help "show all repositories, not only remotes"
)
seek :: ListOptions -> CommandSeek
seek o = do
list <- getList o
printHeader list
withFilesInGit (whenAnnexed $ start list) ps
withFilesInGit (whenAnnexed $ start list) (listThese o)
getList :: Annex [(UUID, RemoteName, TrustLevel)]
getList = ifM (Annex.getFlag $ optionName allrepos)
( nubBy ((==) `on` fst3) <$> ((++) <$> getRemotes <*> getAllUUIDs)
, getRemotes
)
getList :: ListOptions -> Annex [(UUID, RemoteName, TrustLevel)]
getList o
| allRepos o = nubBy ((==) `on` fst3) <$> ((++) <$> getRemotes <*> getAllUUIDs)
| otherwise = getRemotes
where
getRemotes = do
rs <- remoteList
@ -59,7 +68,7 @@ getList = ifM (Annex.getFlag $ optionName allrepos)
filter (\t -> thd3 t /= DeadTrusted) rs3
printHeader :: [(UUID, RemoteName, TrustLevel)] -> Annex ()
printHeader l = liftIO $ putStrLn $ header $ map (\(_, n, t) -> (n, t)) l
printHeader l = liftIO $ putStrLn $ lheader $ map (\(_, n, t) -> (n, t)) l
start :: [(UUID, RemoteName, TrustLevel)] -> FilePath -> Key -> CommandStart
start l file key = do
@ -69,8 +78,8 @@ start l file key = do
type Present = Bool
header :: [(RemoteName, TrustLevel)] -> String
header remotes = unlines (zipWith formatheader [0..] remotes) ++ pipes (length remotes)
lheader :: [(RemoteName, TrustLevel)] -> String
lheader remotes = unlines (zipWith formatheader [0..] remotes) ++ pipes (length remotes)
where
formatheader n (remotename, trustlevel) = pipes n ++ remotename ++ trust trustlevel
pipes = flip replicate '|'

View file

@ -12,12 +12,13 @@ import Command
import qualified Annex.Queue
import qualified Annex
cmd :: [Command]
cmd = [notDirect $ withOptions annexedMatchingOptions $
command "lock" paramPaths seek SectionCommon
"undo unlock command"]
cmd :: Command
cmd = notDirect $ withGlobalOptions annexedMatchingOptions $
command "lock" SectionCommon
"undo unlock command"
paramPaths (withParams seek)
seek :: CommandSeek
seek :: CmdParams -> CommandSeek
seek ps = do
withFilesUnlocked start ps
withFilesUnlockedToBeCommitted start ps

View file

@ -38,52 +38,62 @@ data RefChange = RefChange
type Outputter = Bool -> POSIXTime -> [UUID] -> Annex ()
cmd :: [Command]
cmd = [withOptions options $
command "log" paramPaths seek SectionQuery "shows location log"]
cmd :: Command
cmd = withGlobalOptions annexedMatchingOptions $
command "log" SectionQuery "shows location log"
paramPaths (seek <$$> optParser)
options :: [Option]
options = passthruOptions ++ [gourceOption] ++ annexedMatchingOptions
data LogOptions = LogOptions
{ logFiles :: CmdParams
, gourceOption :: Bool
, passthruOptions :: [CommandParam]
}
passthruOptions :: [Option]
passthruOptions = map odate ["since", "after", "until", "before"] ++
[ fieldOption ['n'] "max-count" paramNumber
"limit number of logs displayed"
]
optParser :: CmdParamsDesc -> Parser LogOptions
optParser desc = LogOptions
<$> cmdParams desc
<*> switch
( long "gource"
<> help "format output for gource"
)
<*> (concat <$> many passthru)
where
odate n = fieldOption [] n paramDate $ "show log " ++ n ++ " date"
passthru :: Parser [CommandParam]
passthru = datepassthru "since"
<|> datepassthru "after"
<|> datepassthru "until"
<|> datepassthru "before"
<|> (mkpassthru "max-count" <$> strOption
( long "max-count" <> metavar paramNumber
<> help "limit number of logs displayed"
))
datepassthru n = mkpassthru n <$> strOption
( long n <> metavar paramDate
<> help ("show log " ++ n ++ " date")
)
mkpassthru n v = [Param ("--" ++ n), Param v]
gourceOption :: Option
gourceOption = flagOption [] "gource" "format output for gource"
seek :: CommandSeek
seek ps = do
seek :: LogOptions -> CommandSeek
seek o = do
m <- Remote.uuidDescriptions
zone <- liftIO getCurrentTimeZone
os <- concat <$> mapM getoption passthruOptions
gource <- getOptionFlag gourceOption
withFilesInGit (whenAnnexed $ start m zone os gource) ps
where
getoption o = maybe [] (use o) <$>
Annex.getField (optionName o)
use o v = [Param ("--" ++ optionName o), Param v]
withFilesInGit (whenAnnexed $ start m zone o) (logFiles o)
start
:: M.Map UUID String
-> TimeZone
-> [CommandParam]
-> Bool
-> LogOptions
-> FilePath
-> Key
-> CommandStart
start m zone os gource file key = do
showLog output =<< readLog <$> getLog key os
start m zone o file key = do
showLog output =<< readLog <$> getLog key (passthruOptions o)
-- getLog produces a zombie; reap it
liftIO reapZombies
stop
where
output
| gource = gourceOutput lookupdescription file
| (gourceOption o) = gourceOutput lookupdescription file
| otherwise = normalOutput lookupdescription file zone
lookupdescription u = fromMaybe (fromUUID u) $ M.lookup u m

View file

@ -13,16 +13,18 @@ import CmdLine.Batch
import Annex.CatFile
import Types.Key
cmd :: [Command]
cmd = [withOptions [batchOption] $ notBareRepo $ noCommit $ noMessages $
command "lookupkey" (paramRepeating paramFile) seek
SectionPlumbing "looks up key used for file"]
cmd :: Command
cmd = notBareRepo $ noCommit $ noMessages $
command "lookupkey" SectionPlumbing
"looks up key used for file"
(paramRepeating paramFile)
(batchable run (pure ()))
seek :: CommandSeek
seek = batchable withStrings start
start :: Batchable String
start batchmode file = do
maybe (batchBadInput batchmode) (liftIO . putStrLn . key2file)
=<< catKeyFile file
stop
run :: () -> String -> Annex Bool
run _ file = do
mk <- catKeyFile file
case mk of
Just k -> do
liftIO $ putStrLn $ key2file k
return True
Nothing -> return False

View file

@ -25,12 +25,13 @@ import qualified Utility.Dot as Dot
-- a link from the first repository to the second (its remote)
data Link = Link Git.Repo Git.Repo
cmd :: [Command]
cmd = [dontCheck repoExists $
command "map" paramNothing seek SectionQuery
"generate map of repositories"]
cmd :: Command
cmd = dontCheck repoExists $
command "map" SectionQuery
"generate map of repositories"
paramNothing (withParams seek)
seek :: CommandSeek
seek :: CmdParams -> CommandSeek
seek = withNothing start
start :: CommandStart

View file

@ -13,11 +13,12 @@ import qualified Annex.Branch
import qualified Git.Branch
import Command.Sync (prepMerge, mergeLocal)
cmd :: [Command]
cmd = [command "merge" paramNothing seek SectionMaintenance
"automatically merge changes from remotes"]
cmd :: Command
cmd = command "merge" SectionMaintenance
"automatically merge changes from remotes"
paramNothing (withParams seek)
seek :: CommandSeek
seek :: CmdParams -> CommandSeek
seek ps = do
withNothing mergeBranch ps
withNothing mergeSynced ps

View file

@ -8,7 +8,6 @@
module Command.MetaData where
import Common.Annex
import qualified Annex
import Command
import Annex.MetaData
import Logs.MetaData
@ -16,71 +15,70 @@ import Logs.MetaData
import qualified Data.Set as S
import Data.Time.Clock.POSIX
cmd :: [Command]
cmd = [withOptions metaDataOptions $
command "metadata" paramPaths seek
SectionMetaData "sets or gets metadata of a file"]
cmd :: Command
cmd = withGlobalOptions ([jsonOption] ++ annexedMatchingOptions) $
command "metadata" SectionMetaData
"sets or gets metadata of a file"
paramPaths (seek <$$> optParser)
metaDataOptions :: [Option]
metaDataOptions =
[ setOption
, tagOption
, untagOption
, getOption
, jsonOption
] ++ keyOptions ++ annexedMatchingOptions
data MetaDataOptions = MetaDataOptions
{ forFiles :: CmdParams
, getSet :: GetSet
, keyOptions :: Maybe KeyOptions
}
storeModMeta :: ModMeta -> Annex ()
storeModMeta modmeta = Annex.changeState $
\s -> s { Annex.modmeta = modmeta:Annex.modmeta s }
data GetSet = Get MetaField | Set [ModMeta]
setOption :: Option
setOption = Option ['s'] ["set"] (ReqArg mkmod "FIELD[+-]=VALUE") "set metadata"
optParser :: CmdParamsDesc -> Parser MetaDataOptions
optParser desc = MetaDataOptions
<$> cmdParams desc
<*> ((Get <$> getopt) <|> (Set <$> many modopts))
<*> optional (parseKeyOptions False)
where
mkmod = either error storeModMeta . parseModMeta
getopt = option (eitherReader mkMetaField)
( long "get" <> short 'g' <> metavar paramField
<> help "get single metadata field"
)
modopts = option (eitherReader parseModMeta)
( long "set" <> short 's' <> metavar "FIELD[+-]=VALUE"
<> help "set or unset metadata value"
)
<|> (AddMeta tagMetaField . toMetaValue <$> strOption
( long "tag" <> short 't' <> metavar "TAG"
<> help "set a tag"
))
<|> (AddMeta tagMetaField . mkMetaValue (CurrentlySet False) <$> strOption
( long "untag" <> short 'u' <> metavar "TAG"
<> help "remove a tag"
))
getOption :: Option
getOption = fieldOption ['g'] "get" paramField "get single metadata field"
tagOption :: Option
tagOption = Option ['t'] ["tag"] (ReqArg mkmod "TAG") "set a tag"
where
mkmod = storeModMeta . AddMeta tagMetaField . toMetaValue
untagOption :: Option
untagOption = Option ['u'] ["untag"] (ReqArg mkmod "TAG") "remove a tag"
where
mkmod = storeModMeta . AddMeta tagMetaField . mkMetaValue (CurrentlySet False)
seek :: CommandSeek
seek ps = do
modmeta <- Annex.getState Annex.modmeta
getfield <- getOptionField getOption $ \ms ->
return $ either error id . mkMetaField <$> ms
seek :: MetaDataOptions -> CommandSeek
seek o = do
now <- liftIO getPOSIXTime
let seeker = if null modmeta
then withFilesInGit
else withFilesInGitNonRecursive
withKeyOptions False
(startKeys now getfield modmeta)
(seeker $ whenAnnexed $ start now getfield modmeta)
ps
let seeker = case getSet o of
Get _ -> withFilesInGit
Set _ -> withFilesInGitNonRecursive
withKeyOptions (keyOptions o) False
(startKeys now o)
(seeker $ whenAnnexed $ start now o)
(forFiles o)
start :: POSIXTime -> Maybe MetaField -> [ModMeta] -> FilePath -> Key -> CommandStart
start now f ms file = start' (Just file) now f ms
start :: POSIXTime -> MetaDataOptions -> FilePath -> Key -> CommandStart
start now o file = start' (Just file) now o
startKeys :: POSIXTime -> Maybe MetaField -> [ModMeta] -> Key -> CommandStart
startKeys :: POSIXTime -> MetaDataOptions -> Key -> CommandStart
startKeys = start' Nothing
start' :: AssociatedFile -> POSIXTime -> Maybe MetaField -> [ModMeta] -> Key -> CommandStart
start' afile now Nothing ms k = do
showStart' "metadata" k afile
next $ perform now ms k
start' _ _ (Just f) _ k = do
l <- S.toList . currentMetaDataValues f <$> getCurrentMetaData k
liftIO $ forM_ l $
putStrLn . fromMetaValue
stop
start' :: AssociatedFile -> POSIXTime -> MetaDataOptions -> Key -> CommandStart
start' afile now o k = case getSet o of
Set ms -> do
showStart' "metadata" k afile
next $ perform now ms k
Get f -> do
l <- S.toList . currentMetaDataValues f <$> getCurrentMetaData k
liftIO $ forM_ l $
putStrLn . fromMetaValue
stop
perform :: POSIXTime -> [ModMeta] -> Key -> CommandPerform
perform _ [] k = next $ cleanup k

View file

@ -18,12 +18,13 @@ import qualified Command.ReKey
import qualified Command.Fsck
import qualified Annex
cmd :: [Command]
cmd = [notDirect $ withOptions annexedMatchingOptions $
command "migrate" paramPaths seek
SectionUtility "switch data to different backend"]
cmd :: Command
cmd = notDirect $ withGlobalOptions annexedMatchingOptions $
command "migrate" SectionUtility
"switch data to different backend"
paramPaths (withParams seek)
seek :: CommandSeek
seek :: CmdParams -> CommandSeek
seek = withFilesInGit $ whenAnnexed start
start :: FilePath -> Key -> CommandStart

View file

@ -16,41 +16,49 @@ import qualified Remote
import Annex.Content
import Annex.NumCopies
cmd :: [Command]
cmd = [withOptions mirrorOptions $ command "mirror" paramPaths seek
SectionCommon "mirror content of files to/from another repository"]
cmd :: Command
cmd = withGlobalOptions ([jobsOption] ++ annexedMatchingOptions) $
command "mirror" SectionCommon
"mirror content of files to/from another repository"
paramPaths (seek <--< optParser)
mirrorOptions :: [Option]
mirrorOptions = fromToOptions ++ [jobsOption] ++ annexedMatchingOptions ++ keyOptions
data MirrorOptions = MirrorOptions
{ mirrorFiles :: CmdParams
, fromToOptions :: FromToOptions
, keyOptions :: Maybe KeyOptions
}
seek :: CommandSeek
seek ps = do
to <- getOptionField toOption Remote.byNameWithUUID
from <- getOptionField fromOption Remote.byNameWithUUID
withKeyOptions False
(startKey to from Nothing)
(withFilesInGit $ whenAnnexed $ start to from)
ps
optParser :: CmdParamsDesc -> Parser MirrorOptions
optParser desc = MirrorOptions
<$> cmdParams desc
<*> parseFromToOptions
<*> optional (parseKeyOptions False)
start :: Maybe Remote -> Maybe Remote -> FilePath -> Key -> CommandStart
start to from file = startKey to from (Just file)
instance DeferredParseClass MirrorOptions where
finishParse v = MirrorOptions
<$> pure (mirrorFiles v)
<*> finishParse (fromToOptions v)
<*> pure (keyOptions v)
startKey :: Maybe Remote -> Maybe Remote -> Maybe FilePath -> Key -> CommandStart
startKey to from afile key =
case (from, to) of
(Nothing, Nothing) -> error "specify either --from or --to"
(Nothing, Just r) -> mirrorto r
(Just r, Nothing) -> mirrorfrom r
_ -> error "only one of --from or --to can be specified"
where
mirrorto r = ifM (inAnnex key)
( Command.Move.toStart r False afile key
seek :: MirrorOptions -> CommandSeek
seek o = withKeyOptions (keyOptions o) False
(startKey o Nothing)
(withFilesInGit $ whenAnnexed $ start o)
(mirrorFiles o)
start :: MirrorOptions -> FilePath -> Key -> CommandStart
start o file = startKey o (Just file)
startKey :: MirrorOptions -> Maybe FilePath -> Key -> CommandStart
startKey o afile key = case fromToOptions o of
ToRemote r -> ifM (inAnnex key)
( Command.Move.toStart False afile key =<< getParsed r
, do
numcopies <- getnumcopies
Command.Drop.startRemote afile numcopies key r
Command.Drop.startRemote afile numcopies key =<< getParsed r
)
mirrorfrom r = do
haskey <- Remote.hasKey r key
FromRemote r -> do
haskey <- flip Remote.hasKey key =<< getParsed r
case haskey of
Left _ -> stop
Right True -> Command.Get.start' (return True) Nothing key afile
@ -60,4 +68,5 @@ startKey to from afile key =
Command.Drop.startLocal afile numcopies key Nothing
, stop
)
where
getnumcopies = maybe getNumCopies getFileNumCopies afile

View file

@ -17,35 +17,47 @@ import Annex.UUID
import Annex.Transfer
import Logs.Presence
cmd :: [Command]
cmd = [withOptions moveOptions $ command "move" paramPaths seek
SectionCommon "move content of files to/from another repository"]
cmd :: Command
cmd = withGlobalOptions (jobsOption : annexedMatchingOptions) $
command "move" SectionCommon
"move content of files to/from another repository"
paramPaths (seek <--< optParser)
moveOptions :: [Option]
moveOptions = fromToOptions ++ [jobsOption] ++ keyOptions ++ annexedMatchingOptions
data MoveOptions = MoveOptions
{ moveFiles :: CmdParams
, fromToOptions :: FromToOptions
, keyOptions :: Maybe KeyOptions
}
seek :: CommandSeek
seek ps = do
to <- getOptionField toOption Remote.byNameWithUUID
from <- getOptionField fromOption Remote.byNameWithUUID
withKeyOptions False
(startKey to from True)
(withFilesInGit $ whenAnnexed $ start to from True)
ps
optParser :: CmdParamsDesc -> Parser MoveOptions
optParser desc = MoveOptions
<$> cmdParams desc
<*> parseFromToOptions
<*> optional (parseKeyOptions False)
start :: Maybe Remote -> Maybe Remote -> Bool -> FilePath -> Key -> CommandStart
start to from move = start' to from move . Just
instance DeferredParseClass MoveOptions where
finishParse v = MoveOptions
<$> pure (moveFiles v)
<*> finishParse (fromToOptions v)
<*> pure (keyOptions v)
startKey :: Maybe Remote -> Maybe Remote -> Bool -> Key -> CommandStart
startKey to from move = start' to from move Nothing
seek :: MoveOptions -> CommandSeek
seek o = withKeyOptions (keyOptions o) False
(startKey o True)
(withFilesInGit $ whenAnnexed $ start o True)
(moveFiles o)
start' :: Maybe Remote -> Maybe Remote -> Bool -> AssociatedFile -> Key -> CommandStart
start' to from move afile key = do
case (from, to) of
(Nothing, Nothing) -> error "specify either --from or --to"
(Nothing, Just dest) -> toStart dest move afile key
(Just src, Nothing) -> fromStart src move afile key
_ -> error "only one of --from or --to can be specified"
start :: MoveOptions -> Bool -> FilePath -> Key -> CommandStart
start o move = start' o move . Just
startKey :: MoveOptions -> Bool -> Key -> CommandStart
startKey o move = start' o move Nothing
start' :: MoveOptions -> Bool -> AssociatedFile -> Key -> CommandStart
start' o move afile key =
case fromToOptions o of
FromRemote src -> fromStart move afile key =<< getParsed src
ToRemote dest -> toStart move afile key =<< getParsed dest
showMoveAction :: Bool -> Key -> AssociatedFile -> Annex ()
showMoveAction move = showStart' (if move then "move" else "copy")
@ -59,8 +71,8 @@ showMoveAction move = showStart' (if move then "move" else "copy")
- A file's content can be moved even if there are insufficient copies to
- allow it to be dropped.
-}
toStart :: Remote -> Bool -> AssociatedFile -> Key -> CommandStart
toStart dest move afile key = do
toStart :: Bool -> AssociatedFile -> Key -> Remote -> CommandStart
toStart move afile key dest = do
u <- getUUID
ishere <- inAnnex key
if not ishere || u == Remote.uuid dest
@ -122,8 +134,8 @@ toPerform dest move key afile fastcheck isthere =
- If the current repository already has the content, it is still removed
- from the remote.
-}
fromStart :: Remote -> Bool -> AssociatedFile -> Key -> CommandStart
fromStart src move afile key
fromStart :: Bool -> AssociatedFile -> Key -> Remote -> CommandStart
fromStart move afile key src
| move = go
| otherwise = stopUnless (not <$> inAnnex key) go
where

View file

@ -19,11 +19,13 @@ import Control.Concurrent
import Control.Concurrent.Async
import Control.Concurrent.STM
cmd :: [Command]
cmd = [noCommit $ command "notifychanges" paramNothing seek SectionPlumbing
"sends notification when git refs are changed"]
cmd :: Command
cmd = noCommit $
command "notifychanges" SectionPlumbing
"sends notification when git refs are changed"
paramNothing (withParams seek)
seek :: CommandSeek
seek :: CmdParams -> CommandSeek
seek = withNothing start
start :: CommandStart

View file

@ -13,11 +13,12 @@ import Command
import Annex.NumCopies
import Types.Messages
cmd :: [Command]
cmd = [command "numcopies" paramNumber seek
SectionSetup "configure desired number of copies"]
cmd :: Command
cmd = command "numcopies" SectionSetup
"configure desired number of copies"
paramNumber (withParams seek)
seek :: CommandSeek
seek :: CmdParams -> CommandSeek
seek = withWords start
start :: [String] -> CommandStart

View file

@ -28,11 +28,13 @@ import qualified Git.LsFiles as Git
import qualified Data.Set as S
cmd :: [Command]
cmd = [command "pre-commit" paramPaths seek SectionPlumbing
"run by git pre-commit hook"]
cmd :: Command
cmd = command "pre-commit" SectionPlumbing
"run by git pre-commit hook"
paramPaths
(withParams seek)
seek :: CommandSeek
seek :: CmdParams -> CommandSeek
seek ps = lockPreCommitHook $ ifM isDirect
( do
-- update direct mode mappings for committed files

View file

@ -17,12 +17,13 @@ import qualified Git.Sha
import qualified Git.Ref
import qualified Git.Branch
cmd :: [Command]
cmd = [notBareRepo $
command "proxy" ("-- git command") seek
SectionPlumbing "safely bypass direct mode guard"]
cmd :: Command
cmd = notBareRepo $
command "proxy" SectionPlumbing
"safely bypass direct mode guard"
("-- git command") (withParams seek)
seek :: CommandSeek
seek :: CmdParams -> CommandSeek
seek = withWords start
start :: [String] -> CommandStart

View file

@ -18,12 +18,14 @@ import Logs.Location
import Utility.CopyFile
import qualified Remote
cmd :: [Command]
cmd = [notDirect $ command "rekey"
(paramOptional $ paramRepeating $ paramPair paramPath paramKey)
seek SectionPlumbing "change keys used for files"]
cmd :: Command
cmd = notDirect $
command "rekey" SectionPlumbing
"change keys used for files"
(paramRepeating $ paramPair paramPath paramKey)
(withParams seek)
seek :: CommandSeek
seek :: CmdParams -> CommandSeek
seek = withPairs start
start :: (FilePath, String) -> CommandStart

View file

@ -12,11 +12,14 @@ import Command
import Logs.Location
import Types.Key
cmd :: [Command]
cmd = [noCommit $ command "readpresentkey" (paramPair paramKey paramUUID) seek
SectionPlumbing "read records of where key is present"]
cmd :: Command
cmd = noCommit $
command "readpresentkey" SectionPlumbing
"read records of where key is present"
(paramPair paramKey paramUUID)
(withParams seek)
seek :: CommandSeek
seek :: CmdParams -> CommandSeek
seek = withWords start
start :: [String] -> CommandStart

View file

@ -20,11 +20,12 @@ import qualified Types.Key
import qualified Types.Backend
import qualified Backend
cmd :: [Command]
cmd = [noCommit $ command "recvkey" paramKey seek
SectionPlumbing "runs rsync in server mode to receive content"]
cmd :: Command
cmd = noCommit $ command "recvkey" SectionPlumbing
"runs rsync in server mode to receive content"
paramKey (withParams seek)
seek :: CommandSeek
seek :: CmdParams -> CommandSeek
seek = withKeys start
start :: Key -> CommandStart

View file

@ -15,12 +15,14 @@ import Logs.Web
import Annex.UUID
import Command.FromKey (mkKey)
cmd :: [Command]
cmd = [notDirect $ notBareRepo $
command "registerurl" (paramPair paramKey paramUrl) seek
SectionPlumbing "registers an url for a key"]
cmd :: Command
cmd = notDirect $ notBareRepo $
command "registerurl"
SectionPlumbing "registers an url for a key"
(paramPair paramKey paramUrl)
(withParams seek)
seek :: CommandSeek
seek :: CmdParams -> CommandSeek
seek = withWords start
start :: [String] -> CommandStart

View file

@ -14,11 +14,14 @@ import Annex.UUID
import Types.UUID
import qualified Remote
cmd :: [Command]
cmd = [dontCheck repoExists $
command "reinit" (paramUUID ++ "|" ++ paramDesc) seek SectionUtility "initialize repository, reusing old UUID"]
cmd :: Command
cmd = dontCheck repoExists $
command "reinit" SectionUtility
"initialize repository, reusing old UUID"
(paramUUID ++ "|" ++ paramDesc)
(withParams seek)
seek :: CommandSeek
seek :: CmdParams -> CommandSeek
seek = withWords start
start :: [String] -> CommandStart

View file

@ -14,11 +14,12 @@ import Annex.Content
import qualified Command.Fsck
import qualified Backend
cmd :: [Command]
cmd = [command "reinject" (paramPair "SRC" "DEST") seek
SectionUtility "sets content of annexed file"]
cmd :: Command
cmd = command "reinject" SectionUtility
"sets content of annexed file"
(paramPair "SRC" "DEST") (withParams seek)
seek :: CommandSeek
seek :: CmdParams -> CommandSeek
seek = withWords start
start :: [FilePath] -> CommandStart

View file

@ -11,11 +11,13 @@ import Common.Annex
import Command
import RemoteDaemon.Core
cmd :: [Command]
cmd = [noCommit $ command "remotedaemon" paramNothing seek SectionPlumbing
"detects when remotes have changed, and fetches from them"]
cmd :: Command
cmd = noCommit $
command "remotedaemon" SectionPlumbing
"detects when remotes have changed, and fetches from them"
paramNothing (withParams seek)
seek :: CommandSeek
seek :: CmdParams -> CommandSeek
seek = withNothing start
start :: CommandStart

View file

@ -16,11 +16,13 @@ import qualified Git.Ref
import Git.Types
import Annex.Version
cmd :: [Command]
cmd = [noCommit $ dontCheck repoExists $
command "repair" paramNothing seek SectionMaintenance "recover broken git repository"]
cmd :: Command
cmd = noCommit $ dontCheck repoExists $
command "repair" SectionMaintenance
"recover broken git repository"
paramNothing (withParams seek)
seek :: CommandSeek
seek :: CmdParams -> CommandSeek
seek = withNothing start
start :: CommandStart

View file

@ -11,7 +11,7 @@ import Command
import Logs.PreferredContent
import qualified Command.Wanted
cmd :: [Command]
cmd :: Command
cmd = Command.Wanted.cmd' "required" "get or set required content expression"
requiredContentMapRaw
requiredContentSet

View file

@ -14,11 +14,12 @@ import Git.Sha
import qualified Git.Branch
import Annex.AutoMerge
cmd :: [Command]
cmd = [command "resolvemerge" paramNothing seek SectionPlumbing
"resolve merge conflicts"]
cmd :: Command
cmd = command "resolvemerge" SectionPlumbing
"resolve merge conflicts"
paramNothing (withParams seek)
seek :: CommandSeek
seek :: CmdParams -> CommandSeek
seek = withNothing start
start :: CommandStart

View file

@ -13,12 +13,14 @@ import Logs.Web
import Annex.UUID
import qualified Remote
cmd :: [Command]
cmd = [notBareRepo $
command "rmurl" (paramPair paramFile paramUrl) seek
SectionCommon "record file is not available at url"]
cmd :: Command
cmd = notBareRepo $
command "rmurl" SectionCommon
"record file is not available at url"
(paramPair paramFile paramUrl)
(withParams seek)
seek :: CommandSeek
seek :: CmdParams -> CommandSeek
seek = withPairs start
start :: (FilePath, String) -> CommandStart

View file

@ -17,11 +17,12 @@ import Types.Messages
import qualified Data.Set as S
cmd :: [Command]
cmd = [command "schedule" (paramPair paramRemote (paramOptional paramExpression)) seek
SectionSetup "get or set scheduled jobs"]
cmd :: Command
cmd = command "schedule" SectionSetup "get or set scheduled jobs"
(paramPair paramRemote (paramOptional paramExpression))
(withParams seek)
seek :: CommandSeek
seek :: CmdParams -> CommandSeek
seek = withWords start
start :: [String] -> CommandStart

View file

@ -11,9 +11,10 @@ import Command
import Types.TrustLevel
import Command.Trust (trustCommand)
cmd :: [Command]
cmd = [command "semitrust" (paramRepeating paramRemote) seek
SectionSetup "return repository to default trust level"]
cmd :: Command
cmd = command "semitrust" SectionSetup
"return repository to default trust level"
(paramRepeating paramRemote) (withParams seek)
seek :: CommandSeek
seek :: CmdParams -> CommandSeek
seek = trustCommand "semitrust" SemiTrusted

View file

@ -16,11 +16,13 @@ import Annex.Transfer
import qualified CmdLine.GitAnnexShell.Fields as Fields
import Utility.Metered
cmd :: [Command]
cmd = [noCommit $ command "sendkey" paramKey seek
SectionPlumbing "runs rsync in server mode to send content"]
cmd :: Command
cmd = noCommit $
command "sendkey" SectionPlumbing
"runs rsync in server mode to send content"
paramKey (withParams seek)
seek :: CommandSeek
seek :: CmdParams -> CommandSeek
seek = withKeys start
start :: Key -> CommandStart

View file

@ -13,11 +13,12 @@ import Logs.Location
import Annex.Content
import Types.Key
cmd :: [Command]
cmd = [command "setkey" (paramPair paramKey paramPath) seek
SectionPlumbing "sets annexed content for a key"]
cmd :: Command
cmd = command "setkey" SectionPlumbing "sets annexed content for a key"
(paramPair paramKey paramPath)
(withParams seek)
seek :: CommandSeek
seek :: CmdParams -> CommandSeek
seek = withWords start
start :: [String] -> CommandStart

View file

@ -13,11 +13,14 @@ import Logs.Location
import Logs.Presence.Pure
import Types.Key
cmd :: [Command]
cmd = [noCommit $ command "setpresentkey" (paramPair paramKey (paramPair paramUUID "[1|0]")) seek
SectionPlumbing "change records of where key is present"]
cmd :: Command
cmd = noCommit $
command "setpresentkey" SectionPlumbing
"change records of where key is present"
(paramPair paramKey (paramPair paramUUID "[1|0]"))
(withParams seek)
seek :: CommandSeek
seek :: CmdParams -> CommandSeek
seek = withWords start
start :: [String] -> CommandStart

View file

@ -16,12 +16,13 @@ import qualified Git.LsFiles as LsFiles
import qualified Git.Ref
import qualified Git
cmd :: [Command]
cmd = [notBareRepo $ noCommit $ noMessages $ withOptions [jsonOption] $
command "status" paramPaths seek SectionCommon
"show the working tree status"]
cmd :: Command
cmd = notBareRepo $ noCommit $ noMessages $ withGlobalOptions [jsonOption] $
command "status" SectionCommon
"show the working tree status"
paramPaths (withParams seek)
seek :: CommandSeek
seek :: CmdParams -> CommandSeek
seek = withWords start
start :: [FilePath] -> CommandStart

View file

@ -51,26 +51,33 @@ import Utility.Bloom
import Control.Concurrent.MVar
import qualified Data.Map as M
cmd :: [Command]
cmd = [withOptions syncOptions $
command "sync" (paramOptional (paramRepeating paramRemote))
seek SectionCommon "synchronize local repository with remotes"]
cmd :: Command
cmd = command "sync" SectionCommon
"synchronize local repository with remotes"
(paramRepeating paramRemote) (seek <$$> optParser)
syncOptions :: [Option]
syncOptions =
[ contentOption
, messageOption
, allOption
]
data SyncOptions = SyncOptions
{ syncWith :: CmdParams
, contentOption :: Bool
, messageOption :: Maybe String
, keyOptions :: Maybe KeyOptions
}
contentOption :: Option
contentOption = flagOption [] "content" "also transfer file contents"
optParser :: CmdParamsDesc -> Parser SyncOptions
optParser desc = SyncOptions
<$> cmdParams desc
<*> switch
( long "content"
<> help "also transfer file contents"
)
<*> optional (strOption
( long "message" <> short 'm' <> metavar "MSG"
<> help "commit message"
))
<*> optional parseAllOption
messageOption :: Option
messageOption = fieldOption ['m'] "message" "MSG" "specify commit message"
seek :: CommandSeek
seek rs = do
seek :: SyncOptions -> CommandSeek
seek o = do
prepMerge
-- There may not be a branch checked out until after the commit,
@ -89,20 +96,20 @@ seek rs = do
)
let withbranch a = a =<< getbranch
remotes <- syncRemotes rs
remotes <- syncRemotes (syncWith o)
let gitremotes = filter Remote.gitSyncableRemote remotes
let dataremotes = filter (not . remoteAnnexIgnore . Remote.gitconfig) remotes
-- Syncing involves many actions, any of which can independently
-- fail, without preventing the others from running.
seekActions $ return $ concat
[ [ commit ]
[ [ commit o ]
, [ withbranch mergeLocal ]
, map (withbranch . pullRemote) gitremotes
, [ mergeAnnex ]
]
whenM (Annex.getFlag $ optionName contentOption) $
whenM (seekSyncContent dataremotes) $
when (contentOption o) $
whenM (seekSyncContent o dataremotes) $
-- Transferring content can take a while,
-- and other changes can be pushed to the git-annex
-- branch on the remotes in the meantime, so pull
@ -150,15 +157,14 @@ syncRemotes rs = ifM (Annex.getState Annex.fast) ( nub <$> pickfast , wanted )
fastest = fromMaybe [] . headMaybe . Remote.byCost
commit :: CommandStart
commit = ifM (annexAutoCommit <$> Annex.getGitConfig)
commit :: SyncOptions -> CommandStart
commit o = ifM (annexAutoCommit <$> Annex.getGitConfig)
( go
, stop
)
where
go = next $ next $ do
commitmessage <- maybe commitMsg return
=<< Annex.getField (optionName messageOption)
commitmessage <- maybe commitMsg return (messageOption o)
showStart "commit" ""
Annex.Branch.commit "update"
ifM isDirect
@ -371,14 +377,16 @@ newer remote b = do
-
- If any file movements were generated, returns true.
-}
seekSyncContent :: [Remote] -> Annex Bool
seekSyncContent rs = do
seekSyncContent :: SyncOptions -> [Remote] -> Annex Bool
seekSyncContent o rs = do
mvar <- liftIO newEmptyMVar
bloom <- ifM (Annex.getFlag "all")
( Just <$> genBloomFilter (seekworktree mvar [])
, seekworktree mvar [] (const noop) >> pure Nothing
)
withKeyOptions' False (seekkeys mvar bloom) (const noop) []
bloom <- case keyOptions o of
Just WantAllKeys -> Just <$> genBloomFilter (seekworktree mvar [])
_ -> seekworktree mvar [] (const noop) >> pure Nothing
withKeyOptions' (keyOptions o) False
(seekkeys mvar bloom)
(const noop)
[]
liftIO $ not <$> isEmptyMVar mvar
where
seekworktree mvar l bloomfeeder = seekHelper LsFiles.inRepo l >>=

View file

@ -1,6 +1,6 @@
{- git-annex command
-
- Copyright 2013 Joey Hess <id@joeyh.name>
- Copyright 2013-2015 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@ -10,28 +10,23 @@ module Command.Test where
import Common
import Command
import Messages
import Types.Test
cmd :: [Command]
cmd = [ noRepo startIO $ dontCheck repoExists $
command "test" paramNothing seek SectionTesting
"run built-in test suite"]
cmd :: Parser TestOptions -> Maybe TestRunner -> Command
cmd optparser runner = noRepo (startIO runner <$$> const optparser) $
dontCheck repoExists $
command "test" SectionTesting
"run built-in test suite"
paramNothing (seek runner <$$> const optparser)
seek :: CommandSeek
seek = withWords start
seek :: Maybe TestRunner -> TestOptions -> CommandSeek
seek runner o = commandAction $ start runner o
{- We don't actually run the test suite here because of a dependency loop.
- The main program notices when the command is test and runs it; this
- function is never run if that works.
-
- However, if git-annex is built without the test suite, just print a
- warning, and do not exit nonzero. This is so git-annex test can be run
- in debian/rules despite some architectures not being able to build the
- test suite.
-}
start :: [String] -> CommandStart
start ps = do
liftIO $ startIO ps
start :: Maybe TestRunner -> TestOptions -> CommandStart
start runner o = do
liftIO $ startIO runner o
stop
startIO :: CmdParams -> IO ()
startIO _ = warningIO "git-annex was built without its test suite; not testing"
startIO :: Maybe TestRunner -> TestOptions -> IO ()
startIO Nothing _ = warningIO "git-annex was built without its test suite; not testing"
startIO (Just runner) o = runner o

View file

@ -27,6 +27,7 @@ import Messages
import Types.Messages
import Remote.Helper.Chunked
import Locations
import Git.Types
import Test.Tasty
import Test.Tasty.Runners
@ -36,25 +37,30 @@ import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import qualified Data.Map as M
cmd :: [Command]
cmd = [ withOptions [sizeOption] $
command "testremote" paramRemote seek SectionTesting
"test transfers to/from a remote"]
cmd :: Command
cmd = command "testremote" SectionTesting
"test transfers to/from a remote"
paramRemote (seek <$$> optParser)
sizeOption :: Option
sizeOption = fieldOption [] "size" paramSize "base key size (default 1MiB)"
data TestRemoteOptions = TestRemoteOptions
{ testRemote :: RemoteName
, sizeOption :: ByteSize
}
seek :: CommandSeek
seek ps = do
basesz <- fromInteger . fromMaybe (1024 * 1024)
<$> getOptionField sizeOption (pure . getsize)
withWords (start basesz) ps
where
getsize v = v >>= readSize dataUnits
optParser :: CmdParamsDesc -> Parser TestRemoteOptions
optParser desc = TestRemoteOptions
<$> argument str ( metavar desc )
<*> option (str >>= maybe (fail "parse error") return . readSize dataUnits)
( long "size" <> metavar paramSize
<> value (1024 * 1024)
<> help "base key size (default 1MiB)"
)
start :: Int -> [String] -> CommandStart
start basesz ws = do
let name = unwords ws
seek :: TestRemoteOptions -> CommandSeek
seek o = commandAction $ start (fromInteger $ sizeOption o) (testRemote o)
start :: Int -> RemoteName -> CommandStart
start basesz name = do
showStart "testremote" name
r <- either error id <$> Remote.byName' name
showSideAction "generating test keys"

View file

@ -15,11 +15,13 @@ import Types.Key
import qualified CmdLine.GitAnnexShell.Fields as Fields
import Utility.Metered
cmd :: [Command]
cmd = [noCommit $ command "transferinfo" paramKey seek SectionPlumbing
"updates sender on number of bytes of content received"]
cmd :: Command
cmd = noCommit $
command "transferinfo" SectionPlumbing
"updates sender on number of bytes of content received"
paramKey (withParams seek)
seek :: CommandSeek
seek :: CmdParams -> CommandSeek
seek = withWords start
{- Security:
@ -47,8 +49,8 @@ start (k:[]) = do
, transferUUID = u
, transferKey = key
}
info <- liftIO $ startTransferInfo file
(update, tfile, _) <- mkProgressUpdater t info
tinfo <- liftIO $ startTransferInfo file
(update, tfile, _) <- mkProgressUpdater t tinfo
liftIO $ mapM_ void
[ tryIO $ forever $ do
bytes <- readUpdate

View file

@ -15,41 +15,51 @@ import Annex.Transfer
import qualified Remote
import Types.Remote
cmd :: [Command]
cmd = [withOptions transferKeyOptions $
noCommit $ command "transferkey" paramKey seek SectionPlumbing
"transfers a key from or to a remote"]
cmd :: Command
cmd = noCommit $
command "transferkey" SectionPlumbing
"transfers a key from or to a remote"
paramKey (seek <--< optParser)
transferKeyOptions :: [Option]
transferKeyOptions = fileOption : fromToOptions
data TransferKeyOptions = TransferKeyOptions
{ keyOptions :: CmdParams
, fromToOptions :: FromToOptions
, fileOption :: AssociatedFile
}
fileOption :: Option
fileOption = fieldOption [] "file" paramFile "the associated file"
optParser :: CmdParamsDesc -> Parser TransferKeyOptions
optParser desc = TransferKeyOptions
<$> cmdParams desc
<*> parseFromToOptions
<*> optional (strOption
( long "file" <> metavar paramFile
<> help "the associated file"
))
seek :: CommandSeek
seek ps = do
to <- getOptionField toOption Remote.byNameWithUUID
from <- getOptionField fromOption Remote.byNameWithUUID
file <- getOptionField fileOption return
withKeys (start to from file) ps
instance DeferredParseClass TransferKeyOptions where
finishParse v = TransferKeyOptions
<$> pure (keyOptions v)
<*> finishParse (fromToOptions v)
<*> pure (fileOption v)
start :: Maybe Remote -> Maybe Remote -> AssociatedFile -> Key -> CommandStart
start to from file key =
case (from, to) of
(Nothing, Just dest) -> next $ toPerform dest key file
(Just src, Nothing) -> next $ fromPerform src key file
_ -> error "specify either --from or --to"
seek :: TransferKeyOptions -> CommandSeek
seek o = withKeys (start o) (keyOptions o)
toPerform :: Remote -> Key -> AssociatedFile -> CommandPerform
toPerform remote key file = go Upload file $
start :: TransferKeyOptions -> Key -> CommandStart
start o key = case fromToOptions o of
ToRemote dest -> next $ toPerform key (fileOption o) =<< getParsed dest
FromRemote src -> next $ fromPerform key (fileOption o) =<< getParsed src
toPerform :: Key -> AssociatedFile -> Remote -> CommandPerform
toPerform key file remote = go Upload file $
upload (uuid remote) key file forwardRetry noObserver $ \p -> do
ok <- Remote.storeKey remote key file p
when ok $
Remote.logStatus remote key InfoPresent
return ok
fromPerform :: Remote -> Key -> AssociatedFile -> CommandPerform
fromPerform remote key file = go Upload file $
fromPerform :: Key -> AssociatedFile -> Remote -> CommandPerform
fromPerform key file remote = go Upload file $
download (uuid remote) key file forwardRetry noObserver $ \p ->
getViaTmp key $ \t -> Remote.retrieveKeyFile remote key file t p

View file

@ -21,11 +21,11 @@ import Git.Types (RemoteName)
data TransferRequest = TransferRequest Direction Remote Key AssociatedFile
cmd :: [Command]
cmd = [command "transferkeys" paramNothing seek
SectionPlumbing "transfers keys"]
cmd :: Command
cmd = command "transferkeys" SectionPlumbing "transfers keys"
paramNothing (withParams seek)
seek :: CommandSeek
seek :: CmdParams -> CommandSeek
seek = withNothing start
start :: CommandStart
@ -45,7 +45,7 @@ start = do
download (Remote.uuid remote) key file forwardRetry observer $ \p ->
getViaTmp key $ \t -> Remote.retrieveKeyFile remote key file t p
observer False t info = recordFailedTransfer t info
observer False t tinfo = recordFailedTransfer t tinfo
observer True _ _ = noop
runRequests
@ -80,14 +80,14 @@ runRequests readh writeh a = do
hFlush writeh
sendRequest :: Transfer -> TransferInfo -> Handle -> IO ()
sendRequest t info h = do
sendRequest t tinfo h = do
hPutStr h $ intercalate fieldSep
[ serialize (transferDirection t)
, maybe (serialize (fromUUID (transferUUID t)))
(serialize . Remote.name)
(transferRemote info)
(transferRemote tinfo)
, serialize (transferKey t)
, serialize (associatedFile info)
, serialize (associatedFile tinfo)
, "" -- adds a trailing null
]
hFlush h

View file

@ -16,14 +16,14 @@ import Logs.Group
import qualified Data.Set as S
cmd :: [Command]
cmd = [command "trust" (paramRepeating paramRemote) seek
SectionSetup "trust a repository"]
cmd :: Command
cmd = command "trust" SectionSetup "trust a repository"
(paramRepeating paramRemote) (withParams seek)
seek :: CommandSeek
seek :: CmdParams -> CommandSeek
seek = trustCommand "trust" Trusted
trustCommand :: String -> TrustLevel -> CommandSeek
trustCommand :: String -> TrustLevel -> CmdParams -> CommandSeek
trustCommand c level = withWords start
where
start ws = do

View file

@ -22,12 +22,13 @@ import qualified Git.DiffTree as DiffTree
import Utility.CopyFile
import Command.PreCommit (lockPreCommitHook)
cmd :: [Command]
cmd = [withOptions annexedMatchingOptions $
command "unannex" paramPaths seek SectionUtility
"undo accidential add command"]
cmd :: Command
cmd = withGlobalOptions annexedMatchingOptions $
command "unannex" SectionUtility
"undo accidential add command"
paramPaths (withParams seek)
seek :: CommandSeek
seek :: CmdParams -> CommandSeek
seek = wrapUnannex . (withFilesInGit $ whenAnnexed start)
wrapUnannex :: Annex a -> Annex a

View file

@ -21,12 +21,13 @@ import qualified Git.Command as Git
import qualified Git.Branch
import qualified Command.Sync
cmd :: [Command]
cmd = [notBareRepo $
command "undo" paramPaths seek
SectionCommon "undo last change to a file or directory"]
cmd :: Command
cmd = notBareRepo $
command "undo" SectionCommon
"undo last change to a file or directory"
paramPaths (withParams seek)
seek :: CommandSeek
seek :: CmdParams -> CommandSeek
seek ps = do
-- Safety first; avoid any undo that would touch files that are not
-- in the index.

View file

@ -15,11 +15,11 @@ import Types.Group
import qualified Data.Set as S
cmd :: [Command]
cmd = [command "ungroup" (paramPair paramRemote paramDesc) seek
SectionSetup "remove a repository from a group"]
cmd :: Command
cmd = command "ungroup" SectionSetup "remove a repository from a group"
(paramPair paramRemote paramDesc) (withParams seek)
seek :: CommandSeek
seek :: CmdParams -> CommandSeek
seek = withWords start
start :: [String] -> CommandStart

View file

@ -21,9 +21,11 @@ import Utility.FileMode
import System.IO.HVFS
import System.IO.HVFS.Utils
cmd :: [Command]
cmd = [addCheck check $ command "uninit" paramPaths seek
SectionUtility "de-initialize git-annex and clean out repository"]
cmd :: Command
cmd = addCheck check $
command "uninit" SectionUtility
"de-initialize git-annex and clean out repository"
paramPaths (withParams seek)
check :: Annex ()
check = do
@ -39,7 +41,7 @@ check = do
revhead = inRepo $ Git.Command.pipeReadStrict
[Param "rev-parse", Param "--abbrev-ref", Param "HEAD"]
seek :: CommandSeek
seek :: CmdParams -> CommandSeek
seek ps = do
withFilesNotInGit False (whenAnnexed startCheckIncomplete) ps
Annex.changeState $ \s -> s { Annex.fast = True }

View file

@ -13,16 +13,17 @@ import Annex.Content
import Annex.CatFile
import Utility.CopyFile
cmd :: [Command]
cmd =
[ c "unlock" "unlock files for modification"
, c "edit" "same as unlock"
]
where
c n = notDirect . withOptions annexedMatchingOptions
. command n paramPaths seek SectionCommon
cmd :: Command
cmd = mkcmd "unlock" "unlock files for modification"
seek :: CommandSeek
editcmd :: Command
editcmd = mkcmd "edit" "same as unlock"
mkcmd :: String -> String -> Command
mkcmd n d = notDirect $ withGlobalOptions annexedMatchingOptions $
command n SectionCommon d paramPaths (withParams seek)
seek :: CmdParams -> CommandSeek
seek = withFilesInGit $ whenAnnexed start
{- The unlock subcommand replaces the symlink with a copy of the file's

View file

@ -11,9 +11,9 @@ import Command
import Types.TrustLevel
import Command.Trust (trustCommand)
cmd :: [Command]
cmd = [command "untrust" (paramRepeating paramRemote) seek
SectionSetup "do not trust a repository"]
cmd :: Command
cmd = command "untrust" SectionSetup "do not trust a repository"
(paramRepeating paramRemote) (withParams seek)
seek :: CommandSeek
seek :: CmdParams -> CommandSeek
seek = trustCommand "untrust" UnTrusted

View file

@ -1,6 +1,6 @@
{- git-annex command
-
- Copyright 2010-2012 Joey Hess <id@joeyh.name>
- Copyright 2010-2015 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@ -31,38 +31,47 @@ import Annex.CatFile
import Types.Key
import Types.RefSpec
import Git.FilePath
import Git.Types
import Logs.View (is_branchView)
import Annex.BloomFilter
cmd :: [Command]
cmd = [withOptions [unusedFromOption, refSpecOption] $
command "unused" paramNothing seek
SectionMaintenance "look for unused file content"]
cmd :: Command
cmd = -- withGlobalOptions [unusedFromOption, refSpecOption] $
command "unused" SectionMaintenance
"look for unused file content"
paramNothing (seek <$$> optParser)
unusedFromOption :: Option
unusedFromOption = fieldOption ['f'] "from" paramRemote "remote to check for unused content"
data UnusedOptions = UnusedOptions
{ fromRemote :: Maybe RemoteName
, refSpecOption :: Maybe RefSpec
}
refSpecOption :: Option
refSpecOption = fieldOption [] "used-refspec" paramRefSpec "refs to consider used (default: all refs)"
optParser :: CmdParamsDesc -> Parser UnusedOptions
optParser _ = UnusedOptions
<$> optional (strOption
( long "from" <> short 'f' <> metavar paramRemote
<> help "remote to check for unused content"
))
<*> optional (option (eitherReader parseRefSpec)
( long "unused-refspec" <> metavar paramRefSpec
<> help "refs to consider used (default: all branches)"
))
seek :: CommandSeek
seek = withNothing start
seek :: UnusedOptions -> CommandSeek
seek = commandAction . start
{- Finds unused content in the annex. -}
start :: CommandStart
start = do
start :: UnusedOptions -> CommandStart
start o = do
cfgrefspec <- fromMaybe allRefSpec . annexUsedRefSpec
<$> Annex.getGitConfig
!refspec <- maybe cfgrefspec (either error id . parseRefSpec)
<$> Annex.getField (optionName refSpecOption)
from <- Annex.getField (optionName unusedFromOption)
let (name, action) = case from of
let refspec = fromMaybe cfgrefspec (refSpecOption o)
let (name, perform) = case fromRemote o of
Nothing -> (".", checkUnused refspec)
Just "." -> (".", checkUnused refspec)
Just "here" -> (".", checkUnused refspec)
Just n -> (n, checkRemoteUnused n refspec)
showStart "unused" name
next action
next perform
checkUnused :: RefSpec -> CommandPerform
checkUnused refspec = chain 0
@ -126,11 +135,11 @@ unusedMsg u = unusedMsg' u
["Some annexed data is no longer used by any files:"]
[dropMsg Nothing]
unusedMsg' :: [(Int, Key)] -> [String] -> [String] -> String
unusedMsg' u header trailer = unlines $
header ++
unusedMsg' u mheader mtrailer = unlines $
mheader ++
table u ++
["(To see where data was previously used, try: git log --stat -S'KEY')"] ++
trailer
mtrailer
remoteUnusedMsg :: Remote -> [(Int, Key)] -> String
remoteUnusedMsg r u = unusedMsg' u
@ -267,7 +276,7 @@ data UnusedMaps = UnusedMaps
, unusedTmpMap :: UnusedMap
}
withUnusedMaps :: (UnusedMaps -> Int -> CommandStart) -> CommandSeek
withUnusedMaps :: (UnusedMaps -> Int -> CommandStart) -> CmdParams -> CommandSeek
withUnusedMaps a params = do
unused <- readUnusedMap ""
unusedbad <- readUnusedMap "bad"

View file

@ -11,12 +11,12 @@ import Common.Annex
import Command
import Upgrade
cmd :: [Command]
cmd = [dontCheck repoExists $ -- because an old version may not seem to exist
command "upgrade" paramNothing seek
SectionMaintenance "upgrade repository layout"]
cmd :: Command
cmd = dontCheck repoExists $ -- because an old version may not seem to exist
command "upgrade" SectionMaintenance "upgrade repository layout"
paramNothing (withParams seek)
seek :: CommandSeek
seek :: CmdParams -> CommandSeek
seek = withNothing start
start :: CommandStart

View file

@ -12,11 +12,14 @@ import Command
import Annex.View
import Command.View (checkoutViewBranch)
cmd :: [Command]
cmd = [notBareRepo $ notDirect $ command "vadd" (paramRepeating "FIELD=GLOB")
seek SectionMetaData "add subdirs to current view"]
cmd :: Command
cmd = notBareRepo $ notDirect $
command "vadd" SectionMetaData
"add subdirs to current view"
(paramRepeating "FIELD=GLOB")
(withParams seek)
seek :: CommandSeek
seek :: CmdParams -> CommandSeek
seek = withWords start
start :: [String] -> CommandStart

View file

@ -14,12 +14,13 @@ import Types.View
import Logs.View
import Command.View (checkoutViewBranch)
cmd :: [Command]
cmd = [notBareRepo $ notDirect $
command "vcycle" paramNothing seek SectionMetaData
"switch view to next layout"]
cmd :: Command
cmd = notBareRepo $ notDirect $
command "vcycle" SectionMetaData
"switch view to next layout"
paramNothing (withParams seek)
seek :: CommandSeek
seek :: CmdParams -> CommandSeek
seek = withNothing start
start ::CommandStart

View file

@ -12,11 +12,12 @@ import Command
import Annex.View
import Command.View (paramView, checkoutViewBranch)
cmd :: [Command]
cmd = [notBareRepo $ notDirect $
command "vfilter" paramView seek SectionMetaData "filter current view"]
cmd :: Command
cmd = notBareRepo $ notDirect $
command "vfilter" SectionMetaData "filter current view"
paramView (withParams seek)
seek :: CommandSeek
seek :: CmdParams -> CommandSeek
seek = withWords start
start :: [String] -> CommandStart

Some files were not shown because too many files have changed in this diff Show more