avoid using function named that conflicts with name used in newer version of process library

This commit is contained in:
Joey Hess 2014-01-29 13:44:53 -04:00
parent 36e08e4491
commit cce69eee4d
10 changed files with 19 additions and 17 deletions

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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