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:
Joey Hess 2011-11-16 00:49:09 -04:00
parent 84784e2ca1
commit 2bb6b02948
9 changed files with 38 additions and 18 deletions

View file

@ -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

View file

@ -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)

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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
View file

@ -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

View file

@ -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]]

View file

@ -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