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.

Checks.hs

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

Command.hs

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

Command/Add.hs

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

Command/AddUrl.hs

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

Command/Direct.hs

@@ -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 $
+start = ifM isDirect ( stop , next perform )
-	ifM isDirect
-		( stop , next perform )
 
 perform :: CommandPerform
 perform = do

Command/FromKey.hs

@@ -14,14 +14,15 @@ import Annex.Content
 import Types.Key
 
 def :: [Command]
-def = [notDirect $ command "fromkey" (paramPair paramKey paramPath) seek
+def = [notDirect $ notBareRepo $
-	"adds a file using a specific key"]
+	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 $

Command/Import.hs

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

Command/Indirect.hs

@@ -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 $
+start = ifM isDirect ( next perform, stop )
-	ifM isDirect
-		( next perform, stop )
 
 perform :: CommandPerform
 perform = do

Command/Watch.hs

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

Command/WebApp.hs

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