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
) 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 Common.Annex
@ -25,14 +27,18 @@ type Params = [String]
type Flags = [Annex ()]
{- Runs the passed command line. -}
dispatch :: Params -> [Command] -> [Option] -> String -> Git.Repo -> IO ()
dispatch args cmds options header gitrepo = do
dispatch :: Params -> [Command] -> [Option] -> String -> IO Git.Repo -> IO ()
dispatch args cmds options header getgitrepo = do
setupConsole
state <- Annex.new gitrepo
(actions, state') <- Annex.run state $ do
sequence_ flags
prepCommand cmd params
tryRun state' cmd $ [startup] ++ actions ++ [shutdown]
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
sequence_ flags
prepCommand cmd params
tryRun state' cmd $ [startup] ++ actions ++ [shutdown]
where
(flags, cmd, params) = parseCmd args cmds options header
@ -77,7 +83,7 @@ tryRun' errnum _ cmd []
| otherwise = return ()
tryRun' errnum state cmd (a:as) = run >>= handle
where
run = try $ Annex.run state $ do
run = IO.try $ Annex.run state $ do
Annex.Queue.flushWhenFull
a
handle (Left err) = showerr err >> cont False state

View file

@ -7,6 +7,7 @@
module Command (
command,
noRepo,
next,
stop,
prepCommand,
@ -31,9 +32,14 @@ import Logs.Trust
import Logs.Location
import Config
{- Generates a command with the common checks. -}
{- Generates a normal 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. -}
next :: a -> Annex (Maybe a)

View file

@ -13,7 +13,7 @@ import qualified Build.SysConfig as SysConfig
import Annex.Version
def :: [Command]
def = [dontCheck repoExists $
def = [noRepo showPackageVersion $ dontCheck repoExists $
command "version" paramNothing seek "show version info"]
seek :: [CommandSeek]
@ -23,7 +23,7 @@ start :: CommandStart
start = do
v <- getVersion
liftIO $ do
putStrLn $ "git-annex version: " ++ SysConfig.packageversion
showPackageVersion
putStrLn $ "local repository version: " ++ fromMaybe "unknown" v
putStrLn $ "default repository version: " ++ defaultVersion
putStrLn $ "supported repository versions: " ++ vs supportedVersions
@ -31,3 +31,6 @@ start = do
stop
where
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 ..]"
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 SemiTrusted = do -- special case; trustMap does not contain all these
others <- M.keys . M.filter (/= SemiTrusted) <$> trustMap
all <- uuidList
return $ all \\ others
alluuids <- uuidList
return $ alluuids \\ others
trustGet level = M.keys . M.filter (== level) <$> trustMap
{- 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. -}
data Command = Command {
cmdnorepo :: Maybe (IO ()),
cmdcheck :: [CommandCheck],
cmdname :: String,
cmdparams :: String,

2
debian/changelog vendored
View file

@ -14,6 +14,8 @@ git-annex (3.20111112) UNRELEASED; urgency=low
displayed)
* status: --fast is back
* 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

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: 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 cmd dir params = do
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 params = do