convert Unused, and remove some dead code for old style option parsing
This commit is contained in:
		
					parent
					
						
							
								4064dd4c82
							
						
					
				
			
			
				commit
				
					
						160d4b9fe0
					
				
			
		
					 4 changed files with 26 additions and 54 deletions
				
			
		| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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."
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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)
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue