When not run in a git repository, git-annex can still display a usage message, and "git annex version" even works.
Things that sound simple, but are made hard by the Annex monad being built with the assumption that there will always be a git repo.
This commit is contained in:
		
					parent
					
						
							
								84784e2ca1
							
						
					
				
			
			
				commit
				
					
						2bb6b02948
					
				
			
		
					 9 changed files with 38 additions and 18 deletions
				
			
		
							
								
								
									
										16
									
								
								CmdLine.hs
									
										
									
									
									
								
							
							
						
						
									
										16
									
								
								CmdLine.hs
									
										
									
									
									
								
							|  | @ -11,7 +11,9 @@ module CmdLine ( | ||||||
| 	shutdown | 	shutdown | ||||||
| ) where | ) where | ||||||
| 
 | 
 | ||||||
| import System.IO.Error (try) | import qualified System.IO.Error as IO | ||||||
|  | import qualified Control.Exception as E | ||||||
|  | import Control.Exception (throw) | ||||||
| import System.Console.GetOpt | import System.Console.GetOpt | ||||||
| 
 | 
 | ||||||
| import Common.Annex | import Common.Annex | ||||||
|  | @ -25,10 +27,14 @@ type Params = [String] | ||||||
| type Flags = [Annex ()] | type Flags = [Annex ()] | ||||||
| 
 | 
 | ||||||
| {- Runs the passed command line. -} | {- Runs the passed command line. -} | ||||||
| dispatch :: Params -> [Command] -> [Option] -> String -> Git.Repo -> IO () | dispatch :: Params -> [Command] -> [Option] -> String -> IO Git.Repo -> IO () | ||||||
| dispatch args cmds options header gitrepo = do | dispatch args cmds options header getgitrepo = do | ||||||
| 	setupConsole | 	setupConsole | ||||||
| 	state <- Annex.new gitrepo | 	r <- E.try getgitrepo :: IO (Either E.SomeException Git.Repo) | ||||||
|  | 	case r of | ||||||
|  | 		Left e -> maybe (throw e) id (cmdnorepo cmd) | ||||||
|  | 		Right g -> do | ||||||
|  | 			state <- Annex.new g | ||||||
| 			(actions, state') <- Annex.run state $ do | 			(actions, state') <- Annex.run state $ do | ||||||
| 				sequence_ flags | 				sequence_ flags | ||||||
| 				prepCommand cmd params | 				prepCommand cmd params | ||||||
|  | @ -77,7 +83,7 @@ tryRun' errnum _ cmd [] | ||||||
| 	| otherwise = return () | 	| otherwise = return () | ||||||
| tryRun' errnum state cmd (a:as) = run >>= handle | tryRun' errnum state cmd (a:as) = run >>= handle | ||||||
| 	where | 	where | ||||||
| 		run = try $ Annex.run state $ do | 		run = IO.try $ Annex.run state $ do | ||||||
| 			Annex.Queue.flushWhenFull | 			Annex.Queue.flushWhenFull | ||||||
| 			a | 			a | ||||||
| 		handle (Left err) = showerr err >> cont False state | 		handle (Left err) = showerr err >> cont False state | ||||||
|  |  | ||||||
							
								
								
									
										10
									
								
								Command.hs
									
										
									
									
									
								
							
							
						
						
									
										10
									
								
								Command.hs
									
										
									
									
									
								
							|  | @ -7,6 +7,7 @@ | ||||||
| 
 | 
 | ||||||
| module Command ( | module Command ( | ||||||
| 	command, | 	command, | ||||||
|  | 	noRepo, | ||||||
| 	next, | 	next, | ||||||
| 	stop, | 	stop, | ||||||
| 	prepCommand, | 	prepCommand, | ||||||
|  | @ -31,9 +32,14 @@ import Logs.Trust | ||||||
| import Logs.Location | import Logs.Location | ||||||
| import Config | import Config | ||||||
| 
 | 
 | ||||||
| {- Generates a command with the common checks. -} | {- Generates a normal command -} | ||||||
| command :: String -> String -> [CommandSeek] -> String -> Command | command :: String -> String -> [CommandSeek] -> String -> Command | ||||||
| command = Command commonChecks | command = Command Nothing commonChecks | ||||||
|  | 
 | ||||||
|  | {- Adds a fallback action to a command, that will be run if it's used | ||||||
|  |  - outside a git repository. -} | ||||||
|  | noRepo :: IO () -> Command -> Command | ||||||
|  | noRepo a c = c { cmdnorepo = Just a } | ||||||
| 
 | 
 | ||||||
| {- For start and perform stages to indicate what step to run next. -} | {- For start and perform stages to indicate what step to run next. -} | ||||||
| next :: a -> Annex (Maybe a) | next :: a -> Annex (Maybe a) | ||||||
|  |  | ||||||
|  | @ -13,7 +13,7 @@ import qualified Build.SysConfig as SysConfig | ||||||
| import Annex.Version | import Annex.Version | ||||||
| 
 | 
 | ||||||
| def :: [Command] | def :: [Command] | ||||||
| def = [dontCheck repoExists $ | def = [noRepo showPackageVersion $ dontCheck repoExists $ | ||||||
| 	command "version" paramNothing seek "show version info"] | 	command "version" paramNothing seek "show version info"] | ||||||
| 
 | 
 | ||||||
| seek :: [CommandSeek] | seek :: [CommandSeek] | ||||||
|  | @ -23,7 +23,7 @@ start :: CommandStart | ||||||
| start = do | start = do | ||||||
| 	v <- getVersion | 	v <- getVersion | ||||||
| 	liftIO $ do | 	liftIO $ do | ||||||
| 		putStrLn $ "git-annex version: " ++ SysConfig.packageversion | 		showPackageVersion | ||||||
| 		putStrLn $ "local repository version: " ++ fromMaybe "unknown" v | 		putStrLn $ "local repository version: " ++ fromMaybe "unknown" v | ||||||
| 		putStrLn $ "default repository version: " ++ defaultVersion | 		putStrLn $ "default repository version: " ++ defaultVersion | ||||||
| 		putStrLn $ "supported repository versions: " ++ vs supportedVersions | 		putStrLn $ "supported repository versions: " ++ vs supportedVersions | ||||||
|  | @ -31,3 +31,6 @@ start = do | ||||||
| 	stop | 	stop | ||||||
| 	where | 	where | ||||||
| 		vs = join " " | 		vs = join " " | ||||||
|  | 
 | ||||||
|  | showPackageVersion :: IO () | ||||||
|  | showPackageVersion = putStrLn $ "git-annex version: " ++ SysConfig.packageversion | ||||||
|  |  | ||||||
|  | @ -123,4 +123,4 @@ header :: String | ||||||
| header = "Usage: git-annex command [option ..]" | header = "Usage: git-annex command [option ..]" | ||||||
| 
 | 
 | ||||||
| run :: [String] -> IO () | run :: [String] -> IO () | ||||||
| run args = dispatch args cmds options header =<< Git.repoFromCwd | run args = dispatch args cmds options header Git.repoFromCwd | ||||||
|  |  | ||||||
|  | @ -30,8 +30,8 @@ trustLog = "trust.log" | ||||||
| trustGet :: TrustLevel -> Annex [UUID] | trustGet :: TrustLevel -> Annex [UUID] | ||||||
| trustGet SemiTrusted = do -- special case; trustMap does not contain all these | trustGet SemiTrusted = do -- special case; trustMap does not contain all these | ||||||
| 	others <- M.keys . M.filter (/= SemiTrusted) <$> trustMap | 	others <- M.keys . M.filter (/= SemiTrusted) <$> trustMap | ||||||
| 	all <- uuidList | 	alluuids <- uuidList | ||||||
| 	return $ all \\ others | 	return $ alluuids \\ others | ||||||
| trustGet level = M.keys . M.filter (== level) <$> trustMap | trustGet level = M.keys . M.filter (== level) <$> trustMap | ||||||
| 
 | 
 | ||||||
| {- Read the trustLog into a map, overriding with any | {- Read the trustLog into a map, overriding with any | ||||||
|  |  | ||||||
|  | @ -33,6 +33,7 @@ type CommandCleanup = Annex Bool | ||||||
| 
 | 
 | ||||||
| {- A command is defined by specifying these things. -} | {- A command is defined by specifying these things. -} | ||||||
| data Command = Command { | data Command = Command { | ||||||
|  | 	cmdnorepo :: Maybe (IO ()), | ||||||
| 	cmdcheck :: [CommandCheck], | 	cmdcheck :: [CommandCheck], | ||||||
| 	cmdname :: String, | 	cmdname :: String, | ||||||
| 	cmdparams :: String, | 	cmdparams :: String, | ||||||
|  |  | ||||||
							
								
								
									
										2
									
								
								debian/changelog
									
										
									
									
										vendored
									
									
								
							
							
						
						
									
										2
									
								
								debian/changelog
									
										
									
									
										vendored
									
									
								
							|  | @ -14,6 +14,8 @@ git-annex (3.20111112) UNRELEASED; urgency=low | ||||||
|     displayed) |     displayed) | ||||||
|   * status: --fast is back |   * status: --fast is back | ||||||
|   * Fix support for insteadOf url remapping. Closes: #644278 |   * Fix support for insteadOf url remapping. Closes: #644278 | ||||||
|  |   * When not run in a git repository, git-annex can still display a usage | ||||||
|  |     message, and "git annex version" even works. | ||||||
| 
 | 
 | ||||||
|  -- Joey Hess <joeyh@debian.org>  Sat, 12 Nov 2011 14:50:21 -0400 |  -- Joey Hess <joeyh@debian.org>  Sat, 12 Nov 2011 14:50:21 -0400 | ||||||
| 
 | 
 | ||||||
|  |  | ||||||
|  | @ -3,3 +3,5 @@ was checking the version of git-annex on a machine before cloning a repo... | ||||||
|     $ git annex version |     $ git annex version | ||||||
|     git-annex: Not in a git repository. |     git-annex: Not in a git repository. | ||||||
| 
 | 
 | ||||||
|  | > made difficult by the Annex monad, but I made it work! --[[Joey]] | ||||||
|  | > [[done]] | ||||||
|  |  | ||||||
|  | @ -79,8 +79,8 @@ builtins = map cmdname cmds | ||||||
| builtin :: String -> String -> [String] -> IO () | builtin :: String -> String -> [String] -> IO () | ||||||
| builtin cmd dir params = do | builtin cmd dir params = do | ||||||
| 	checkNotReadOnly cmd | 	checkNotReadOnly cmd | ||||||
| 	Git.repoAbsPath dir >>= Git.repoFromAbsPath >>= | 	dispatch (cmd : filterparams params) cmds options header $ | ||||||
| 		dispatch (cmd : filterparams params) cmds options header | 		Git.repoAbsPath dir >>= Git.repoFromAbsPath | ||||||
| 
 | 
 | ||||||
| external :: [String] -> IO () | external :: [String] -> IO () | ||||||
| external params = do | external params = do | ||||||
|  |  | ||||||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue
	
	 Joey Hess
				Joey Hess