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

move several readonly values to AnnexRead

Browse source 
This improves performance to a small extent in several places.

Sponsored-by: Tobias Ammann on Patreon
This commit is contained in:
Joey Hess 2022-06-28 15:28:14 -04:00
parent 4174ee33a4
commit cb9cf30c48
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
42 changed files with 81 additions and 88 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

20
Annex.hs
View file

@ -123,6 +123,11 @@ data AnnexRead = AnnexRead
, debugenabled :: Bool , debugenabled :: Bool
, debugselector :: DebugSelector , debugselector :: DebugSelector
, ciphers :: TMVar (M.Map StorableCipher Cipher) , ciphers :: TMVar (M.Map StorableCipher Cipher)
, fast :: Bool
, force :: Bool
, forcenumcopies :: Maybe NumCopies
, forcemincopies :: Maybe MinCopies
, forcebackend :: Maybe String
} }
newAnnexRead :: GitConfig -> IO AnnexRead newAnnexRead :: GitConfig -> IO AnnexRead
@ -144,6 +149,11 @@ newAnnexRead c = do
, debugenabled = annexDebug c , debugenabled = annexDebug c
, debugselector = debugSelectorFromGitConfig c , debugselector = debugSelectorFromGitConfig c
, ciphers = cm , ciphers = cm
, fast = False
, force = False
, forcebackend = Nothing
, forcenumcopies = Nothing
, forcemincopies = Nothing
} }
-- Values that can change while running an Annex action. -- Values that can change while running an Annex action.
@ -159,8 +169,6 @@ data AnnexState = AnnexState
, remotes :: [Types.Remote.RemoteA Annex] , remotes :: [Types.Remote.RemoteA Annex]
, output :: MessageState , output :: MessageState
, concurrency :: ConcurrencySetting , concurrency :: ConcurrencySetting
, force :: Bool
, fast :: Bool
, daemon :: Bool , daemon :: Bool
, branchstate :: BranchState , branchstate :: BranchState
, repoqueue :: Maybe (Git.Queue.Queue Annex) , repoqueue :: Maybe (Git.Queue.Queue Annex)
@ -168,11 +176,8 @@ data AnnexState = AnnexState
, hashobjecthandle :: Maybe HashObjectHandle , hashobjecthandle :: Maybe HashObjectHandle
, checkattrhandle :: Maybe (ResourcePool CheckAttrHandle) , checkattrhandle :: Maybe (ResourcePool CheckAttrHandle)
, checkignorehandle :: Maybe (ResourcePool CheckIgnoreHandle) , checkignorehandle :: Maybe (ResourcePool CheckIgnoreHandle)
, forcebackend :: Maybe String
, globalnumcopies :: Maybe NumCopies , globalnumcopies :: Maybe NumCopies
, globalmincopies :: Maybe MinCopies , globalmincopies :: Maybe MinCopies
, forcenumcopies :: Maybe NumCopies
, forcemincopies :: Maybe MinCopies
, limit :: ExpandableMatcher Annex , limit :: ExpandableMatcher Annex
, timelimit :: Maybe (Duration, POSIXTime) , timelimit :: Maybe (Duration, POSIXTime)
, sizelimit :: Maybe (TVar Integer) , sizelimit :: Maybe (TVar Integer)
@ -220,8 +225,6 @@ newAnnexState c r = do
, remotes = [] , remotes = []
, output = o , output = o
, concurrency = ConcurrencyCmdLine NonConcurrent , concurrency = ConcurrencyCmdLine NonConcurrent
, force = False
, fast = False
, daemon = False , daemon = False
, branchstate = startBranchState , branchstate = startBranchState
, repoqueue = Nothing , repoqueue = Nothing
@ -229,11 +232,8 @@ newAnnexState c r = do
, hashobjecthandle = Nothing , hashobjecthandle = Nothing
, checkattrhandle = Nothing , checkattrhandle = Nothing
, checkignorehandle = Nothing , checkignorehandle = Nothing
, forcebackend = Nothing
, globalnumcopies = Nothing , globalnumcopies = Nothing
, globalmincopies = Nothing , globalmincopies = Nothing
, forcenumcopies = Nothing
, forcemincopies = Nothing
, limit = BuildingMatcher [] , limit = BuildingMatcher []
, timelimit = Nothing , timelimit = Nothing
, sizelimit = Nothing , sizelimit = Nothing

2
Annex/AdjustedBranch.hs
View file

@ -207,7 +207,7 @@ enterAdjustedBranch adj = inRepo Git.Branch.current >>= \case
go currbranch = do go currbranch = do
let origbranch = fromAdjustedBranch currbranch let origbranch = fromAdjustedBranch currbranch
let adjbranch = adjBranch $ originalToAdjusted origbranch adj let adjbranch = adjBranch $ originalToAdjusted origbranch adj
ifM (inRepo (Git.Ref.exists adjbranch) <&&> (not <$> Annex.getState Annex.force)) ifM (inRepo (Git.Ref.exists adjbranch) <&&> (not <$> Annex.getRead Annex.force))
( do ( do
mapM_ (warning . unwords) mapM_ (warning . unwords)
[ [ "adjusted branch" [ [ "adjusted branch"

2
Annex/CheckIgnore.hs
View file

@ -25,7 +25,7 @@ newtype CheckGitIgnore = CheckGitIgnore Bool
checkIgnored :: CheckGitIgnore -> RawFilePath -> Annex Bool checkIgnored :: CheckGitIgnore -> RawFilePath -> Annex Bool
checkIgnored (CheckGitIgnore False) _ = pure False checkIgnored (CheckGitIgnore False) _ = pure False
checkIgnored (CheckGitIgnore True) file = checkIgnored (CheckGitIgnore True) file =
ifM (Annex.getState Annex.force) ifM (Annex.getRead Annex.force)
( pure False ( pure False
, withCheckIgnoreHandle $ \h -> liftIO $ Git.checkIgnored h file , withCheckIgnoreHandle $ \h -> liftIO $ Git.checkIgnored h file
) )

2
Annex/Content/LowLevel.hs
View file

@ -107,7 +107,7 @@ checkDiskSpace destdir key = checkDiskSpace' (fromMaybe 1 (fromKey keySize key))
{- Allows specifying the size of the key, if it's known, which is useful {- Allows specifying the size of the key, if it's known, which is useful
- as not all keys know their size. -} - as not all keys know their size. -}
checkDiskSpace' :: Integer -> Maybe RawFilePath -> Key -> Integer -> Bool -> Annex Bool checkDiskSpace' :: Integer -> Maybe RawFilePath -> Key -> Integer -> Bool -> Annex Bool
checkDiskSpace' need destdir key alreadythere samefilesystem = ifM (Annex.getState Annex.force) checkDiskSpace' need destdir key alreadythere samefilesystem = ifM (Annex.getRead Annex.force)
( return True ( return True
, do , do
-- We can't get inprogress and free at the same -- We can't get inprogress and free at the same

2
Annex/Ingest.hs
View file

@ -325,7 +325,7 @@ addSymlink file key mcache = do
- checked in, CheckGitIgnore True has no effect. - checked in, CheckGitIgnore True has no effect.
-} -}
gitAddParams :: CheckGitIgnore -> Annex [CommandParam] gitAddParams :: CheckGitIgnore -> Annex [CommandParam]
gitAddParams (CheckGitIgnore True) = ifM (Annex.getState Annex.force) gitAddParams (CheckGitIgnore True) = ifM (Annex.getRead Annex.force)
( return [Param "-f"] ( return [Param "-f"]
, return [] , return []
) )

4
Annex/NumCopies.hs
View file

@ -57,11 +57,11 @@ deprecatedNumCopies = annexNumCopies <$> Annex.getGitConfig
{- Value forced on the command line by --numcopies. -} {- Value forced on the command line by --numcopies. -}
getForcedNumCopies :: Annex (Maybe NumCopies) getForcedNumCopies :: Annex (Maybe NumCopies)
getForcedNumCopies = Annex.getState Annex.forcenumcopies getForcedNumCopies = Annex.getRead Annex.forcenumcopies
{- Value forced on the command line by --mincopies. -} {- Value forced on the command line by --mincopies. -}
getForcedMinCopies :: Annex (Maybe MinCopies) getForcedMinCopies :: Annex (Maybe MinCopies)
getForcedMinCopies = Annex.getState Annex.forcemincopies getForcedMinCopies = Annex.getRead Annex.forcemincopies
{- NumCopies value from any of the non-.gitattributes configuration {- NumCopies value from any of the non-.gitattributes configuration
- sources. -} - sources. -}

2
Annex/YoutubeDl.hs
View file

@ -118,7 +118,7 @@ youtubeDl' url workdir p uo
-- and any files in the workdir that it may have partially downloaded -- and any files in the workdir that it may have partially downloaded
-- before. -- before.
youtubeDlMaxSize :: FilePath -> Annex (Either String [CommandParam]) youtubeDlMaxSize :: FilePath -> Annex (Either String [CommandParam])
youtubeDlMaxSize workdir = ifM (Annex.getState Annex.force) youtubeDlMaxSize workdir = ifM (Annex.getRead Annex.force)
( return $ Right [] ( return $ Right []
, liftIO (getDiskFree workdir) >>= \case , liftIO (getDiskFree workdir) >>= \case
Just have -> do Just have -> do

2
Assistant/Threads/Watcher.hs
View file

@ -57,7 +57,7 @@ checkCanWatch
| canWatch = do | canWatch = do
#ifndef mingw32_HOST_OS #ifndef mingw32_HOST_OS
liftIO Lsof.setup liftIO Lsof.setup
unlessM (liftIO (inSearchPath "lsof") <||> Annex.getState Annex.force) unlessM (liftIO (inSearchPath "lsof") <||> Annex.getRead Annex.force)
needLsof needLsof
#else #else
noop noop

4
Backend.hs
View file

@ -44,7 +44,7 @@ defaultBackend = maybe cache return =<< Annex.getState Annex.backend
where where
cache = do cache = do
n <- maybe (annexBackend <$> Annex.getGitConfig) (return . Just) n <- maybe (annexBackend <$> Annex.getGitConfig) (return . Just)
=<< Annex.getState Annex.forcebackend =<< Annex.getRead Annex.forcebackend
b <- case n of b <- case n of
Just name | valid name -> lookupname name Just name | valid name -> lookupname name
_ -> pure (Prelude.head builtinList) _ -> pure (Prelude.head builtinList)
@ -79,7 +79,7 @@ unknownBackendVarietyMessage v =
- That can be configured on a per-file basis in the gitattributes file, - That can be configured on a per-file basis in the gitattributes file,
- or forced with --backend. -} - or forced with --backend. -}
chooseBackend :: RawFilePath -> Annex (Maybe Backend) chooseBackend :: RawFilePath -> Annex (Maybe Backend)
chooseBackend f = Annex.getState Annex.forcebackend >>= go chooseBackend f = Annex.getRead Annex.forcebackend >>= go
where where
go Nothing = maybeLookupBackendVariety . parseKeyVariety . encodeBS go Nothing = maybeLookupBackendVariety . parseKeyVariety . encodeBS
=<< checkAttr "annex.backend" f =<< checkAttr "annex.backend" f

2
Backend/Hash.hs
View file

@ -120,7 +120,7 @@ keyValueE hash source meterupdate =
checkKeyChecksum :: Hash -> Key -> RawFilePath -> Annex Bool checkKeyChecksum :: Hash -> Key -> RawFilePath -> Annex Bool
checkKeyChecksum hash key file = catchIOErrorType HardwareFault hwfault $ do checkKeyChecksum hash key file = catchIOErrorType HardwareFault hwfault $ do
fast <- Annex.getState Annex.fast fast <- Annex.getRead Annex.fast
exists <- liftIO $ R.doesPathExist file exists <- liftIO $ R.doesPathExist file
case (exists, fast) of case (exists, fast) of
(True, False) -> do (True, False) -> do

8
CmdLine/GitAnnex/Options.hs
View file

@ -45,12 +45,12 @@ import Annex.Concurrent
-- although not always used. -- although not always used.
gitAnnexGlobalOptions :: [GlobalOption] gitAnnexGlobalOptions :: [GlobalOption]
gitAnnexGlobalOptions = commonGlobalOptions ++ gitAnnexGlobalOptions = commonGlobalOptions ++
[ globalOption (setAnnexState . setnumcopies) $ option auto [ globalOption setnumcopies $ option auto
( long "numcopies" <> short 'N' <> metavar paramNumber ( long "numcopies" <> short 'N' <> metavar paramNumber
<> help "override desired number of copies" <> help "override desired number of copies"
<> hidden <> hidden
) )
, globalOption (setAnnexState . setmincopies) $ option auto , globalOption setmincopies $ option auto
( long "mincopies" <> short 'N' <> metavar paramNumber ( long "mincopies" <> short 'N' <> metavar paramNumber
<> help "override minimum number of copies" <> help "override minimum number of copies"
<> hidden <> hidden
@ -100,8 +100,8 @@ gitAnnexGlobalOptions = commonGlobalOptions ++
) )
] ]
where where
setnumcopies n = Annex.changeState $ \s -> s { Annex.forcenumcopies = Just $ configuredNumCopies n } setnumcopies n = setAnnexRead $ \rd -> rd { Annex.forcenumcopies = Just $ configuredNumCopies n }
setmincopies n = Annex.changeState $ \s -> s { Annex.forcemincopies = Just $ configuredMinCopies n } setmincopies n = setAnnexRead $ \rd -> rd { Annex.forcemincopies = Just $ configuredMinCopies n }
setuseragent v = Annex.changeState $ \s -> s { Annex.useragent = Just v } setuseragent v = Annex.changeState $ \s -> s { Annex.useragent = Just v }
setgitconfig v = Annex.addGitConfigOverride v setgitconfig v = Annex.addGitConfigOverride v
setdesktopnotify v = Annex.changeState $ \s -> s { Annex.desktopnotify = Annex.desktopnotify s <> v } setdesktopnotify v = Annex.changeState $ \s -> s { Annex.desktopnotify = Annex.desktopnotify s <> v }

12
CmdLine/Option.hs
View file

@ -25,12 +25,12 @@ import Annex.Debug
-- Global options accepted by both git-annex and git-annex-shell sub-commands. -- Global options accepted by both git-annex and git-annex-shell sub-commands.
commonGlobalOptions :: [GlobalOption] commonGlobalOptions :: [GlobalOption]
commonGlobalOptions = commonGlobalOptions =
[ globalFlag (setAnnexState $ setforce True) [ globalFlag (setforce True)
( long "force" ( long "force"
<> help "allow actions that may lose annexed data" <> help "allow actions that may lose annexed data"
<> hidden <> hidden
) )
, globalFlag (setAnnexState $ setfast True) , globalFlag (setfast True)
( long "fast" <> short 'F' ( long "fast" <> short 'F'
<> help "avoid slow operations" <> help "avoid slow operations"
<> hidden <> hidden
@ -67,12 +67,12 @@ commonGlobalOptions =
) )
] ]
where where
setforce v = Annex.changeState $ \s -> s { Annex.force = v } setforce v = setAnnexRead $ \rd -> rd { Annex.force = v }
setfast v = Annex.changeState $ \s -> s { Annex.fast = v } setfast v = setAnnexRead $ \rd -> rd { Annex.fast = v }
setforcebackend v = setAnnexState $ setforcebackend v = setAnnexRead $
Annex.changeState $ \s -> s { Annex.forcebackend = Just v } \rd -> rd { Annex.forcebackend = Just v }
setdebug v = mconcat setdebug v = mconcat
[ setAnnexRead $ \rd -> rd { Annex.debugenabled = v } [ setAnnexRead $ \rd -> rd { Annex.debugenabled = v }

4
CmdLine/Seek.hs
View file

@ -64,7 +64,7 @@ withFilesInGitAnnex ww a l = seekFilteredKeys a $
seekHelper fst3 ww LsFiles.inRepoDetails l seekHelper fst3 ww LsFiles.inRepoDetails l
withFilesInGitAnnexNonRecursive :: WarnUnmatchWhen -> String -> AnnexedFileSeeker -> WorkTreeItems -> CommandSeek withFilesInGitAnnexNonRecursive :: WarnUnmatchWhen -> String -> AnnexedFileSeeker -> WorkTreeItems -> CommandSeek
withFilesInGitAnnexNonRecursive ww needforce a (WorkTreeItems l) = ifM (Annex.getState Annex.force) withFilesInGitAnnexNonRecursive ww needforce a (WorkTreeItems l) = ifM (Annex.getRead Annex.force)
( withFilesInGitAnnex ww a (WorkTreeItems l) ( withFilesInGitAnnex ww a (WorkTreeItems l)
, if null l , if null l
then giveup needforce then giveup needforce
@ -90,7 +90,7 @@ withFilesInGitAnnexNonRecursive _ _ _ NoWorkTreeItems = noop
withFilesNotInGit :: CheckGitIgnore -> WarnUnmatchWhen -> ((SeekInput, RawFilePath) -> CommandSeek) -> WorkTreeItems -> CommandSeek withFilesNotInGit :: CheckGitIgnore -> WarnUnmatchWhen -> ((SeekInput, RawFilePath) -> CommandSeek) -> WorkTreeItems -> CommandSeek
withFilesNotInGit (CheckGitIgnore ci) ww a l = do withFilesNotInGit (CheckGitIgnore ci) ww a l = do
force <- Annex.getState Annex.force force <- Annex.getRead Annex.force
let include_ignored = force || not ci let include_ignored = force || not ci
seekFiltered (const (pure True)) a $ seekFiltered (const (pure True)) a $
seekHelper id ww (const $ LsFiles.notInRepo [] include_ignored) l seekHelper id ww (const $ LsFiles.notInRepo [] include_ignored) l

2
Command/Add.hs
View file

@ -89,7 +89,7 @@ seek o = startConcurrency commandStages $ do
s <- liftIO $ R.getSymbolicLinkStatus file s <- liftIO $ R.getSymbolicLinkStatus file
ifM (pure (annexdotfiles || not (dotfile file)) ifM (pure (annexdotfiles || not (dotfile file))
<&&> (checkFileMatcher largematcher file <&&> (checkFileMatcher largematcher file
<||> Annex.getState Annex.force)) <||> Annex.getRead Annex.force))
( start si file addunlockedmatcher ( start si file addunlockedmatcher
, if includingsmall , if includingsmall
then ifM (annexAddSmallFiles <$> Annex.getGitConfig) then ifM (annexAddSmallFiles <$> Annex.getGitConfig)

4
Command/AddUrl.hs
View file

@ -191,7 +191,7 @@ downloadRemoteFile :: AddUnlockedMatcher -> Remote -> DownloadOptions -> URLStri
downloadRemoteFile addunlockedmatcher r o uri file sz = checkCanAdd o file $ \canadd -> do downloadRemoteFile addunlockedmatcher r o uri file sz = checkCanAdd o file $ \canadd -> do
let urlkey = Backend.URL.fromUrl uri sz let urlkey = Backend.URL.fromUrl uri sz
createWorkTreeDirectory (parentDir file) createWorkTreeDirectory (parentDir file)
ifM (Annex.getState Annex.fast <||> pure (relaxedOption o)) ifM (Annex.getRead Annex.fast <||> pure (relaxedOption o))
( do ( do
addWorkTree canadd addunlockedmatcher (Remote.uuid r) loguri file urlkey Nothing addWorkTree canadd addunlockedmatcher (Remote.uuid r) loguri file urlkey Nothing
return (Just urlkey) return (Just urlkey)
@ -305,7 +305,7 @@ addUrlChecked o url file u checkexistssize key =
-} -}
addUrlFile :: AddUnlockedMatcher -> DownloadOptions -> URLString -> Url.UrlInfo -> RawFilePath -> Annex (Maybe Key) addUrlFile :: AddUnlockedMatcher -> DownloadOptions -> URLString -> Url.UrlInfo -> RawFilePath -> Annex (Maybe Key)
addUrlFile addunlockedmatcher o url urlinfo file = addUrlFile addunlockedmatcher o url urlinfo file =
ifM (Annex.getState Annex.fast <||> pure (relaxedOption o)) ifM (Annex.getRead Annex.fast <||> pure (relaxedOption o))
( nodownloadWeb addunlockedmatcher o url urlinfo file ( nodownloadWeb addunlockedmatcher o url urlinfo file
, downloadWeb addunlockedmatcher o url urlinfo file , downloadWeb addunlockedmatcher o url urlinfo file
) )

2
Command/Drop.hs
View file

@ -201,7 +201,7 @@ doDrop
-> (Maybe SafeDropProof -> CommandPerform, CommandPerform) -> (Maybe SafeDropProof -> CommandPerform, CommandPerform)
-> CommandPerform -> CommandPerform
doDrop pcc dropfrom contentlock key afile numcopies mincopies skip preverified check (dropaction, nodropaction) = doDrop pcc dropfrom contentlock key afile numcopies mincopies skip preverified check (dropaction, nodropaction) =
ifM (Annex.getState Annex.force) ifM (Annex.getRead Annex.force)
( dropaction Nothing ( dropaction Nothing
, ifM (checkRequiredContent pcc dropfrom key afile) , ifM (checkRequiredContent pcc dropfrom key afile)
( verifyEnoughCopiesToDrop nolocmsg key ( verifyEnoughCopiesToDrop nolocmsg key

2
Command/DropKey.hs
View file

@ -31,7 +31,7 @@ optParser desc = DropKeyOptions
seek :: DropKeyOptions -> CommandSeek seek :: DropKeyOptions -> CommandSeek
seek o = do seek o = do
unlessM (Annex.getState Annex.force) $ unlessM (Annex.getRead Annex.force) $
giveup "dropkey can cause data loss; use --force if you're sure you want to do this" giveup "dropkey can cause data loss; use --force if you're sure you want to do this"
case batchOption o of case batchOption o of
NoBatch -> withKeys (commandAction . start) (toDrop o) NoBatch -> withKeys (commandAction . start) (toDrop o)

2
Command/DropUnused.hs
View file

@ -53,7 +53,7 @@ perform from numcopies mincopies key = case from of
Nothing -> ifM (inAnnex key) Nothing -> ifM (inAnnex key)
( droplocal ( droplocal
, ifM (objectFileExists key) , ifM (objectFileExists key)
( ifM (Annex.getState Annex.force) ( ifM (Annex.getRead Annex.force)
( droplocal ( droplocal
, do , do
warning "Annexed object has been modified and dropping it would probably lose the only copy. Run this command with --force if you want to drop it anyway." warning "Annexed object has been modified and dropping it would probably lose the only copy. Run this command with --force if you want to drop it anyway."

2
Command/Export.hs
View file

@ -96,7 +96,7 @@ seek o = startConcurrency commandStages $ do
db <- openDb (uuid r) db <- openDb (uuid r)
writeLockDbWhile db $ do writeLockDbWhile db $ do
changeExport r db tree changeExport r db tree
unlessM (Annex.getState Annex.fast) $ do unlessM (Annex.getRead Annex.fast) $ do
void $ fillExport r db tree mtbcommitsha void $ fillExport r db tree mtbcommitsha
closeDb db closeDb db

2
Command/Forget.hs
View file

@ -40,7 +40,7 @@ start o = starting "forget" ai si $ do
let ts = if dropDead o let ts = if dropDead o
then addTransition c ForgetDeadRemotes basets then addTransition c ForgetDeadRemotes basets
else basets else basets
perform ts =<< Annex.getState Annex.force perform ts =<< Annex.getRead Annex.force
where where
ai = ActionItemOther (Just (fromRef Branch.name)) ai = ActionItemOther (Just (fromRef Branch.name))
si = SeekInput [] si = SeekInput []

2
Command/FromKey.hs
View file

@ -46,7 +46,7 @@ seek o = do
-- older way of enabling batch input, does not support BatchNull -- older way of enabling batch input, does not support BatchNull
(NoBatch, []) -> seekBatch matcher (BatchFormat BatchLine (BatchKeys False)) (NoBatch, []) -> seekBatch matcher (BatchFormat BatchLine (BatchKeys False))
(NoBatch, ps) -> do (NoBatch, ps) -> do
force <- Annex.getState Annex.force force <- Annex.getRead Annex.force
withPairs (commandAction . start matcher force) ps withPairs (commandAction . start matcher force) ps
seekBatch :: AddUnlockedMatcher -> BatchFormat -> CommandSeek seekBatch :: AddUnlockedMatcher -> BatchFormat -> CommandSeek

2
Command/Fsck.hs
View file

@ -195,7 +195,7 @@ performRemote key afile backend numcopies remote =
getfile tmp = ifM (checkDiskSpace (Just (P.takeDirectory tmp)) key 0 True) getfile tmp = ifM (checkDiskSpace (Just (P.takeDirectory tmp)) key 0 True)
( ifM (getcheap tmp) ( ifM (getcheap tmp)
( return (Just (Right UnVerified)) ( return (Just (Right UnVerified))
, ifM (Annex.getState Annex.fast) , ifM (Annex.getRead Annex.fast)
( return Nothing ( return Nothing
, Just <$> tryNonAsync (getfile' tmp) , Just <$> tryNonAsync (getfile' tmp)
) )

4
Command/Import.hs
View file

@ -173,13 +173,13 @@ startLocal o addunlockedmatcher largematcher mode (srcfile, destfile) =
Nothing -> importfilechecked ld k Nothing -> importfilechecked ld k
Just s Just s
| isDirectory s -> notoverwriting "(is a directory)" | isDirectory s -> notoverwriting "(is a directory)"
| isSymbolicLink s -> ifM (Annex.getState Annex.force) | isSymbolicLink s -> ifM (Annex.getRead Annex.force)
( do ( do
liftIO $ removeWhenExistsWith R.removeLink destfile liftIO $ removeWhenExistsWith R.removeLink destfile
importfilechecked ld k importfilechecked ld k
, notoverwriting "(is a symlink)" , notoverwriting "(is a symlink)"
) )
| otherwise -> ifM (Annex.getState Annex.force) | otherwise -> ifM (Annex.getRead Annex.force)
( do ( do
liftIO $ removeWhenExistsWith R.removeLink destfile liftIO $ removeWhenExistsWith R.removeLink destfile
importfilechecked ld k importfilechecked ld k

6
Command/ImportFeed.hs
View file

@ -135,7 +135,7 @@ data Cache = Cache
} }
getCache :: Maybe String -> Annex Cache getCache :: Maybe String -> Annex Cache
getCache opttemplate = ifM (Annex.getState Annex.force) getCache opttemplate = ifM (Annex.getRead Annex.force)
( ret S.empty S.empty ( ret S.empty S.empty
, do , do
showStart "importfeed" "gathering known urls" (SeekInput []) showStart "importfeed" "gathering known urls" (SeekInput [])
@ -246,12 +246,12 @@ performDownload' started addunlockedmatcher opts cache todownload = case locatio
-- to avoid adding it a second time. -- to avoid adding it a second time.
let quviurl = setDownloader linkurl QuviDownloader let quviurl = setDownloader linkurl QuviDownloader
checkknown mediaurl $ checkknown quviurl $ checkknown mediaurl $ checkknown quviurl $
ifM (Annex.getState Annex.fast <||> pure (relaxedOption (downloadOptions opts))) ifM (Annex.getRead Annex.fast <||> pure (relaxedOption (downloadOptions opts)))
( addmediafast linkurl mediaurl mediakey ( addmediafast linkurl mediaurl mediakey
, downloadmedia linkurl mediaurl mediakey , downloadmedia linkurl mediaurl mediakey
) )
where where
forced = Annex.getState Annex.force forced = Annex.getRead Annex.force
{- Avoids downloading any items that are already known to be {- Avoids downloading any items that are already known to be
- associated with a file in the annex, unless forced. -} - associated with a file in the annex, unless forced. -}

6
Command/Info.hs
View file

@ -238,7 +238,7 @@ uuidInfo o u si = showCustom (unwords ["info", fromUUID u]) si $ do
selStats :: [Stat] -> [Stat] -> Annex [Stat] selStats :: [Stat] -> [Stat] -> Annex [Stat]
selStats fast_stats slow_stats = do selStats fast_stats slow_stats = do
fast <- Annex.getState Annex.fast fast <- Annex.getRead Annex.fast
return $ if fast return $ if fast
then fast_stats then fast_stats
else fast_stats ++ slow_stats else fast_stats ++ slow_stats
@ -597,7 +597,7 @@ cachedRepoData = repoData <$> get
getDirStatInfo :: InfoOptions -> FilePath -> Annex StatInfo getDirStatInfo :: InfoOptions -> FilePath -> Annex StatInfo
getDirStatInfo o dir = do getDirStatInfo o dir = do
fast <- Annex.getState Annex.fast fast <- Annex.getRead Annex.fast
matcher <- Limit.getMatcher matcher <- Limit.getMatcher
(presentdata, referenceddata, numcopiesstats, repodata) <- (presentdata, referenceddata, numcopiesstats, repodata) <-
Command.Unused.withKeysFilesReferencedIn dir initial Command.Unused.withKeysFilesReferencedIn dir initial
@ -625,7 +625,7 @@ getDirStatInfo o dir = do
getTreeStatInfo :: InfoOptions -> Git.Ref -> Annex (Maybe StatInfo) getTreeStatInfo :: InfoOptions -> Git.Ref -> Annex (Maybe StatInfo)
getTreeStatInfo o r = do getTreeStatInfo o r = do
fast <- Annex.getState Annex.fast fast <- Annex.getRead Annex.fast
-- git lstree filenames start with a leading "./" that prevents -- git lstree filenames start with a leading "./" that prevents
-- matching, and also things like --include are supposed to -- matching, and also things like --include are supposed to
-- match relative to the current directory, which does not make -- match relative to the current directory, which does not make

2
Command/Lock.hs
View file

@ -50,7 +50,7 @@ start si file key = ifM (isJust <$> isAnnexLink file)
go Nothing = go Nothing =
ifM (isUnmodified key file) ifM (isUnmodified key file)
( cont ( cont
, ifM (Annex.getState Annex.force) , ifM (Annex.getRead Annex.force)
( cont ( cont
, errorModified , errorModified
) )

2
Command/Map.hs
View file

@ -52,7 +52,7 @@ start = startingNoMessage (ActionItemOther Nothing) $ do
liftIO $ writeFile file (drawMap rs trustmap umap) liftIO $ writeFile file (drawMap rs trustmap umap)
next $ next $
ifM (Annex.getState Annex.fast) ifM (Annex.getRead Annex.fast)
( runViewer file [] ( runViewer file []
, runViewer file , runViewer file
[ ("xdot", [File file]) [ ("xdot", [File file])

2
Command/Migrate.hs
View file

@ -50,7 +50,7 @@ seek o = withFilesInGitAnnex ww seeker =<< workTreeItems ww (migrateThese o)
start :: MigrateOptions -> SeekInput -> RawFilePath -> Key -> CommandStart start :: MigrateOptions -> SeekInput -> RawFilePath -> Key -> CommandStart
start o si file key = do start o si file key = do
forced <- Annex.getState Annex.force forced <- Annex.getRead Annex.force
v <- Backend.getBackend (fromRawFilePath file) key v <- Backend.getBackend (fromRawFilePath file) key
case v of case v of
Nothing -> stop Nothing -> stop

4
Command/Move.hs
View file

@ -118,7 +118,7 @@ toStart removewhen afile key ai si dest = do
toStart' :: Remote -> RemoveWhen -> AssociatedFile -> Key -> ActionItem -> SeekInput -> CommandStart toStart' :: Remote -> RemoveWhen -> AssociatedFile -> Key -> ActionItem -> SeekInput -> CommandStart
toStart' dest removewhen afile key ai si = do toStart' dest removewhen afile key ai si = do
fast <- Annex.getState Annex.fast fast <- Annex.getRead Annex.fast
if fast && removewhen == RemoveNever if fast && removewhen == RemoveNever
then ifM (expectedPresent dest key) then ifM (expectedPresent dest key)
( stop ( stop
@ -334,7 +334,7 @@ willDropMakeItWorse srcuuid destuuid (DestStartedWithCopy deststartedwithcopy _)
, unlessforced DropWorse , unlessforced DropWorse
) )
where where
unlessforced r = ifM (Annex.getState Annex.force) unlessforced r = ifM (Annex.getRead Annex.force)
( return DropAllowed ( return DropAllowed
, return r , return r
) )

2
Command/ReKey.hs
View file

@ -75,7 +75,7 @@ perform file oldkey newkey = do
ifM (inAnnex oldkey) ifM (inAnnex oldkey)
( unlessM (linkKey file oldkey newkey) $ ( unlessM (linkKey file oldkey newkey) $
giveup "failed creating link from old to new key" giveup "failed creating link from old to new key"
, unlessM (Annex.getState Annex.force) $ , unlessM (Annex.getRead Annex.force) $
giveup $ fromRawFilePath file ++ " is not available (use --force to override)" giveup $ fromRawFilePath file ++ " is not available (use --force to override)"
) )
next $ cleanup file newkey next $ cleanup file newkey

2
Command/Repair.hs
View file

@ -27,7 +27,7 @@ seek = withNothing (commandAction start)
start :: CommandStart start :: CommandStart
start = starting "repair" (ActionItemOther Nothing) (SeekInput []) $ start = starting "repair" (ActionItemOther Nothing) (SeekInput []) $
next $ runRepair =<< Annex.getState Annex.force next $ runRepair =<< Annex.getRead Annex.force
runRepair :: Bool -> Annex Bool runRepair :: Bool -> Annex Bool
runRepair forced = do runRepair forced = do

2
Command/Sync.hs
View file

@ -324,7 +324,7 @@ syncRemotes ps = do
syncRemotes' :: [String] -> [Remote] -> Annex [Remote] syncRemotes' :: [String] -> [Remote] -> Annex [Remote]
syncRemotes' ps available = syncRemotes' ps available =
ifM (Annex.getState Annex.fast) ( fastest <$> wanted , wanted ) ifM (Annex.getRead Annex.fast) ( fastest <$> wanted , wanted )
where where
wanted wanted
| null ps = filterM good (concat $ Remote.byCost available) | null ps = filterM good (concat $ Remote.byCost available)

2
Command/TestRemote.hs
View file

@ -74,7 +74,7 @@ seek = commandAction . start
start :: TestRemoteOptions -> CommandStart start :: TestRemoteOptions -> CommandStart
start o = starting "testremote" (ActionItemOther (Just (testRemote o))) si $ do start o = starting "testremote" (ActionItemOther (Just (testRemote o))) si $ do
fast <- Annex.getState Annex.fast fast <- Annex.getRead Annex.fast
cache <- liftIO newRemoteVariantCache cache <- liftIO newRemoteVariantCache
r <- either giveup (disableExportTree cache) r <- either giveup (disableExportTree cache)
=<< Remote.byName' (testRemote o) =<< Remote.byName' (testRemote o)

2
Command/Trust.hs
View file

@ -33,7 +33,7 @@ trustCommand c level = withWords (commandAction . start)
starting c (ActionItemOther (Just name)) si (perform name u) starting c (ActionItemOther (Just name)) si (perform name u)
perform name uuid = do perform name uuid = do
when (level >= Trusted) $ when (level >= Trusted) $
unlessM (Annex.getState Annex.force) $ unlessM (Annex.getRead Annex.force) $
giveup $ trustedNeedsForce name giveup $ trustedNeedsForce name
trustSet uuid level trustSet uuid level
when (level == DeadTrusted) $ when (level == DeadTrusted) $

26
Command/Unannex.hs
View file

@ -26,24 +26,24 @@ cmd = withGlobalOptions [annexedMatchingOptions] $
paramPaths (withParams seek) paramPaths (withParams seek)
seek :: CmdParams -> CommandSeek seek :: CmdParams -> CommandSeek
seek ps = withFilesInGitAnnex ww seeker =<< workTreeItems ww ps seek ps = withFilesInGitAnnex ww (seeker False) =<< workTreeItems ww ps
where where
ww = WarnUnmatchLsFiles ww = WarnUnmatchLsFiles
seeker :: AnnexedFileSeeker seeker :: Bool -> AnnexedFileSeeker
seeker = AnnexedFileSeeker seeker fast = AnnexedFileSeeker
{ startAction = start { startAction = start fast
, checkContentPresent = Just True , checkContentPresent = Just True
, usesLocationLog = False , usesLocationLog = False
} }
start :: SeekInput -> RawFilePath -> Key -> CommandStart start :: Bool -> SeekInput -> RawFilePath -> Key -> CommandStart
start si file key = start fast si file key =
starting "unannex" (mkActionItem (key, file)) si $ starting "unannex" (mkActionItem (key, file)) si $
perform file key perform fast file key
perform :: RawFilePath -> Key -> CommandPerform perform :: Bool -> RawFilePath -> Key -> CommandPerform
perform file key = do perform fast file key = do
Annex.Queue.addCommand [] "rm" Annex.Queue.addCommand [] "rm"
[ Param "--cached" [ Param "--cached"
, Param "--force" , Param "--force"
@ -58,7 +58,7 @@ perform file key = do
-- (cached in git). -- (cached in git).
Just key' -> do Just key' -> do
cleanupdb cleanupdb
next $ cleanup file key' next $ cleanup fast file key'
-- If the file is unlocked, it can be unmodified or not and -- If the file is unlocked, it can be unmodified or not and
-- does not need to be replaced either way. -- does not need to be replaced either way.
Nothing -> do Nothing -> do
@ -71,11 +71,11 @@ perform file key = do
maybe noop Database.Keys.removeInodeCache maybe noop Database.Keys.removeInodeCache
=<< withTSDelta (liftIO . genInodeCache file) =<< withTSDelta (liftIO . genInodeCache file)
cleanup :: RawFilePath -> Key -> CommandCleanup cleanup :: Bool -> RawFilePath -> Key -> CommandCleanup
cleanup file key = do cleanup fast file key = do
liftIO $ removeFile (fromRawFilePath file) liftIO $ removeFile (fromRawFilePath file)
src <- calcRepo (gitAnnexLocation key) src <- calcRepo (gitAnnexLocation key)
ifM (Annex.getState Annex.fast) ifM (pure fast <||> Annex.getRead Annex.fast)
( do ( do
-- Only make a hard link if the annexed file does not -- Only make a hard link if the annexed file does not
-- already have other hard links pointing at it. This -- already have other hard links pointing at it. This

4
Command/Uninit.hs
View file

@ -8,7 +8,6 @@
module Command.Uninit where module Command.Uninit where
import Command import Command
import qualified Annex
import qualified Git import qualified Git
import qualified Git.Command import qualified Git.Command
import qualified Git.Ref import qualified Git.Ref
@ -54,8 +53,7 @@ seek ps = do
WarnUnmatchWorkTreeItems WarnUnmatchWorkTreeItems
(\(_, f) -> commandAction $ whenAnnexed (startCheckIncomplete . fromRawFilePath) f) (\(_, f) -> commandAction $ whenAnnexed (startCheckIncomplete . fromRawFilePath) f)
l l
Annex.changeState $ \s -> s { Annex.fast = True } withFilesInGitAnnex ww (Command.Unannex.seeker True) l
withFilesInGitAnnex ww Command.Unannex.seeker l
finish finish
where where
ww = WarnUnmatchLsFiles ww = WarnUnmatchLsFiles

2
Command/Unused.hs
View file

@ -77,7 +77,7 @@ start o = do
checkUnused :: RefSpec -> CommandPerform checkUnused :: RefSpec -> CommandPerform
checkUnused refspec = chain 0 checkUnused refspec = chain 0
[ check "" unusedMsg $ findunused =<< Annex.getState Annex.fast [ check "" unusedMsg $ findunused =<< Annex.getRead Annex.fast
, check "bad" staleBadMsg $ staleKeysPrune gitAnnexBadDir False , check "bad" staleBadMsg $ staleKeysPrune gitAnnexBadDir False
, check "tmp" staleTmpMsg $ staleKeysPrune gitAnnexTmpObjectDir True , check "tmp" staleTmpMsg $ staleKeysPrune gitAnnexTmpObjectDir True
] ]

2
Remote/GitLFS.hs
View file

@ -149,7 +149,7 @@ mySetup ss mu _ c gc = do
(c', _encsetup) <- encryptionSetup c gc (c', _encsetup) <- encryptionSetup c gc
pc <- either giveup return . parseRemoteConfig c' =<< configParser remote c' pc <- either giveup return . parseRemoteConfig c' =<< configParser remote c'
let failinitunlessforced msg = case ss of let failinitunlessforced msg = case ss of
Init -> unlessM (Annex.getState Annex.force) (giveup msg) Init -> unlessM (Annex.getRead Annex.force) (giveup msg)
Enable _ -> noop Enable _ -> noop
AutoEnable _ -> noop AutoEnable _ -> noop
case (isEncrypted pc, Git.GCrypt.urlPrefix `isPrefixOf` url) of case (isEncrypted pc, Git.GCrypt.urlPrefix `isPrefixOf` url) of

2
Remote/Helper/Encryptable.hs
View file

@ -197,7 +197,7 @@ encryptionSetup c gc = do
cipher <- liftIO a cipher <- liftIO a
showNote (describeCipher cipher) showNote (describeCipher cipher)
return (storeCipher cipher c', EncryptionIsSetup) return (storeCipher cipher c', EncryptionIsSetup)
highRandomQuality = ifM (Annex.getState Annex.fast) highRandomQuality = ifM (Annex.getRead Annex.fast)
( return False ( return False
, case parseHighRandomQuality (fromProposedAccepted <$> M.lookup highRandomQualityField c) of , case parseHighRandomQuality (fromProposedAccepted <$> M.lookup highRandomQualityField c) of
Left err -> giveup err Left err -> giveup err

2
Remote/S3.hs
View file

@ -312,7 +312,7 @@ s3Setup' ss u mcreds c gc
use archiveconfig pc' info use archiveconfig pc' info
checkexportimportsafe c' info = checkexportimportsafe c' info =
unlessM (Annex.getState Annex.force) $ unlessM (Annex.getRead Annex.force) $
checkexportimportsafe' c' info checkexportimportsafe' c' info
checkexportimportsafe' c' info checkexportimportsafe' c' info
| versioning info = return () | versioning info = return ()

2
Upgrade/V9.hs
View file

@ -27,7 +27,7 @@ upgrade automatic
( return UpgradeDeferred ( return UpgradeDeferred
, performUpgrade automatic , performUpgrade automatic
) )
| otherwise = ifM (oldprocessesdanger <&&> (not <$> Annex.getState Annex.force)) | otherwise = ifM (oldprocessesdanger <&&> (not <$> Annex.getRead Annex.force))
( do ( do
warning $ unlines unsafeupgrade warning $ unlines unsafeupgrade
return UpgradeDeferred return UpgradeDeferred

7
doc/todo/move_readonly_values_to_AnnexRead.mdwn
View file

@ -4,9 +4,4 @@ anything that never needs to be modified while git-annex is running can be
moved to AnnexRead for a performance win and also to make clean how it's moved to AnnexRead for a performance win and also to make clean how it's
used. --[[Joey]] used. --[[Joey]]
The easy things have been moved now, but some things like Annex.force and Many things have been moved, but there are certainly others that can be.
Annex.fast and Annex.getGitConfig would be good to move. Moving those would
involve running argument processing outside the Annex monad. The main
reason argument processing runs in the Annex monad is to set those values,
but there may be other reasons too, so this will be a large set of changes
that need to all happen together. --[[Joey]]