tweak
This commit is contained in:
parent
df21cbfdd2
commit
1f8a1058c9
14 changed files with 62 additions and 47 deletions
|
@ -30,7 +30,6 @@ import Types.Command as ReExported
|
||||||
import Types.Option as ReExported
|
import Types.Option as ReExported
|
||||||
import Seek as ReExported
|
import Seek as ReExported
|
||||||
import Checks as ReExported
|
import Checks as ReExported
|
||||||
import Options as ReExported
|
|
||||||
import Usage as ReExported
|
import Usage as ReExported
|
||||||
import Logs.Trust
|
import Logs.Trust
|
||||||
import Logs.Location
|
import Logs.Location
|
||||||
|
|
|
@ -17,8 +17,8 @@ def = [withOptions Command.Move.options $ command "copy" paramPaths seek
|
||||||
"copy content of files to/from another repository"]
|
"copy content of files to/from another repository"]
|
||||||
|
|
||||||
seek :: [CommandSeek]
|
seek :: [CommandSeek]
|
||||||
seek = [withField "to" Remote.byName $ \to ->
|
seek = [withField Command.Move.toOption Remote.byName $ \to ->
|
||||||
withField "from" Remote.byName $ \from ->
|
withField Command.Move.fromOption Remote.byName $ \from ->
|
||||||
withNumCopies $ \n -> whenAnnexed $ start to from n]
|
withNumCopies $ \n -> whenAnnexed $ start to from n]
|
||||||
|
|
||||||
-- A copy is just a move that does not delete the source file.
|
-- A copy is just a move that does not delete the source file.
|
||||||
|
|
|
@ -16,16 +16,17 @@ import Logs.Location
|
||||||
import Logs.Trust
|
import Logs.Trust
|
||||||
import Annex.Content
|
import Annex.Content
|
||||||
import Config
|
import Config
|
||||||
|
import qualified Option
|
||||||
|
|
||||||
def :: [Command]
|
def :: [Command]
|
||||||
def = [withOptions [fromOption] $ command "drop" paramPaths seek
|
def = [withOptions [fromOption] $ command "drop" paramPaths seek
|
||||||
"indicate content of files not currently wanted"]
|
"indicate content of files not currently wanted"]
|
||||||
|
|
||||||
fromOption :: Option
|
fromOption :: Option
|
||||||
fromOption = fieldOption ['f'] "from" paramRemote "drop content from a remote"
|
fromOption = Option.field ['f'] "from" paramRemote "drop content from a remote"
|
||||||
|
|
||||||
seek :: [CommandSeek]
|
seek :: [CommandSeek]
|
||||||
seek = [withField "from" Remote.byName $ \from -> withNumCopies $ \n ->
|
seek = [withField fromOption Remote.byName $ \from -> withNumCopies $ \n ->
|
||||||
whenAnnexed $ start from n]
|
whenAnnexed $ start from n]
|
||||||
|
|
||||||
start :: Maybe Remote -> Maybe Int -> FilePath -> (Key, Backend) -> CommandStart
|
start :: Maybe Remote -> Maybe Int -> FilePath -> (Key, Backend) -> CommandStart
|
||||||
|
|
|
@ -15,6 +15,7 @@ import qualified Annex
|
||||||
import qualified Command.Drop
|
import qualified Command.Drop
|
||||||
import qualified Remote
|
import qualified Remote
|
||||||
import qualified Git
|
import qualified Git
|
||||||
|
import qualified Option
|
||||||
import Types.Key
|
import Types.Key
|
||||||
|
|
||||||
type UnusedMap = M.Map String Key
|
type UnusedMap = M.Map String Key
|
||||||
|
@ -51,13 +52,14 @@ start (unused, unusedbad, unusedtmp) s = search
|
||||||
next $ a key
|
next $ a key
|
||||||
|
|
||||||
perform :: Key -> CommandPerform
|
perform :: Key -> CommandPerform
|
||||||
perform key = maybe droplocal dropremote =<< Remote.byName =<< Annex.getField "from"
|
perform key = maybe droplocal dropremote =<< Remote.byName =<< from
|
||||||
where
|
where
|
||||||
dropremote r = do
|
dropremote r = do
|
||||||
showAction $ "from " ++ Remote.name r
|
showAction $ "from " ++ Remote.name r
|
||||||
ok <- Remote.removeKey r key
|
ok <- Remote.removeKey r key
|
||||||
next $ Command.Drop.cleanupRemote key r ok
|
next $ Command.Drop.cleanupRemote key r ok
|
||||||
droplocal = Command.Drop.performLocal key (Just 0) -- force drop
|
droplocal = Command.Drop.performLocal key (Just 0) -- force drop
|
||||||
|
from = Annex.getField $ Option.name Command.Drop.fromOption
|
||||||
|
|
||||||
performOther :: (Key -> Git.Repo -> FilePath) -> Key -> CommandPerform
|
performOther :: (Key -> Git.Repo -> FilePath) -> Key -> CommandPerform
|
||||||
performOther filespec key = do
|
performOther filespec key = do
|
||||||
|
|
|
@ -17,20 +17,23 @@ import qualified Annex
|
||||||
import qualified Utility.Format
|
import qualified Utility.Format
|
||||||
import Utility.DataUnits
|
import Utility.DataUnits
|
||||||
import Types.Key
|
import Types.Key
|
||||||
|
import qualified Option
|
||||||
|
|
||||||
def :: [Command]
|
def :: [Command]
|
||||||
def = [withOptions [formatOption, print0Option] $
|
def = [withOptions [formatOption, print0Option] $
|
||||||
command "find" paramPaths seek "lists available files"]
|
command "find" paramPaths seek "lists available files"]
|
||||||
|
|
||||||
print0Option :: Option
|
|
||||||
print0Option = Option [] ["print0"] (NoArg $ Annex.setField "format" "${file}\0")
|
|
||||||
"terminate output with null"
|
|
||||||
|
|
||||||
formatOption :: Option
|
formatOption :: Option
|
||||||
formatOption = fieldOption [] "format" paramFormat "control format of output"
|
formatOption = Option.field [] "format" paramFormat "control format of output"
|
||||||
|
|
||||||
|
print0Option :: Option
|
||||||
|
print0Option = Option.Option [] ["print0"] (Option.NoArg set)
|
||||||
|
"terminate output with null"
|
||||||
|
where
|
||||||
|
set = Annex.setField (Option.name formatOption) "${file}\0"
|
||||||
|
|
||||||
seek :: [CommandSeek]
|
seek :: [CommandSeek]
|
||||||
seek = [withField "format" formatconverter $ \f ->
|
seek = [withField formatOption formatconverter $ \f ->
|
||||||
withFilesInGit $ whenAnnexed $ start f]
|
withFilesInGit $ whenAnnexed $ start f]
|
||||||
where
|
where
|
||||||
formatconverter = return . maybe Nothing (Just . Utility.Format.gen)
|
formatconverter = return . maybe Nothing (Just . Utility.Format.gen)
|
||||||
|
|
|
@ -18,8 +18,8 @@ def = [withOptions [Command.Move.fromOption] $ command "get" paramPaths seek
|
||||||
"make content of annexed files available"]
|
"make content of annexed files available"]
|
||||||
|
|
||||||
seek :: [CommandSeek]
|
seek :: [CommandSeek]
|
||||||
seek = [withField "from" Remote.byName $ \from -> withNumCopies $ \n ->
|
seek = [withField Command.Move.fromOption Remote.byName $ \from ->
|
||||||
whenAnnexed $ start from n]
|
withNumCopies $ \n -> whenAnnexed $ start from n]
|
||||||
|
|
||||||
start :: Maybe Remote -> Maybe Int -> FilePath -> (Key, Backend) -> CommandStart
|
start :: Maybe Remote -> Maybe Int -> FilePath -> (Key, Backend) -> CommandStart
|
||||||
start from numcopies file (key, _) = stopUnless (not <$> inAnnex key) $
|
start from numcopies file (key, _) = stopUnless (not <$> inAnnex key) $
|
||||||
|
|
|
@ -14,23 +14,24 @@ import qualified Annex
|
||||||
import Annex.Content
|
import Annex.Content
|
||||||
import qualified Remote
|
import qualified Remote
|
||||||
import Annex.UUID
|
import Annex.UUID
|
||||||
|
import qualified Option
|
||||||
|
|
||||||
def :: [Command]
|
def :: [Command]
|
||||||
def = [withOptions options $ command "move" paramPaths seek
|
def = [withOptions options $ command "move" paramPaths seek
|
||||||
"move content of files to/from another repository"]
|
"move content of files to/from another repository"]
|
||||||
|
|
||||||
fromOption :: Option
|
fromOption :: Option
|
||||||
fromOption = fieldOption ['f'] "from" paramRemote "source remote"
|
fromOption = Option.field ['f'] "from" paramRemote "source remote"
|
||||||
|
|
||||||
toOption :: Option
|
toOption :: Option
|
||||||
toOption = fieldOption ['t'] "to" paramRemote "destination remote"
|
toOption = Option.field ['t'] "to" paramRemote "destination remote"
|
||||||
|
|
||||||
options :: [Option]
|
options :: [Option]
|
||||||
options = [fromOption, toOption]
|
options = [fromOption, toOption]
|
||||||
|
|
||||||
seek :: [CommandSeek]
|
seek :: [CommandSeek]
|
||||||
seek = [withField "to" Remote.byName $ \to ->
|
seek = [withField toOption Remote.byName $ \to ->
|
||||||
withField "from" Remote.byName $ \from ->
|
withField fromOption Remote.byName $ \from ->
|
||||||
withFilesInGit $ whenAnnexed $ start to from True]
|
withFilesInGit $ whenAnnexed $ start to from True]
|
||||||
|
|
||||||
start :: Maybe Remote -> Maybe Remote -> Bool -> FilePath -> (Key, Backend) -> CommandStart
|
start :: Maybe Remote -> Maybe Remote -> Bool -> FilePath -> (Key, Backend) -> CommandStart
|
||||||
|
|
|
@ -27,6 +27,7 @@ import qualified Git.LsTree as LsTree
|
||||||
import qualified Backend
|
import qualified Backend
|
||||||
import qualified Remote
|
import qualified Remote
|
||||||
import qualified Annex.Branch
|
import qualified Annex.Branch
|
||||||
|
import qualified Option
|
||||||
import Annex.CatFile
|
import Annex.CatFile
|
||||||
|
|
||||||
def :: [Command]
|
def :: [Command]
|
||||||
|
@ -34,7 +35,7 @@ def = [withOptions [fromOption] $ command "unused" paramNothing seek
|
||||||
"look for unused file content"]
|
"look for unused file content"]
|
||||||
|
|
||||||
fromOption :: Option
|
fromOption :: Option
|
||||||
fromOption = fieldOption ['f'] "from" paramRemote "remote to check for unused content"
|
fromOption = Option.field ['f'] "from" paramRemote "remote to check for unused content"
|
||||||
|
|
||||||
seek :: [CommandSeek]
|
seek :: [CommandSeek]
|
||||||
seek = [withNothing $ start]
|
seek = [withNothing $ start]
|
||||||
|
@ -42,7 +43,7 @@ seek = [withNothing $ start]
|
||||||
{- Finds unused content in the annex. -}
|
{- Finds unused content in the annex. -}
|
||||||
start :: CommandStart
|
start :: CommandStart
|
||||||
start = do
|
start = do
|
||||||
from <- Annex.getField "from"
|
from <- Annex.getField $ Option.name fromOption
|
||||||
let (name, action) = case from of
|
let (name, action) = case from of
|
||||||
Nothing -> (".", checkUnused)
|
Nothing -> (".", checkUnused)
|
||||||
Just "." -> (".", checkUnused)
|
Just "." -> (".", checkUnused)
|
||||||
|
|
|
@ -18,6 +18,7 @@ import Types.TrustLevel
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
import qualified Remote
|
import qualified Remote
|
||||||
import qualified Limit
|
import qualified Limit
|
||||||
|
import qualified Option
|
||||||
|
|
||||||
import qualified Command.Add
|
import qualified Command.Add
|
||||||
import qualified Command.Unannex
|
import qualified Command.Unannex
|
||||||
|
@ -93,7 +94,7 @@ cmds = concat
|
||||||
]
|
]
|
||||||
|
|
||||||
options :: [Option]
|
options :: [Option]
|
||||||
options = commonOptions ++
|
options = Option.common ++
|
||||||
[ Option ['N'] ["numcopies"] (ReqArg setnumcopies paramNumber)
|
[ Option ['N'] ["numcopies"] (ReqArg setnumcopies paramNumber)
|
||||||
"override default number of copies"
|
"override default number of copies"
|
||||||
, Option [] ["trust"] (ReqArg (Remote.forceTrust Trusted) paramRemote)
|
, Option [] ["trust"] (ReqArg (Remote.forceTrust Trusted) paramRemote)
|
||||||
|
@ -114,7 +115,7 @@ options = commonOptions ++
|
||||||
"skip files with fewer copies"
|
"skip files with fewer copies"
|
||||||
, Option ['B'] ["inbackend"] (ReqArg Limit.addInBackend paramName)
|
, Option ['B'] ["inbackend"] (ReqArg Limit.addInBackend paramName)
|
||||||
"skip files not using a key-value backend"
|
"skip files not using a key-value backend"
|
||||||
] ++ matcherOptions
|
] ++ Option.matcher
|
||||||
where
|
where
|
||||||
setnumcopies v = Annex.changeState $ \s -> s {Annex.forcenumcopies = readMaybe v }
|
setnumcopies v = Annex.changeState $ \s -> s {Annex.forcenumcopies = readMaybe v }
|
||||||
setgitconfig :: String -> Annex ()
|
setgitconfig :: String -> Annex ()
|
||||||
|
|
|
@ -5,13 +5,13 @@
|
||||||
- Licensed under the GNU GPL version 3 or higher.
|
- Licensed under the GNU GPL version 3 or higher.
|
||||||
-}
|
-}
|
||||||
|
|
||||||
module Options (
|
module Option (
|
||||||
commonOptions,
|
common,
|
||||||
matcherOptions,
|
matcher,
|
||||||
flagOption,
|
flag,
|
||||||
fieldOption,
|
field,
|
||||||
|
name,
|
||||||
ArgDescr(..),
|
ArgDescr(..),
|
||||||
Option,
|
|
||||||
OptDescr(..),
|
OptDescr(..),
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
@ -21,11 +21,10 @@ import System.Log.Logger
|
||||||
import Common.Annex
|
import Common.Annex
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
import Limit
|
import Limit
|
||||||
import Types.Option
|
|
||||||
import Usage
|
import Usage
|
||||||
|
|
||||||
commonOptions :: [Option]
|
common :: [Option]
|
||||||
commonOptions =
|
common =
|
||||||
[ Option [] ["force"] (NoArg (setforce True))
|
[ Option [] ["force"] (NoArg (setforce True))
|
||||||
"allow actions that may lose annexed data"
|
"allow actions that may lose annexed data"
|
||||||
, Option ['F'] ["fast"] (NoArg (setfast True))
|
, Option ['F'] ["fast"] (NoArg (setfast True))
|
||||||
|
@ -51,9 +50,9 @@ commonOptions =
|
||||||
setforcebackend v = Annex.changeState $ \s -> s { Annex.forcebackend = Just v }
|
setforcebackend v = Annex.changeState $ \s -> s { Annex.forcebackend = Just v }
|
||||||
setdebug = liftIO $ updateGlobalLogger rootLoggerName $
|
setdebug = liftIO $ updateGlobalLogger rootLoggerName $
|
||||||
setLevel DEBUG
|
setLevel DEBUG
|
||||||
|
|
||||||
matcherOptions :: [Option]
|
matcher :: [Option]
|
||||||
matcherOptions =
|
matcher =
|
||||||
[ longopt "not" "negate next option"
|
[ longopt "not" "negate next option"
|
||||||
, longopt "and" "both previous and next option must match"
|
, longopt "and" "both previous and next option must match"
|
||||||
, longopt "or" "either previous or next option must match"
|
, longopt "or" "either previous or next option must match"
|
||||||
|
@ -65,11 +64,16 @@ matcherOptions =
|
||||||
shortopt o = Option o [] $ NoArg $ addToken o
|
shortopt o = Option o [] $ NoArg $ addToken o
|
||||||
|
|
||||||
{- An option that sets a flag. -}
|
{- An option that sets a flag. -}
|
||||||
flagOption :: String -> String -> String -> Option
|
flag :: String -> String -> String -> Option
|
||||||
flagOption short flag description =
|
flag short opt description =
|
||||||
Option short [flag] (NoArg (Annex.setFlag flag)) description
|
Option short [opt] (NoArg (Annex.setFlag opt)) description
|
||||||
|
|
||||||
{- An option that sets a field. -}
|
{- An option that sets a field. -}
|
||||||
fieldOption :: String -> String -> String -> String -> Option
|
field :: String -> String -> String -> String -> Option
|
||||||
fieldOption short field paramdesc description =
|
field short opt paramdesc description =
|
||||||
Option short [field] (ReqArg (Annex.setField field) paramdesc) description
|
Option short [opt] (ReqArg (Annex.setField opt) paramdesc) description
|
||||||
|
|
||||||
|
{- The flag or field name used for an option. -}
|
||||||
|
name :: Option -> String
|
||||||
|
name (Option _ o _ _) = Prelude.head o
|
||||||
|
|
9
Seek.hs
9
Seek.hs
|
@ -20,6 +20,7 @@ import qualified Git
|
||||||
import qualified Git.LsFiles as LsFiles
|
import qualified Git.LsFiles as LsFiles
|
||||||
import qualified Git.CheckAttr
|
import qualified Git.CheckAttr
|
||||||
import qualified Limit
|
import qualified Limit
|
||||||
|
import qualified Option
|
||||||
|
|
||||||
seekHelper :: ([FilePath] -> Git.Repo -> IO [FilePath]) -> [FilePath] -> Annex [FilePath]
|
seekHelper :: ([FilePath] -> Git.Repo -> IO [FilePath]) -> [FilePath] -> Annex [FilePath]
|
||||||
seekHelper a params = do
|
seekHelper a params = do
|
||||||
|
@ -87,13 +88,13 @@ withKeys a params = return $ map (a . parse) params
|
||||||
where
|
where
|
||||||
parse p = fromMaybe (error "bad key") $ readKey p
|
parse p = fromMaybe (error "bad key") $ readKey p
|
||||||
|
|
||||||
{- Modifies a seek action using the value of a field, which is fed into
|
{- Modifies a seek action using the value of a field option, which is fed into
|
||||||
- a conversion function, and then is passed into the seek action.
|
- a conversion function, and then is passed into the seek action.
|
||||||
- This ensures that the conversion function only runs once.
|
- This ensures that the conversion function only runs once.
|
||||||
-}
|
-}
|
||||||
withField :: String -> (Maybe String -> Annex a) -> (a -> CommandSeek) -> CommandSeek
|
withField :: Option -> (Maybe String -> Annex a) -> (a -> CommandSeek) -> CommandSeek
|
||||||
withField field converter a ps = do
|
withField option converter a ps = do
|
||||||
f <- converter =<< Annex.getField field
|
f <- converter =<< Annex.getField (Option.name option)
|
||||||
a f ps
|
a f ps
|
||||||
|
|
||||||
withNothing :: CommandStart -> CommandSeek
|
withNothing :: CommandStart -> CommandSeek
|
||||||
|
|
4
Types.hs
4
Types.hs
|
@ -11,7 +11,8 @@ module Types (
|
||||||
Key,
|
Key,
|
||||||
UUID(..),
|
UUID(..),
|
||||||
Remote,
|
Remote,
|
||||||
RemoteType
|
RemoteType,
|
||||||
|
Option
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Annex
|
import Annex
|
||||||
|
@ -19,6 +20,7 @@ import Types.Backend
|
||||||
import Types.Key
|
import Types.Key
|
||||||
import Types.UUID
|
import Types.UUID
|
||||||
import Types.Remote
|
import Types.Remote
|
||||||
|
import Types.Option
|
||||||
|
|
||||||
type Backend = BackendA Annex
|
type Backend = BackendA Annex
|
||||||
type Remote = RemoteA Annex
|
type Remote = RemoteA Annex
|
||||||
|
|
|
@ -8,7 +8,6 @@
|
||||||
module Types.Command where
|
module Types.Command where
|
||||||
|
|
||||||
import Types
|
import Types
|
||||||
import Types.Option
|
|
||||||
|
|
||||||
{- A command runs in these stages.
|
{- A command runs in these stages.
|
||||||
-
|
-
|
||||||
|
|
|
@ -13,6 +13,7 @@ import qualified Git.Construct
|
||||||
import CmdLine
|
import CmdLine
|
||||||
import Command
|
import Command
|
||||||
import Annex.UUID
|
import Annex.UUID
|
||||||
|
import qualified Option
|
||||||
|
|
||||||
import qualified Command.ConfigList
|
import qualified Command.ConfigList
|
||||||
import qualified Command.InAnnex
|
import qualified Command.InAnnex
|
||||||
|
@ -41,7 +42,7 @@ cmds = map adddirparam $ cmds_readonly ++ cmds_notreadonly
|
||||||
}
|
}
|
||||||
|
|
||||||
options :: [OptDescr (Annex ())]
|
options :: [OptDescr (Annex ())]
|
||||||
options = commonOptions ++
|
options = Option.common ++
|
||||||
[ Option [] ["uuid"] (ReqArg checkuuid paramUUID) "repository uuid"
|
[ Option [] ["uuid"] (ReqArg checkuuid paramUUID) "repository uuid"
|
||||||
]
|
]
|
||||||
where
|
where
|
||||||
|
|
Loading…
Reference in a new issue