diff options
-rw-r--r-- | Assistant/Drop.hs | 4 | ||||
-rw-r--r-- | Assistant/Threads/TransferScanner.hs | 4 | ||||
-rw-r--r-- | CmdLine.hs | 2 | ||||
-rw-r--r-- | CmdLine/Action.hs (renamed from RunCommand.hs) | 14 | ||||
-rw-r--r-- | CmdLine/Seek.hs | 2 | ||||
-rw-r--r-- | Command.hs | 2 | ||||
-rw-r--r-- | Command/PreCommit.hs | 2 | ||||
-rw-r--r-- | Command/Sync.hs | 2 | ||||
-rw-r--r-- | Command/WebApp.hs | 2 | ||||
-rw-r--r-- | doc/bugs/Build_error:_Ambiguous_occurrence___96__callCommand__39__.mdwn | 2 |
10 files changed, 19 insertions, 17 deletions
diff --git a/Assistant/Drop.hs b/Assistant/Drop.hs index faff37a23..efd74fdb3 100644 --- a/Assistant/Drop.hs +++ b/Assistant/Drop.hs @@ -14,7 +14,7 @@ import Assistant.Common import Assistant.DaemonStatus import Annex.Drop (handleDropsFrom, Reason) import Logs.Location -import RunCommand +import CmdLine.Action {- Drop from local and/or remote when allowed by the preferred content and - numcopies settings. -} @@ -22,4 +22,4 @@ handleDrops :: Reason -> Bool -> Key -> AssociatedFile -> Maybe Remote -> Assist handleDrops reason fromhere key f knownpresentremote = do syncrs <- syncDataRemotes <$> getDaemonStatus locs <- liftAnnex $ loggedLocations key - liftAnnex $ handleDropsFrom locs syncrs reason fromhere key f knownpresentremote callCommand + liftAnnex $ handleDropsFrom locs syncrs reason fromhere key f knownpresentremote callCommandAction diff --git a/Assistant/Threads/TransferScanner.hs b/Assistant/Threads/TransferScanner.hs index 6aefb2920..6df9b1e18 100644 --- a/Assistant/Threads/TransferScanner.hs +++ b/Assistant/Threads/TransferScanner.hs @@ -29,7 +29,7 @@ import qualified Git.LsFiles as LsFiles import qualified Backend import Annex.Content import Annex.Wanted -import RunCommand +import CmdLine.Action import qualified Data.Set as S @@ -159,7 +159,7 @@ expensiveScan urlrenderer rs = unless onlyweb $ batch <~> do present <- liftAnnex $ inAnnex key liftAnnex $ handleDropsFrom locs syncrs "expensive scan found too many copies of object" - present key (Just f) Nothing callCommand + present key (Just f) Nothing callCommandAction liftAnnex $ do let slocs = S.fromList locs let use a = return $ mapMaybe (a key slocs) syncrs diff --git a/CmdLine.hs b/CmdLine.hs index cba403dc2..a920898dc 100644 --- a/CmdLine.hs +++ b/CmdLine.hs @@ -50,7 +50,7 @@ dispatch fuzzyok allargs allcmds commonoptions fields header getgitrepo = do whenM (annexDebug <$> Annex.getGitConfig) $ liftIO enableDebugOutput startup - performCommand cmd params + performCommandAction cmd params shutdown $ cmdnocommit cmd where err msg = msg ++ "\n\n" ++ usage header allcmds diff --git a/RunCommand.hs b/CmdLine/Action.hs index 937686d97..247c658bc 100644 --- a/RunCommand.hs +++ b/CmdLine/Action.hs @@ -1,4 +1,4 @@ -{- git-annex running commands +{- git-annex command-line actions - - Copyright 2010-2014 Joey Hess <joey@kitenet.net> - @@ -7,7 +7,7 @@ {-# LANGUAGE BangPatterns #-} -module RunCommand where +module CmdLine.Action where import Common.Annex import qualified Annex @@ -20,8 +20,8 @@ type CommandActionRunner = CommandStart -> CommandCleanup {- Runs a command, starting with the check stage, and then - the seek stage. Finishes by printing the number of commandActions that - failed. -} -performCommand :: Command -> CmdParams -> Annex () -performCommand Command { cmdseek = seek, cmdcheck = c, cmdname = name } params = do +performCommandAction :: Command -> CmdParams -> Annex () +performCommandAction Command { cmdseek = seek, cmdcheck = c, cmdname = name } params = do mapM_ runCheck c Annex.changeState $ \s -> s { Annex.errcounter = 0 } seek params @@ -41,7 +41,7 @@ commandAction a = handle =<< tryAnnexIO go where go = do Annex.Queue.flushWhenFull - callCommand a + callCommandAction a handle (Right True) = return True handle (Right False) = incerr handle (Left err) = do @@ -58,8 +58,8 @@ commandAction a = handle =<< tryAnnexIO go {- Runs a single command action through the start, perform and cleanup - stages, without catching errors. Useful if one command wants to run - part of another command. -} -callCommand :: CommandActionRunner -callCommand = start +callCommandAction :: CommandActionRunner +callCommandAction = start where start = stage $ maybe skip perform perform = stage $ maybe failure cleanup diff --git a/CmdLine/Seek.hs b/CmdLine/Seek.hs index d6d7fbc8b..c3becefde 100644 --- a/CmdLine/Seek.hs +++ b/CmdLine/Seek.hs @@ -23,10 +23,10 @@ import qualified Git.Command import qualified Git.LsFiles as LsFiles import qualified Limit import CmdLine.Option +import CmdLine.Action import Logs.Location import Logs.Unused import Annex.CatFile -import RunCommand withFilesInGit :: (FilePath -> CommandStart) -> CommandSeek withFilesInGit a params = seekActions $ prepFiltered a $ diff --git a/Command.hs b/Command.hs index 7d179aed2..83d67bffd 100644 --- a/Command.hs +++ b/Command.hs @@ -32,7 +32,7 @@ import Types.Option as ReExported import CmdLine.Seek as ReExported import Checks as ReExported import CmdLine.Usage as ReExported -import RunCommand as ReExported +import CmdLine.Action as ReExported import CmdLine.Option as ReExported import CmdLine.GitAnnex.Options as ReExported diff --git a/Command/PreCommit.hs b/Command/PreCommit.hs index 6644f6ffa..388d065c0 100644 --- a/Command/PreCommit.hs +++ b/Command/PreCommit.hs @@ -31,7 +31,7 @@ seek ps = ifM isDirect startIndirect :: FilePath -> CommandStart startIndirect file = next $ do - unlessM (callCommand $ Command.Add.start file) $ + unlessM (callCommandAction $ Command.Add.start file) $ error $ "failed to add " ++ file ++ "; canceling commit" next $ return True diff --git a/Command/Sync.hs b/Command/Sync.hs index 6ef111bc4..acd487df3 100644 --- a/Command/Sync.hs +++ b/Command/Sync.hs @@ -513,7 +513,7 @@ syncFile rs f (k, _) = do -- Using callCommand rather than commandAction for drops, -- because a failure to drop does not mean the sync failed. handleDropsFrom (putrs ++ locs) rs "unwanted" True k (Just f) - Nothing callCommand + Nothing callCommandAction where wantget have = allM id [ pure (not $ null have) diff --git a/Command/WebApp.hs b/Command/WebApp.hs index 9a2d4a38f..d5f43432c 100644 --- a/Command/WebApp.hs +++ b/Command/WebApp.hs @@ -107,7 +107,7 @@ startNoRepo _ = do (d:_) -> do setCurrentDirectory d state <- Annex.new =<< Git.CurrentRepo.get - void $ Annex.eval state $ callCommand $ + void $ Annex.eval state $ callCommandAction $ start' False listenhost {- Run the webapp without a repository, which prompts the user, makes one, diff --git a/doc/bugs/Build_error:_Ambiguous_occurrence___96__callCommand__39__.mdwn b/doc/bugs/Build_error:_Ambiguous_occurrence___96__callCommand__39__.mdwn index e6a167762..e7a849021 100644 --- a/doc/bugs/Build_error:_Ambiguous_occurrence___96__callCommand__39__.mdwn +++ b/doc/bugs/Build_error:_Ambiguous_occurrence___96__callCommand__39__.mdwn @@ -70,3 +70,5 @@ Sorry but I don't know what else could help you. # End of transcript or log. """]] + +> fixed in git and will update cabal soon [[done]] --[[Joey]] |