convert notBareRepo to a CommandCheck

This avoids some small overhead by only running the check once per command;
it also ensures that, even if the command doesn't find anything to run on,
it still fails to run when in a bare repo.
This commit is contained in:
Joey Hess 2012-12-29 14:45:19 -04:00
parent e2788a5d15
commit e872c3f648
10 changed files with 26 additions and 28 deletions

View file

@ -14,6 +14,7 @@ import Common.Annex
import Types.Command
import Init
import Config
import qualified Git
commonChecks :: [CommandCheck]
commonChecks = [repoExists]
@ -25,6 +26,10 @@ notDirect :: Command -> Command
notDirect = addCheck $ whenM isDirect $
error "You cannot run this subcommand in a direct mode repository."
notBareRepo :: Command -> Command
notBareRepo = addCheck $ whenM (fromRepo Git.repoIsLocalBare) $
error "You cannot run this subcommand in a bare repository."
dontCheck :: CommandCheck -> Command -> Command
dontCheck check cmd = mutateCheck cmd $ \c -> filter (/= check) c

View file

@ -17,7 +17,6 @@ module Command (
doCommand,
whenAnnexed,
ifAnnexed,
notBareRepo,
isBareRepo,
numCopies,
numCopiesCheck,
@ -97,12 +96,6 @@ whenAnnexed a file = ifAnnexed file (a file) (return Nothing)
ifAnnexed :: FilePath -> ((Key, Backend) -> Annex a) -> Annex a -> Annex a
ifAnnexed file yes no = maybe no yes =<< Backend.lookupFile file
notBareRepo :: Annex a -> Annex a
notBareRepo a = do
whenM isBareRepo $
error "You cannot run this subcommand in a bare repository."
a
isBareRepo :: Annex Bool
isBareRepo = fromRepo Git.repoIsLocalBare

View file

@ -23,7 +23,8 @@ import Utility.FileMode
import Config
def :: [Command]
def = [notDirect $ command "add" paramPaths seek "add files to annex"]
def = [notDirect $ notBareRepo $
command "add" paramPaths seek "add files to annex"]
{- Add acts on both files not checked into git yet, and unlocked files. -}
seek :: [CommandSeek]
@ -33,7 +34,7 @@ seek = [withFilesNotInGit start, withFilesUnlocked start]
- backend, and then moving it into the annex directory and setting up
- the symlink pointing to its content. -}
start :: FilePath -> CommandStart
start file = notBareRepo $ ifAnnexed file fixup add
start file = ifAnnexed file fixup add
where
add = do
s <- liftIO $ getSymbolicLinkStatus file

View file

@ -24,7 +24,7 @@ import Types.KeySource
import Config
def :: [Command]
def = [notDirect $ withOptions [fileOption, pathdepthOption] $
def = [notDirect $ notBareRepo $ withOptions [fileOption, pathdepthOption] $
command "addurl" (paramRepeating paramUrl) seek "add urls to annex"]
fileOption :: Option
@ -39,7 +39,7 @@ seek = [withField fileOption return $ \f ->
withStrings $ start f d]
start :: Maybe FilePath -> Maybe Int -> String -> CommandStart
start optfile pathdepth s = notBareRepo $ go $ fromMaybe bad $ parseURI s
start optfile pathdepth s = go $ fromMaybe bad $ parseURI s
where
bad = fromMaybe (error $ "bad url " ++ s) $
parseURI $ escapeURIString isUnescapedInURI s

View file

@ -16,15 +16,14 @@ import Config
import Annex.Direct
def :: [Command]
def = [command "direct" paramNothing seek "switch repository to direct mode"]
def = [notBareRepo $
command "direct" paramNothing seek "switch repository to direct mode"]
seek :: [CommandSeek]
seek = [withNothing start]
start :: CommandStart
start = notBareRepo $
ifM isDirect
( stop , next perform )
start = ifM isDirect ( stop , next perform )
perform :: CommandPerform
perform = do

View file

@ -14,14 +14,15 @@ import Annex.Content
import Types.Key
def :: [Command]
def = [notDirect $ command "fromkey" (paramPair paramKey paramPath) seek
def = [notDirect $ notBareRepo $
command "fromkey" (paramPair paramKey paramPath) seek
"adds a file using a specific key"]
seek :: [CommandSeek]
seek = [withWords start]
start :: [String] -> CommandStart
start (keyname:file:[]) = notBareRepo $ do
start (keyname:file:[]) = do
let key = fromMaybe (error "bad key") $ file2key keyname
inbackend <- inAnnex key
unless inbackend $ error $

View file

@ -13,14 +13,14 @@ import qualified Annex
import qualified Command.Add
def :: [Command]
def = [notDirect $ command "import" paramPaths seek
def = [notDirect $ notBareRepo $ command "import" paramPaths seek
"move and add files from outside git working copy"]
seek :: [CommandSeek]
seek = [withPathContents start]
start :: (FilePath, FilePath) -> CommandStart
start (srcfile, destfile) = notBareRepo $
start (srcfile, destfile) =
ifM (liftIO $ isRegularFile <$> getSymbolicLinkStatus srcfile)
( do
showStart "import" destfile

View file

@ -18,15 +18,14 @@ import Annex.Content
import Annex.CatFile
def :: [Command]
def = [command "indirect" paramNothing seek "switch repository to indirect mode"]
def = [notBareRepo $ command "indirect" paramNothing seek
"switch repository to indirect mode"]
seek :: [CommandSeek]
seek = [withNothing start]
start :: CommandStart
start = notBareRepo $
ifM isDirect
( next perform, stop )
start = ifM isDirect ( next perform, stop )
perform :: CommandPerform
perform = do

View file

@ -13,7 +13,7 @@ import Command
import Option
def :: [Command]
def = [withOptions [foregroundOption, stopOption] $
def = [notBareRepo $ withOptions [foregroundOption, stopOption] $
command "watch" paramNothing seek "watch for changes"]
seek :: [CommandSeek]
@ -28,7 +28,7 @@ stopOption :: Option
stopOption = Option.flag [] "stop" "stop daemon"
start :: Bool -> Bool -> Bool -> CommandStart
start assistant foreground stopdaemon = notBareRepo $ do
start assistant foreground stopdaemon = do
if stopdaemon
then stopDaemon
else startDaemon assistant foreground Nothing -- does not return

View file

@ -29,7 +29,7 @@ import Control.Concurrent
import Control.Concurrent.STM
def :: [Command]
def = [noCommit $ noRepo startNoRepo $ dontCheck repoExists $
def = [noCommit $ noRepo startNoRepo $ dontCheck repoExists $ notBareRepo $
command "webapp" paramNothing seek "launch webapp"]
seek :: [CommandSeek]
@ -39,7 +39,7 @@ start :: CommandStart
start = start' True
start' :: Bool -> CommandStart
start' allowauto = notBareRepo $ do
start' allowauto = do
liftIO $ ensureInstalled
ifM isInitialized ( go , auto )
stop