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
24
CmdLine.hs
24
CmdLine.hs
|
@ -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
|
||||
|
|
10
Command.hs
10
Command.hs
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
2
debian/changelog
vendored
|
@ -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
|
||||
|
||||
|
|
|
@ -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]]
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue