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
|
runHandler handler file filestatus = void $ do
|
||||||
r <- tryIO <~> handler (normalize file) filestatus
|
r <- tryIO <~> handler (normalize file) filestatus
|
||||||
case r of
|
case r of
|
||||||
Left e -> liftIO $ warningIO $ show e
|
Left e -> liftAnnex $ warning $ show e
|
||||||
Right Nothing -> noop
|
Right Nothing -> noop
|
||||||
Right (Just change) -> recordChange change
|
Right (Just change) -> recordChange change
|
||||||
where
|
where
|
||||||
|
|
|
@ -286,7 +286,7 @@ setupRepo gcryptid r
|
||||||
{- Ask git-annex-shell to configure the repository as a gcrypt
|
{- Ask git-annex-shell to configure the repository as a gcrypt
|
||||||
- repository. May fail if it is too old. -}
|
- repository. May fail if it is too old. -}
|
||||||
gitannexshellsetup = Ssh.onRemote NoConsumeStdin r
|
gitannexshellsetup = Ssh.onRemote NoConsumeStdin r
|
||||||
(boolSystem, return False)
|
(\f p -> liftIO (boolSystem f p), return False)
|
||||||
"gcryptsetup" [ Param gcryptid ] []
|
"gcryptsetup" [ Param gcryptid ] []
|
||||||
|
|
||||||
denyNonFastForwards = "receive.denyNonFastForwards"
|
denyNonFastForwards = "receive.denyNonFastForwards"
|
||||||
|
@ -451,7 +451,7 @@ getGCryptId fast r gc
|
||||||
| Git.repoIsLocal r || Git.repoIsLocalUnknown r = extract <$>
|
| Git.repoIsLocal r || Git.repoIsLocalUnknown r = extract <$>
|
||||||
liftIO (catchMaybeIO $ Git.Config.read r)
|
liftIO (catchMaybeIO $ Git.Config.read r)
|
||||||
| not fast = extract . liftM fst <$> getM (eitherToMaybe <$>)
|
| 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
|
, getConfigViaRsync r gc
|
||||||
]
|
]
|
||||||
| otherwise = return (Nothing, r)
|
| otherwise = return (Nothing, r)
|
||||||
|
|
|
@ -249,21 +249,21 @@ tryGitConfigRead autoinit r
|
||||||
haveconfig = not . M.null . Git.config
|
haveconfig = not . M.null . Git.config
|
||||||
|
|
||||||
pipedconfig cmd params = do
|
pipedconfig cmd params = do
|
||||||
v <- Git.Config.fromPipe r cmd params
|
v <- liftIO $ Git.Config.fromPipe r cmd params
|
||||||
case v of
|
case v of
|
||||||
Right (r', val) -> do
|
Right (r', val) -> do
|
||||||
unless (isUUIDConfigured r' || null val) $ do
|
unless (isUUIDConfigured r' || null val) $ do
|
||||||
warningIO $ "Failed to get annex.uuid configuration of repository " ++ Git.repoDescribe r
|
warning $ "Failed to get annex.uuid configuration of repository " ++ Git.repoDescribe r
|
||||||
warningIO $ "Instead, got: " ++ show val
|
warning $ "Instead, got: " ++ show val
|
||||||
warningIO $ "This is unexpected; please check the network transport!"
|
warning $ "This is unexpected; please check the network transport!"
|
||||||
return $ Right r'
|
return $ Right r'
|
||||||
Left l -> return $ Left l
|
Left l -> return $ Left l
|
||||||
|
|
||||||
geturlconfig = Url.withUrlOptions $ \uo -> do
|
geturlconfig = Url.withUrlOptions $ \uo -> do
|
||||||
v <- liftIO $ withTmpFile "git-annex.tmp" $ \tmpfile h -> do
|
v <- withTmpFile "git-annex.tmp" $ \tmpfile h -> do
|
||||||
hClose h
|
liftIO $ hClose h
|
||||||
let url = Git.repoLocation r ++ "/config"
|
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]
|
( Just <$> pipedconfig "git" [Param "config", Param "--null", Param "--list", Param "--file", File tmpfile]
|
||||||
, return Nothing
|
, return Nothing
|
||||||
)
|
)
|
||||||
|
|
|
@ -83,7 +83,7 @@ git_annex_shell cs r command params fields
|
||||||
onRemote
|
onRemote
|
||||||
:: ConsumeStdin
|
:: ConsumeStdin
|
||||||
-> Git.Repo
|
-> Git.Repo
|
||||||
-> (FilePath -> [CommandParam] -> IO a, Annex a)
|
-> (FilePath -> [CommandParam] -> Annex a, Annex a)
|
||||||
-> String
|
-> String
|
||||||
-> [CommandParam]
|
-> [CommandParam]
|
||||||
-> [(Field, String)]
|
-> [(Field, String)]
|
||||||
|
@ -91,7 +91,7 @@ onRemote
|
||||||
onRemote cs r (with, errorval) command params fields = do
|
onRemote cs r (with, errorval) command params fields = do
|
||||||
s <- git_annex_shell cs r command params fields
|
s <- git_annex_shell cs r command params fields
|
||||||
case s of
|
case s of
|
||||||
Just (c, ps) -> liftIO $ with c ps
|
Just (c, ps) -> with c ps
|
||||||
Nothing -> errorval
|
Nothing -> errorval
|
||||||
|
|
||||||
{- Checks if a remote contains a key. -}
|
{- Checks if a remote contains a key. -}
|
||||||
|
@ -100,14 +100,14 @@ inAnnex r k = do
|
||||||
showChecking r
|
showChecking r
|
||||||
onRemote NoConsumeStdin r (runcheck, cantCheck r) "inannex" [Param $ serializeKey k] []
|
onRemote NoConsumeStdin r (runcheck, cantCheck r) "inannex" [Param $ serializeKey k] []
|
||||||
where
|
where
|
||||||
runcheck c p = dispatch =<< safeSystem c p
|
runcheck c p = liftIO $ dispatch =<< safeSystem c p
|
||||||
dispatch ExitSuccess = return True
|
dispatch ExitSuccess = return True
|
||||||
dispatch (ExitFailure 1) = return False
|
dispatch (ExitFailure 1) = return False
|
||||||
dispatch _ = cantCheck r
|
dispatch _ = cantCheck r
|
||||||
|
|
||||||
{- Removes a key from a remote. -}
|
{- Removes a key from a remote. -}
|
||||||
dropKey :: Git.Repo -> Key -> Annex Bool
|
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 "--quiet", Param "--force"
|
||||||
, Param $ serializeKey key
|
, Param $ serializeKey key
|
||||||
]
|
]
|
||||||
|
|
|
@ -69,7 +69,7 @@ server ichan th@(TransportHandle (LocalRepo r) _) = go
|
||||||
)
|
)
|
||||||
unless ok $ do
|
unless ok $ do
|
||||||
hClose conn
|
hClose conn
|
||||||
warningIO "dropped Tor connection, too busy"
|
liftAnnex th $ warning "dropped Tor connection, too busy"
|
||||||
|
|
||||||
handlecontrol servicerunning = do
|
handlecontrol servicerunning = do
|
||||||
msg <- atomically $ readTChan ichan
|
msg <- atomically $ readTChan ichan
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue