mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

use fastDebug everywhere it can be used

Browse source 
None of these are likely to yeild a noticable speedup though.
This commit is contained in:
Joey Hess 2021-04-06 15:41:24 -04:00
parent d16d739ce2
commit 13c090b37a
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
16 changed files with 17 additions and 28 deletions
Download patch file Download diff file Expand all files Collapse all files

1
Annex/Common.hs
View file

@ -8,6 +8,7 @@ import Key as X
import Types.UUID as X import Types.UUID as X
import Annex as X (gitRepo, inRepo, fromRepo, calcRepo) import Annex as X (gitRepo, inRepo, fromRepo, calcRepo)
import Annex.Locations as X import Annex.Locations as X
import Annex.Debug as X (fastDebug, debug)
import Messages as X import Messages as X
#ifndef mingw32_HOST_OS #ifndef mingw32_HOST_OS
import System.Posix.IO as X hiding (createPipe) import System.Posix.IO as X hiding (createPipe)

3
Annex/Drop.hs
View file

@ -22,7 +22,6 @@ import Annex.Content
import Annex.SpecialRemote.Config import Annex.SpecialRemote.Config
import qualified Database.Keys import qualified Database.Keys
import Git.FilePath import Git.FilePath
import Utility.Debug
import qualified Data.Set as S import qualified Data.Set as S
@ -117,7 +116,7 @@ handleDropsFrom locs rs reason fromhere key afile si preverified runner = do
dodrop n@(have, numcopies, mincopies, _untrusted) u a = dodrop n@(have, numcopies, mincopies, _untrusted) u a =
ifM (safely $ runner $ a numcopies mincopies) ifM (safely $ runner $ a numcopies mincopies)
( do ( do
liftIO $ debug "Annex.Drop" $ unwords fastDebug "Annex.Drop" $ unwords
[ "dropped" [ "dropped"
, case afile of , case afile of
AssociatedFile Nothing -> serializeKey key AssociatedFile Nothing -> serializeKey key

1
Annex/ExternalAddonProcess.hs
View file

@ -13,7 +13,6 @@ import qualified Annex
import Annex.Common import Annex.Common
import Git.Env import Git.Env
import Utility.Shell import Utility.Shell
import Utility.Debug
import Messages.Progress import Messages.Progress
import Control.Concurrent.Async import Control.Concurrent.Async

1
Annex/TransferrerPool.hs
View file

@ -24,7 +24,6 @@ import Annex.Path
import Annex.StallDetection import Annex.StallDetection
import Utility.Batch import Utility.Batch
import Utility.Metered import Utility.Metered
import Utility.Debug
import qualified Utility.SimpleProtocol as Proto import qualified Utility.SimpleProtocol as Proto
import Control.Concurrent import Control.Concurrent

2
Assistant/Common.hs
View file

@ -7,7 +7,7 @@
module Assistant.Common (module X) where module Assistant.Common (module X) where
import Annex.Common as X import Annex.Common as X hiding (debug)
import Assistant.Monad as X import Assistant.Monad as X
import Assistant.Types.DaemonStatus as X import Assistant.Types.DaemonStatus as X
import Assistant.Types.NamedThread as X import Assistant.Types.NamedThread as X

2
Assistant/Monad.hs
View file

@ -27,7 +27,7 @@ module Assistant.Monad (
import "mtl" Control.Monad.Reader import "mtl" Control.Monad.Reader
import qualified Control.Monad.Fail as Fail import qualified Control.Monad.Fail as Fail
import Annex.Common import Annex.Common hiding (debug)
import Assistant.Types.ThreadedMonad import Assistant.Types.ThreadedMonad
import Assistant.Types.DaemonStatus import Assistant.Types.DaemonStatus
import Assistant.Types.ScanRemotes import Assistant.Types.ScanRemotes

3
Backend/External.hs
View file

@ -17,7 +17,6 @@ import Types.Key
import Types.Backend import Types.Backend
import Types.KeySource import Types.KeySource
import Utility.Metered import Utility.Metered
import Utility.Debug
import qualified Utility.SimpleProtocol as Proto import qualified Utility.SimpleProtocol as Proto
import qualified Data.ByteString as S import qualified Data.ByteString as S
@ -142,7 +141,7 @@ handleRequest st req whenunavail responsehandler =
warning ("external special remote error: " ++ err) warning ("external special remote error: " ++ err)
whenunavail whenunavail
handleExceptionalMessage loop (DEBUG msg) = do handleExceptionalMessage loop (DEBUG msg) = do
liftIO $ debug "Backend.External" msg fastDebug "Backend.External" msg
loop loop
withExternalAddon :: ExternalState -> a -> (ExternalAddonProcess -> a) -> a withExternalAddon :: ExternalState -> a -> (ExternalAddonProcess -> a) -> a

5
Command/Drop.hs
View file

@ -20,7 +20,6 @@ import Annex.NumCopies
import Annex.Content import Annex.Content
import Annex.Wanted import Annex.Wanted
import Annex.Notification import Annex.Notification
import Utility.Debug
import qualified Data.Set as S import qualified Data.Set as S
@ -115,7 +114,7 @@ performLocal key afile numcopies mincopies preverified = lockContentForRemoval k
(tocheck, verified) <- verifiableCopies key [u] (tocheck, verified) <- verifiableCopies key [u]
doDrop u (Just contentlock) key afile numcopies mincopies [] (preverified ++ verified) tocheck doDrop u (Just contentlock) key afile numcopies mincopies [] (preverified ++ verified) tocheck
( \proof -> do ( \proof -> do
liftIO $ debug "Command.Drop" $ unwords fastDebug "Command.Drop" $ unwords
[ "Dropping from here" [ "Dropping from here"
, "proof:" , "proof:"
, show proof , show proof
@ -142,7 +141,7 @@ performRemote key afile numcopies mincopies remote = do
(tocheck, verified) <- verifiableCopies key [uuid] (tocheck, verified) <- verifiableCopies key [uuid]
doDrop uuid Nothing key afile numcopies mincopies [uuid] verified tocheck doDrop uuid Nothing key afile numcopies mincopies [uuid] verified tocheck
( \proof -> do ( \proof -> do
liftIO $ debug "Command.Drop" $ unwords fastDebug "Command.Drop" $ unwords
[ "Dropping from remote" [ "Dropping from remote"
, show remote , show remote
, "proof:" , "proof:"

3
Command/ImportFeed.hs
View file

@ -49,7 +49,6 @@ import qualified Git.Ref
import qualified Annex.Branch import qualified Annex.Branch
import Logs import Logs
import Git.CatFile (catObjectStream) import Git.CatFile (catObjectStream)
import Utility.Debug
cmd :: Command cmd :: Command
cmd = notBareRepo $ cmd = notBareRepo $
@ -96,7 +95,7 @@ getFeed addunlockedmatcher opts cache url = do
) )
where where
debugfeedcontent feedcontent msg = do debugfeedcontent feedcontent msg = do
liftIO $ debug "Command.ImportFeed" $ unlines fastDebug "Command.ImportFeed" $ unlines
[ "start of feed content" [ "start of feed content"
, feedcontent , feedcontent
, "end of feed content" , "end of feed content"

5
Command/Move.hs
View file

@ -20,7 +20,6 @@ import Logs.Presence
import Logs.Trust import Logs.Trust
import Logs.File import Logs.File
import Annex.NumCopies import Annex.NumCopies
import Utility.Debug
import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Char8 as B8
import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy as L
@ -177,7 +176,7 @@ toPerform dest removewhen key afile fastcheck isthere = do
DropWorse -> faileddrophere setpresentremote DropWorse -> faileddrophere setpresentremote
showproof proof = "proof: " ++ show proof showproof proof = "proof: " ++ show proof
drophere setpresentremote contentlock reason = do drophere setpresentremote contentlock reason = do
liftIO $ debug "Command.Move" $ unwords fastDebug "Command.Move" $ unwords
[ "Dropping from here" [ "Dropping from here"
, "(" ++ reason ++ ")" , "(" ++ reason ++ ")"
] ]
@ -257,7 +256,7 @@ fromPerform src removewhen key afile = do
showproof proof = "proof: " ++ show proof showproof proof = "proof: " ++ show proof
dropremote reason = do dropremote reason = do
liftIO $ debug "Command.Move" $ unwords fastDebug "Command.Move" $ unwords
[ "Dropping from remote" [ "Dropping from remote"
, show src , show src
, "(" ++ reason ++ ")" , "(" ++ reason ++ ")"

5
Command/SendKey.hs
View file

@ -16,7 +16,6 @@ import Utility.Rsync
import Annex.Transfer import Annex.Transfer
import qualified CmdLine.GitAnnexShell.Fields as Fields import qualified CmdLine.GitAnnexShell.Fields as Fields
import Utility.Metered import Utility.Metered
import Utility.Debug
cmd :: Command cmd :: Command
cmd = noCommit $ cmd = noCommit $
@ -46,14 +45,14 @@ start (_, key) = do
fieldTransfer :: Direction -> Key -> (MeterUpdate -> Annex Bool) -> CommandStart fieldTransfer :: Direction -> Key -> (MeterUpdate -> Annex Bool) -> CommandStart
fieldTransfer direction key a = do fieldTransfer direction key a = do
liftIO $ debug "Command.SendKey" "transfer start" fastDebug "Command.SendKey" "transfer start"
afile <- AssociatedFile . (fmap toRawFilePath) afile <- AssociatedFile . (fmap toRawFilePath)
<$> Fields.getField Fields.associatedFile <$> Fields.getField Fields.associatedFile
ok <- maybe (a $ const noop) ok <- maybe (a $ const noop)
-- Using noRetry here because we're the sender. -- Using noRetry here because we're the sender.
(\u -> runner (Transfer direction (toUUID u) (fromKey id key)) afile Nothing noRetry a) (\u -> runner (Transfer direction (toUUID u) (fromKey id key)) afile Nothing noRetry a)
=<< Fields.getField Fields.remoteUUID =<< Fields.getField Fields.remoteUUID
liftIO $ debug "Command.SendKey" "transfer done" fastDebug "Command.SendKey" "transfer done"
liftIO $ exitBool ok liftIO $ exitBool ok
where where
{- Allow the key to be sent to the remote even if there seems to be {- Allow the key to be sent to the remote even if there seems to be

3
Remote/External.hs
View file

@ -38,7 +38,6 @@ import Annex.Content
import Annex.Url import Annex.Url
import Annex.UUID import Annex.UUID
import Creds import Creds
import Utility.Debug
import Control.Concurrent.STM import Control.Concurrent.STM
import qualified Data.Map as M import qualified Data.Map as M
@ -494,7 +493,7 @@ handleRequest' st external req mp responsehandler
handleRemoteRequest (GETURLS key prefix) = do handleRemoteRequest (GETURLS key prefix) = do
mapM_ (send . VALUE) =<< getUrlsWithPrefix key prefix mapM_ (send . VALUE) =<< getUrlsWithPrefix key prefix
send (VALUE "") -- end of list send (VALUE "") -- end of list
handleRemoteRequest (DEBUG msg) = liftIO $ debug "Remote.External" msg handleRemoteRequest (DEBUG msg) = fastDebug "Remote.External" msg
handleRemoteRequest (INFO msg) = showInfo msg handleRemoteRequest (INFO msg) = showInfo msg
handleRemoteRequest (VERSION _) = senderror "too late to send VERSION" handleRemoteRequest (VERSION _) = senderror "too late to send VERSION"

5
Remote/GitLFS.hs
View file

@ -39,7 +39,6 @@ import Backend.Hash
import Utility.Hash import Utility.Hash
import Utility.SshHost import Utility.SshHost
import Utility.Url import Utility.Url
import Utility.Debug
import Logs.Remote import Logs.Remote
import Logs.RemoteState import Logs.RemoteState
import qualified Git.Config import qualified Git.Config
@ -349,11 +348,11 @@ makeSmallAPIRequest :: Request -> Annex (Response L.ByteString)
makeSmallAPIRequest req = do makeSmallAPIRequest req = do
uo <- getUrlOptions uo <- getUrlOptions
let req' = applyRequest uo req let req' = applyRequest uo req
liftIO $ debug "Remote.GitLFS" (show req') fastDebug "Remote.GitLFS" (show req')
resp <- liftIO $ httpLbs req' (httpManager uo) resp <- liftIO $ httpLbs req' (httpManager uo)
-- Only debug the http status code, not the json -- Only debug the http status code, not the json
-- which may include an authentication token. -- which may include an authentication token.
liftIO $ debug "Remote.GitLFS" (show $ responseStatus resp) fastDebug "Remote.GitLFS" (show $ responseStatus resp)
return resp return resp
sendTransferRequest sendTransferRequest

4
Remote/Helper/Ssh.hs
View file

@ -59,8 +59,8 @@ git_annex_shell cs r command params fields
dir = Git.repoPath r dir = Git.repoPath r
shellcmd = "git-annex-shell" shellcmd = "git-annex-shell"
getshellopts = do getshellopts = do
debug <- annexDebug <$> Annex.getGitConfig debugenabled <- annexDebug <$> Annex.getGitConfig
let params' = if debug let params' = if debugenabled
then Param "--debug" : params then Param "--debug" : params
else params else params
return (Param command : File (fromRawFilePath dir) : params') return (Param command : File (fromRawFilePath dir) : params')

1
Remote/S3.hs
View file

@ -66,7 +66,6 @@ import qualified Annex.Url as Url
import Utility.Url (extractFromResourceT) import Utility.Url (extractFromResourceT)
import Annex.Url (getUrlOptions, withUrlOptions, UrlOptions(..)) import Annex.Url (getUrlOptions, withUrlOptions, UrlOptions(..))
import Utility.Env import Utility.Env
import Utility.Debug
type BucketName = String type BucketName = String
type BucketObject = String type BucketObject = String

1
Remote/WebDAV.hs
View file

@ -43,7 +43,6 @@ import Utility.Url (URLString, matchStatusCodeException, matchHttpExceptionConte
import Annex.UUID import Annex.UUID
import Remote.WebDAV.DavLocation import Remote.WebDAV.DavLocation
import Types.ProposedAccepted import Types.ProposedAccepted
import Utility.Debug
remote :: RemoteType remote :: RemoteType
remote = specialRemoteType $ RemoteType remote = specialRemoteType $ RemoteType