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