remove some unncessary uses of warningIO
warningIO is not concurrent output safe, and it doesn't go to --json-error-messages There are a few more that would be too hard to remove, and there are also several dozen direct prints to stderr still.
This commit is contained in:
parent
0be23bae2f
commit
9e8d40181f
5 changed files with 15 additions and 15 deletions
|
@ -183,7 +183,7 @@ runHandler :: Handler -> FilePath -> Maybe FileStatus -> Assistant ()
|
|||
runHandler handler file filestatus = void $ do
|
||||
r <- tryIO <~> handler (normalize file) filestatus
|
||||
case r of
|
||||
Left e -> liftIO $ warningIO $ show e
|
||||
Left e -> liftAnnex $ warning $ show e
|
||||
Right Nothing -> noop
|
||||
Right (Just change) -> recordChange change
|
||||
where
|
||||
|
|
|
@ -286,7 +286,7 @@ setupRepo gcryptid r
|
|||
{- Ask git-annex-shell to configure the repository as a gcrypt
|
||||
- repository. May fail if it is too old. -}
|
||||
gitannexshellsetup = Ssh.onRemote NoConsumeStdin r
|
||||
(boolSystem, return False)
|
||||
(\f p -> liftIO (boolSystem f p), return False)
|
||||
"gcryptsetup" [ Param gcryptid ] []
|
||||
|
||||
denyNonFastForwards = "receive.denyNonFastForwards"
|
||||
|
@ -451,7 +451,7 @@ getGCryptId fast r gc
|
|||
| Git.repoIsLocal r || Git.repoIsLocalUnknown r = extract <$>
|
||||
liftIO (catchMaybeIO $ Git.Config.read r)
|
||||
| not fast = extract . liftM fst <$> getM (eitherToMaybe <$>)
|
||||
[ Ssh.onRemote NoConsumeStdin r (Git.Config.fromPipe r, return (Left $ error "configlist failed")) "configlist" [] []
|
||||
[ Ssh.onRemote NoConsumeStdin r (\f p -> liftIO (Git.Config.fromPipe r f p), return (Left $ error "configlist failed")) "configlist" [] []
|
||||
, getConfigViaRsync r gc
|
||||
]
|
||||
| otherwise = return (Nothing, r)
|
||||
|
|
|
@ -249,21 +249,21 @@ tryGitConfigRead autoinit r
|
|||
haveconfig = not . M.null . Git.config
|
||||
|
||||
pipedconfig cmd params = do
|
||||
v <- Git.Config.fromPipe r cmd params
|
||||
v <- liftIO $ Git.Config.fromPipe r cmd params
|
||||
case v of
|
||||
Right (r', val) -> do
|
||||
unless (isUUIDConfigured r' || null val) $ do
|
||||
warningIO $ "Failed to get annex.uuid configuration of repository " ++ Git.repoDescribe r
|
||||
warningIO $ "Instead, got: " ++ show val
|
||||
warningIO $ "This is unexpected; please check the network transport!"
|
||||
warning $ "Failed to get annex.uuid configuration of repository " ++ Git.repoDescribe r
|
||||
warning $ "Instead, got: " ++ show val
|
||||
warning $ "This is unexpected; please check the network transport!"
|
||||
return $ Right r'
|
||||
Left l -> return $ Left l
|
||||
|
||||
geturlconfig = Url.withUrlOptions $ \uo -> do
|
||||
v <- liftIO $ withTmpFile "git-annex.tmp" $ \tmpfile h -> do
|
||||
hClose h
|
||||
v <- withTmpFile "git-annex.tmp" $ \tmpfile h -> do
|
||||
liftIO $ hClose h
|
||||
let url = Git.repoLocation r ++ "/config"
|
||||
ifM (Url.downloadQuiet nullMeterUpdate url tmpfile uo)
|
||||
ifM (liftIO $ Url.downloadQuiet nullMeterUpdate url tmpfile uo)
|
||||
( Just <$> pipedconfig "git" [Param "config", Param "--null", Param "--list", Param "--file", File tmpfile]
|
||||
, return Nothing
|
||||
)
|
||||
|
|
|
@ -83,7 +83,7 @@ git_annex_shell cs r command params fields
|
|||
onRemote
|
||||
:: ConsumeStdin
|
||||
-> Git.Repo
|
||||
-> (FilePath -> [CommandParam] -> IO a, Annex a)
|
||||
-> (FilePath -> [CommandParam] -> Annex a, Annex a)
|
||||
-> String
|
||||
-> [CommandParam]
|
||||
-> [(Field, String)]
|
||||
|
@ -91,7 +91,7 @@ onRemote
|
|||
onRemote cs r (with, errorval) command params fields = do
|
||||
s <- git_annex_shell cs r command params fields
|
||||
case s of
|
||||
Just (c, ps) -> liftIO $ with c ps
|
||||
Just (c, ps) -> with c ps
|
||||
Nothing -> errorval
|
||||
|
||||
{- Checks if a remote contains a key. -}
|
||||
|
@ -100,14 +100,14 @@ inAnnex r k = do
|
|||
showChecking r
|
||||
onRemote NoConsumeStdin r (runcheck, cantCheck r) "inannex" [Param $ serializeKey k] []
|
||||
where
|
||||
runcheck c p = dispatch =<< safeSystem c p
|
||||
runcheck c p = liftIO $ dispatch =<< safeSystem c p
|
||||
dispatch ExitSuccess = return True
|
||||
dispatch (ExitFailure 1) = return False
|
||||
dispatch _ = cantCheck r
|
||||
|
||||
{- Removes a key from a remote. -}
|
||||
dropKey :: Git.Repo -> Key -> Annex Bool
|
||||
dropKey r key = onRemote NoConsumeStdin r (boolSystem, return False) "dropkey"
|
||||
dropKey r key = onRemote NoConsumeStdin r (\f p -> liftIO (boolSystem f p), return False) "dropkey"
|
||||
[ Param "--quiet", Param "--force"
|
||||
, Param $ serializeKey key
|
||||
]
|
||||
|
|
|
@ -69,7 +69,7 @@ server ichan th@(TransportHandle (LocalRepo r) _) = go
|
|||
)
|
||||
unless ok $ do
|
||||
hClose conn
|
||||
warningIO "dropped Tor connection, too busy"
|
||||
liftAnnex th $ warning "dropped Tor connection, too busy"
|
||||
|
||||
handlecontrol servicerunning = do
|
||||
msg <- atomically $ readTChan ichan
|
||||
|
|
Loading…
Reference in a new issue