diff options
| -rw-r--r-- | CmdLine/GitAnnex.hs | 4 | ||||
| -rw-r--r-- | CmdLine/Option.hs | 28 | ||||
| -rw-r--r-- | CmdLine/Seek.hs | 10 | ||||
| -rw-r--r-- | Command/Unused.hs | 38 |
4 files changed, 26 insertions, 54 deletions
diff --git a/CmdLine/GitAnnex.hs b/CmdLine/GitAnnex.hs index 81b9cd3d6..7119d1455 100644 --- a/CmdLine/GitAnnex.hs +++ b/CmdLine/GitAnnex.hs @@ -50,7 +50,7 @@ import qualified Command.InitRemote import qualified Command.EnableRemote --import qualified Command.Expire import qualified Command.Repair ---import qualified Command.Unused +import qualified Command.Unused --import qualified Command.DropUnused import qualified Command.AddUnused import qualified Command.Unlock @@ -180,7 +180,7 @@ cmds = , Command.Fix.cmd -- , Command.Expire.cmd , Command.Repair.cmd --- , Command.Unused.cmd + , Command.Unused.cmd -- , Command.DropUnused.cmd , Command.AddUnused.cmd , Command.Find.cmd diff --git a/CmdLine/Option.hs b/CmdLine/Option.hs index 9f2353f98..4e201cbd4 100644 --- a/CmdLine/Option.hs +++ b/CmdLine/Option.hs @@ -5,18 +5,9 @@ - Licensed under the GNU GPL version 3 or higher. -} -module CmdLine.Option ( - commonGlobalOptions, - flagOption, - fieldOption, - optionName, - optionParam, - ArgDescr(..), - OptDescr(..), -) where +module CmdLine.Option where import Options.Applicative -import System.Console.GetOpt import Common.Annex import CmdLine.Usage @@ -70,20 +61,3 @@ commonGlobalOptions = setforcebackend v = Annex.changeState $ \s -> s { Annex.forcebackend = Just v } setdebug = Annex.changeGitConfig $ \c -> c { annexDebug = True } unsetdebug = Annex.changeGitConfig $ \c -> c { annexDebug = False } - -{- An option that sets a flag. -} -flagOption :: String -> String -> String -> Option -flagOption shortv opt description = - Option shortv [opt] (NoArg (Annex.setFlag opt)) description - -{- An option that sets a field. -} -fieldOption :: String -> String -> String -> String -> Option -fieldOption shortv opt paramdesc description = - Option shortv [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 diff --git a/CmdLine/Seek.hs b/CmdLine/Seek.hs index b40e0d17a..e67c3b908 100644 --- a/CmdLine/Seek.hs +++ b/CmdLine/Seek.hs @@ -22,7 +22,6 @@ 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 @@ -152,15 +151,6 @@ 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 -> CmdParams -> CommandSeek withNothing a [] = seekActions $ return [a] withNothing _ _ = error "This command takes no parameters." diff --git a/Command/Unused.hs b/Command/Unused.hs index c2ca148b7..a383d567b 100644 --- a/Command/Unused.hs +++ b/Command/Unused.hs @@ -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,6 +31,7 @@ import Annex.CatFile import Types.Key import Types.RefSpec import Git.FilePath +import Git.Types import Logs.View (is_branchView) import Annex.BloomFilter @@ -38,26 +39,33 @@ cmd :: Command cmd = -- withGlobalOptions [unusedFromOption, refSpecOption] $ command "unused" SectionMaintenance "look for unused file content" - paramNothing (withParams seek) + 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 :: CmdParams -> 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, perform) = 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) |