summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2011-11-16 00:49:09 -0400
committerGravatar Joey Hess <joey@kitenet.net>2011-11-16 00:49:09 -0400
commit2bb6b02948da8a33b2edcd911fcf3c2597b0ee58 (patch)
tree631f0694c7b5a17064eb66862230ec666e3871a8
parent84784e2ca1ababf21342cba36f7e65b4c3cd303b (diff)
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.
-rw-r--r--CmdLine.hs24
-rw-r--r--Command.hs10
-rw-r--r--Command/Version.hs7
-rw-r--r--GitAnnex.hs2
-rw-r--r--Logs/Trust.hs4
-rw-r--r--Types/Command.hs1
-rw-r--r--debian/changelog2
-rw-r--r--doc/bugs/git_annex_version_should_without_being_in_a_repo_.mdwn2
-rw-r--r--git-annex-shell.hs4
9 files changed, 38 insertions, 18 deletions
diff --git a/CmdLine.hs b/CmdLine.hs
index af53abc62..78f46a2e3 100644
--- a/CmdLine.hs
+++ b/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
diff --git a/Command.hs b/Command.hs
index d22c2d12f..b66217192 100644
--- a/Command.hs
+++ b/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)
diff --git a/Command/Version.hs b/Command/Version.hs
index a58426482..9fb7fe5bd 100644
--- a/Command/Version.hs
+++ b/Command/Version.hs
@@ -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
diff --git a/GitAnnex.hs b/GitAnnex.hs
index f416b7bea..7b51602be 100644
--- a/GitAnnex.hs
+++ b/GitAnnex.hs
@@ -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
diff --git a/Logs/Trust.hs b/Logs/Trust.hs
index 6305d281f..072ea41d6 100644
--- a/Logs/Trust.hs
+++ b/Logs/Trust.hs
@@ -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
diff --git a/Types/Command.hs b/Types/Command.hs
index d39876a7a..5341a4054 100644
--- a/Types/Command.hs
+++ b/Types/Command.hs
@@ -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,
diff --git a/debian/changelog b/debian/changelog
index 46518b2a8..fd989546a 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -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
diff --git a/doc/bugs/git_annex_version_should_without_being_in_a_repo_.mdwn b/doc/bugs/git_annex_version_should_without_being_in_a_repo_.mdwn
index 0bae8bdb0..5c995852b 100644
--- a/doc/bugs/git_annex_version_should_without_being_in_a_repo_.mdwn
+++ b/doc/bugs/git_annex_version_should_without_being_in_a_repo_.mdwn
@@ -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]]
diff --git a/git-annex-shell.hs b/git-annex-shell.hs
index 658eddd77..9a9d2f092 100644
--- a/git-annex-shell.hs
+++ b/git-annex-shell.hs
@@ -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