diff --git a/Annex.hs b/Annex.hs index 0856e7fc05..abe947444b 100644 --- a/Annex.hs +++ b/Annex.hs @@ -123,6 +123,11 @@ data AnnexRead = AnnexRead , debugenabled :: Bool , debugselector :: DebugSelector , ciphers :: TMVar (M.Map StorableCipher Cipher) + , fast :: Bool + , force :: Bool + , forcenumcopies :: Maybe NumCopies + , forcemincopies :: Maybe MinCopies + , forcebackend :: Maybe String } newAnnexRead :: GitConfig -> IO AnnexRead @@ -144,6 +149,11 @@ newAnnexRead c = do , debugenabled = annexDebug c , debugselector = debugSelectorFromGitConfig c , ciphers = cm + , fast = False + , force = False + , forcebackend = Nothing + , forcenumcopies = Nothing + , forcemincopies = Nothing } -- Values that can change while running an Annex action. @@ -159,8 +169,6 @@ data AnnexState = AnnexState , remotes :: [Types.Remote.RemoteA Annex] , output :: MessageState , concurrency :: ConcurrencySetting - , force :: Bool - , fast :: Bool , daemon :: Bool , branchstate :: BranchState , repoqueue :: Maybe (Git.Queue.Queue Annex) @@ -168,11 +176,8 @@ data AnnexState = AnnexState , hashobjecthandle :: Maybe HashObjectHandle , checkattrhandle :: Maybe (ResourcePool CheckAttrHandle) , checkignorehandle :: Maybe (ResourcePool CheckIgnoreHandle) - , forcebackend :: Maybe String , globalnumcopies :: Maybe NumCopies , globalmincopies :: Maybe MinCopies - , forcenumcopies :: Maybe NumCopies - , forcemincopies :: Maybe MinCopies , limit :: ExpandableMatcher Annex , timelimit :: Maybe (Duration, POSIXTime) , sizelimit :: Maybe (TVar Integer) @@ -220,8 +225,6 @@ newAnnexState c r = do , remotes = [] , output = o , concurrency = ConcurrencyCmdLine NonConcurrent - , force = False - , fast = False , daemon = False , branchstate = startBranchState , repoqueue = Nothing @@ -229,11 +232,8 @@ newAnnexState c r = do , hashobjecthandle = Nothing , checkattrhandle = Nothing , checkignorehandle = Nothing - , forcebackend = Nothing , globalnumcopies = Nothing , globalmincopies = Nothing - , forcenumcopies = Nothing - , forcemincopies = Nothing , limit = BuildingMatcher [] , timelimit = Nothing , sizelimit = Nothing diff --git a/Annex/AdjustedBranch.hs b/Annex/AdjustedBranch.hs index 27253016e7..4a55d4647a 100644 --- a/Annex/AdjustedBranch.hs +++ b/Annex/AdjustedBranch.hs @@ -207,7 +207,7 @@ enterAdjustedBranch adj = inRepo Git.Branch.current >>= \case go currbranch = do let origbranch = fromAdjustedBranch currbranch 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 mapM_ (warning . unwords) [ [ "adjusted branch" diff --git a/Annex/CheckIgnore.hs b/Annex/CheckIgnore.hs index 42e635b667..d3c03f210a 100644 --- a/Annex/CheckIgnore.hs +++ b/Annex/CheckIgnore.hs @@ -25,7 +25,7 @@ newtype CheckGitIgnore = CheckGitIgnore Bool checkIgnored :: CheckGitIgnore -> RawFilePath -> Annex Bool checkIgnored (CheckGitIgnore False) _ = pure False checkIgnored (CheckGitIgnore True) file = - ifM (Annex.getState Annex.force) + ifM (Annex.getRead Annex.force) ( pure False , withCheckIgnoreHandle $ \h -> liftIO $ Git.checkIgnored h file ) diff --git a/Annex/Content/LowLevel.hs b/Annex/Content/LowLevel.hs index c686e462e2..0271fa65de 100644 --- a/Annex/Content/LowLevel.hs +++ b/Annex/Content/LowLevel.hs @@ -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 - as not all keys know their size. -} 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 , do -- We can't get inprogress and free at the same diff --git a/Annex/Ingest.hs b/Annex/Ingest.hs index 6e5224b484..89dc8aceaa 100644 --- a/Annex/Ingest.hs +++ b/Annex/Ingest.hs @@ -325,7 +325,7 @@ addSymlink file key mcache = do - checked in, CheckGitIgnore True has no effect. -} gitAddParams :: CheckGitIgnore -> Annex [CommandParam] -gitAddParams (CheckGitIgnore True) = ifM (Annex.getState Annex.force) +gitAddParams (CheckGitIgnore True) = ifM (Annex.getRead Annex.force) ( return [Param "-f"] , return [] ) diff --git a/Annex/NumCopies.hs b/Annex/NumCopies.hs index d460856465..1c4fed1fcb 100644 --- a/Annex/NumCopies.hs +++ b/Annex/NumCopies.hs @@ -57,11 +57,11 @@ deprecatedNumCopies = annexNumCopies <$> Annex.getGitConfig {- Value forced on the command line by --numcopies. -} getForcedNumCopies :: Annex (Maybe NumCopies) -getForcedNumCopies = Annex.getState Annex.forcenumcopies +getForcedNumCopies = Annex.getRead Annex.forcenumcopies {- Value forced on the command line by --mincopies. -} getForcedMinCopies :: Annex (Maybe MinCopies) -getForcedMinCopies = Annex.getState Annex.forcemincopies +getForcedMinCopies = Annex.getRead Annex.forcemincopies {- NumCopies value from any of the non-.gitattributes configuration - sources. -} diff --git a/Annex/YoutubeDl.hs b/Annex/YoutubeDl.hs index 659a9adc91..e466f01eba 100644 --- a/Annex/YoutubeDl.hs +++ b/Annex/YoutubeDl.hs @@ -118,7 +118,7 @@ youtubeDl' url workdir p uo -- and any files in the workdir that it may have partially downloaded -- before. youtubeDlMaxSize :: FilePath -> Annex (Either String [CommandParam]) -youtubeDlMaxSize workdir = ifM (Annex.getState Annex.force) +youtubeDlMaxSize workdir = ifM (Annex.getRead Annex.force) ( return $ Right [] , liftIO (getDiskFree workdir) >>= \case Just have -> do diff --git a/Assistant/Threads/Watcher.hs b/Assistant/Threads/Watcher.hs index 59f6922e3a..8a668f0db3 100644 --- a/Assistant/Threads/Watcher.hs +++ b/Assistant/Threads/Watcher.hs @@ -57,7 +57,7 @@ checkCanWatch | canWatch = do #ifndef mingw32_HOST_OS liftIO Lsof.setup - unlessM (liftIO (inSearchPath "lsof") <||> Annex.getState Annex.force) + unlessM (liftIO (inSearchPath "lsof") <||> Annex.getRead Annex.force) needLsof #else noop diff --git a/Backend.hs b/Backend.hs index b85658e599..8e49bfce41 100644 --- a/Backend.hs +++ b/Backend.hs @@ -44,7 +44,7 @@ defaultBackend = maybe cache return =<< Annex.getState Annex.backend where cache = do n <- maybe (annexBackend <$> Annex.getGitConfig) (return . Just) - =<< Annex.getState Annex.forcebackend + =<< Annex.getRead Annex.forcebackend b <- case n of Just name | valid name -> lookupname name _ -> pure (Prelude.head builtinList) @@ -79,7 +79,7 @@ unknownBackendVarietyMessage v = - That can be configured on a per-file basis in the gitattributes file, - or forced with --backend. -} chooseBackend :: RawFilePath -> Annex (Maybe Backend) -chooseBackend f = Annex.getState Annex.forcebackend >>= go +chooseBackend f = Annex.getRead Annex.forcebackend >>= go where go Nothing = maybeLookupBackendVariety . parseKeyVariety . encodeBS =<< checkAttr "annex.backend" f diff --git a/Backend/Hash.hs b/Backend/Hash.hs index 4ffbcbbdee..550d8fc6c0 100644 --- a/Backend/Hash.hs +++ b/Backend/Hash.hs @@ -120,7 +120,7 @@ keyValueE hash source meterupdate = checkKeyChecksum :: Hash -> Key -> RawFilePath -> Annex Bool checkKeyChecksum hash key file = catchIOErrorType HardwareFault hwfault $ do - fast <- Annex.getState Annex.fast + fast <- Annex.getRead Annex.fast exists <- liftIO $ R.doesPathExist file case (exists, fast) of (True, False) -> do diff --git a/CmdLine/GitAnnex/Options.hs b/CmdLine/GitAnnex/Options.hs index 49848b7786..6526d3632d 100644 --- a/CmdLine/GitAnnex/Options.hs +++ b/CmdLine/GitAnnex/Options.hs @@ -45,12 +45,12 @@ import Annex.Concurrent -- although not always used. gitAnnexGlobalOptions :: [GlobalOption] gitAnnexGlobalOptions = commonGlobalOptions ++ - [ globalOption (setAnnexState . setnumcopies) $ option auto + [ globalOption setnumcopies $ option auto ( long "numcopies" <> short 'N' <> metavar paramNumber <> help "override desired number of copies" <> hidden ) - , globalOption (setAnnexState . setmincopies) $ option auto + , globalOption setmincopies $ option auto ( long "mincopies" <> short 'N' <> metavar paramNumber <> help "override minimum number of copies" <> hidden @@ -100,8 +100,8 @@ gitAnnexGlobalOptions = commonGlobalOptions ++ ) ] where - setnumcopies n = Annex.changeState $ \s -> s { Annex.forcenumcopies = Just $ configuredNumCopies n } - setmincopies n = Annex.changeState $ \s -> s { Annex.forcemincopies = Just $ configuredMinCopies n } + setnumcopies n = setAnnexRead $ \rd -> rd { Annex.forcenumcopies = Just $ configuredNumCopies n } + setmincopies n = setAnnexRead $ \rd -> rd { Annex.forcemincopies = Just $ configuredMinCopies n } setuseragent v = Annex.changeState $ \s -> s { Annex.useragent = Just v } setgitconfig v = Annex.addGitConfigOverride v setdesktopnotify v = Annex.changeState $ \s -> s { Annex.desktopnotify = Annex.desktopnotify s <> v } diff --git a/CmdLine/Option.hs b/CmdLine/Option.hs index bf54189c5d..796ea1df3f 100644 --- a/CmdLine/Option.hs +++ b/CmdLine/Option.hs @@ -25,12 +25,12 @@ import Annex.Debug -- Global options accepted by both git-annex and git-annex-shell sub-commands. commonGlobalOptions :: [GlobalOption] commonGlobalOptions = - [ globalFlag (setAnnexState $ setforce True) + [ globalFlag (setforce True) ( long "force" <> help "allow actions that may lose annexed data" <> hidden ) - , globalFlag (setAnnexState $ setfast True) + , globalFlag (setfast True) ( long "fast" <> short 'F' <> help "avoid slow operations" <> hidden @@ -67,12 +67,12 @@ commonGlobalOptions = ) ] 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 $ - Annex.changeState $ \s -> s { Annex.forcebackend = Just v } + setforcebackend v = setAnnexRead $ + \rd -> rd { Annex.forcebackend = Just v } setdebug v = mconcat [ setAnnexRead $ \rd -> rd { Annex.debugenabled = v } diff --git a/CmdLine/Seek.hs b/CmdLine/Seek.hs index 3bc56dc750..600a62ee5e 100644 --- a/CmdLine/Seek.hs +++ b/CmdLine/Seek.hs @@ -64,7 +64,7 @@ withFilesInGitAnnex ww a l = seekFilteredKeys a $ seekHelper fst3 ww LsFiles.inRepoDetails l 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) , if null l then giveup needforce @@ -90,7 +90,7 @@ withFilesInGitAnnexNonRecursive _ _ _ NoWorkTreeItems = noop withFilesNotInGit :: CheckGitIgnore -> WarnUnmatchWhen -> ((SeekInput, RawFilePath) -> CommandSeek) -> WorkTreeItems -> CommandSeek withFilesNotInGit (CheckGitIgnore ci) ww a l = do - force <- Annex.getState Annex.force + force <- Annex.getRead Annex.force let include_ignored = force || not ci seekFiltered (const (pure True)) a $ seekHelper id ww (const $ LsFiles.notInRepo [] include_ignored) l diff --git a/Command/Add.hs b/Command/Add.hs index 17a00d7e10..11cf59f3d0 100644 --- a/Command/Add.hs +++ b/Command/Add.hs @@ -89,7 +89,7 @@ seek o = startConcurrency commandStages $ do s <- liftIO $ R.getSymbolicLinkStatus file ifM (pure (annexdotfiles || not (dotfile file)) <&&> (checkFileMatcher largematcher file - <||> Annex.getState Annex.force)) + <||> Annex.getRead Annex.force)) ( start si file addunlockedmatcher , if includingsmall then ifM (annexAddSmallFiles <$> Annex.getGitConfig) diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs index 1de729d4c5..9a09daec2c 100644 --- a/Command/AddUrl.hs +++ b/Command/AddUrl.hs @@ -191,7 +191,7 @@ downloadRemoteFile :: AddUnlockedMatcher -> Remote -> DownloadOptions -> URLStri downloadRemoteFile addunlockedmatcher r o uri file sz = checkCanAdd o file $ \canadd -> do let urlkey = Backend.URL.fromUrl uri sz createWorkTreeDirectory (parentDir file) - ifM (Annex.getState Annex.fast <||> pure (relaxedOption o)) + ifM (Annex.getRead Annex.fast <||> pure (relaxedOption o)) ( do addWorkTree canadd addunlockedmatcher (Remote.uuid r) loguri file urlkey Nothing 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 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 , downloadWeb addunlockedmatcher o url urlinfo file ) diff --git a/Command/Drop.hs b/Command/Drop.hs index f397068ae8..e8fadf83bc 100644 --- a/Command/Drop.hs +++ b/Command/Drop.hs @@ -201,7 +201,7 @@ doDrop -> (Maybe SafeDropProof -> CommandPerform, CommandPerform) -> CommandPerform 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 , ifM (checkRequiredContent pcc dropfrom key afile) ( verifyEnoughCopiesToDrop nolocmsg key diff --git a/Command/DropKey.hs b/Command/DropKey.hs index 86248b0cc0..b84503c331 100644 --- a/Command/DropKey.hs +++ b/Command/DropKey.hs @@ -31,7 +31,7 @@ optParser desc = DropKeyOptions seek :: DropKeyOptions -> CommandSeek 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" case batchOption o of NoBatch -> withKeys (commandAction . start) (toDrop o) diff --git a/Command/DropUnused.hs b/Command/DropUnused.hs index 1400bedf2b..4d2e868e7d 100644 --- a/Command/DropUnused.hs +++ b/Command/DropUnused.hs @@ -53,7 +53,7 @@ perform from numcopies mincopies key = case from of Nothing -> ifM (inAnnex key) ( droplocal , ifM (objectFileExists key) - ( ifM (Annex.getState Annex.force) + ( ifM (Annex.getRead Annex.force) ( droplocal , 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." diff --git a/Command/Export.hs b/Command/Export.hs index 6efbaf1002..af392692b3 100644 --- a/Command/Export.hs +++ b/Command/Export.hs @@ -96,7 +96,7 @@ seek o = startConcurrency commandStages $ do db <- openDb (uuid r) writeLockDbWhile db $ do changeExport r db tree - unlessM (Annex.getState Annex.fast) $ do + unlessM (Annex.getRead Annex.fast) $ do void $ fillExport r db tree mtbcommitsha closeDb db diff --git a/Command/Forget.hs b/Command/Forget.hs index 0ed65e6847..7409fe2c77 100644 --- a/Command/Forget.hs +++ b/Command/Forget.hs @@ -40,7 +40,7 @@ start o = starting "forget" ai si $ do let ts = if dropDead o then addTransition c ForgetDeadRemotes basets else basets - perform ts =<< Annex.getState Annex.force + perform ts =<< Annex.getRead Annex.force where ai = ActionItemOther (Just (fromRef Branch.name)) si = SeekInput [] diff --git a/Command/FromKey.hs b/Command/FromKey.hs index d8f04ee01f..62e15683e5 100644 --- a/Command/FromKey.hs +++ b/Command/FromKey.hs @@ -46,7 +46,7 @@ seek o = do -- older way of enabling batch input, does not support BatchNull (NoBatch, []) -> seekBatch matcher (BatchFormat BatchLine (BatchKeys False)) (NoBatch, ps) -> do - force <- Annex.getState Annex.force + force <- Annex.getRead Annex.force withPairs (commandAction . start matcher force) ps seekBatch :: AddUnlockedMatcher -> BatchFormat -> CommandSeek diff --git a/Command/Fsck.hs b/Command/Fsck.hs index cac06ecfc2..dbc9d18d0c 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -195,7 +195,7 @@ performRemote key afile backend numcopies remote = getfile tmp = ifM (checkDiskSpace (Just (P.takeDirectory tmp)) key 0 True) ( ifM (getcheap tmp) ( return (Just (Right UnVerified)) - , ifM (Annex.getState Annex.fast) + , ifM (Annex.getRead Annex.fast) ( return Nothing , Just <$> tryNonAsync (getfile' tmp) ) diff --git a/Command/Import.hs b/Command/Import.hs index 21fd0a9bef..db2c970736 100644 --- a/Command/Import.hs +++ b/Command/Import.hs @@ -173,13 +173,13 @@ startLocal o addunlockedmatcher largematcher mode (srcfile, destfile) = Nothing -> importfilechecked ld k Just s | isDirectory s -> notoverwriting "(is a directory)" - | isSymbolicLink s -> ifM (Annex.getState Annex.force) + | isSymbolicLink s -> ifM (Annex.getRead Annex.force) ( do liftIO $ removeWhenExistsWith R.removeLink destfile importfilechecked ld k , notoverwriting "(is a symlink)" ) - | otherwise -> ifM (Annex.getState Annex.force) + | otherwise -> ifM (Annex.getRead Annex.force) ( do liftIO $ removeWhenExistsWith R.removeLink destfile importfilechecked ld k diff --git a/Command/ImportFeed.hs b/Command/ImportFeed.hs index 55b23bea6c..c910bbcf03 100644 --- a/Command/ImportFeed.hs +++ b/Command/ImportFeed.hs @@ -135,7 +135,7 @@ data Cache = 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 , do 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. let quviurl = setDownloader linkurl QuviDownloader 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 , downloadmedia linkurl mediaurl mediakey ) where - forced = Annex.getState Annex.force + forced = Annex.getRead Annex.force {- Avoids downloading any items that are already known to be - associated with a file in the annex, unless forced. -} diff --git a/Command/Info.hs b/Command/Info.hs index 3658893b9b..caa6a06158 100644 --- a/Command/Info.hs +++ b/Command/Info.hs @@ -238,7 +238,7 @@ uuidInfo o u si = showCustom (unwords ["info", fromUUID u]) si $ do selStats :: [Stat] -> [Stat] -> Annex [Stat] selStats fast_stats slow_stats = do - fast <- Annex.getState Annex.fast + fast <- Annex.getRead Annex.fast return $ if fast then fast_stats else fast_stats ++ slow_stats @@ -597,7 +597,7 @@ cachedRepoData = repoData <$> get getDirStatInfo :: InfoOptions -> FilePath -> Annex StatInfo getDirStatInfo o dir = do - fast <- Annex.getState Annex.fast + fast <- Annex.getRead Annex.fast matcher <- Limit.getMatcher (presentdata, referenceddata, numcopiesstats, repodata) <- Command.Unused.withKeysFilesReferencedIn dir initial @@ -625,7 +625,7 @@ getDirStatInfo o dir = do getTreeStatInfo :: InfoOptions -> Git.Ref -> Annex (Maybe StatInfo) getTreeStatInfo o r = do - fast <- Annex.getState Annex.fast + fast <- Annex.getRead Annex.fast -- git lstree filenames start with a leading "./" that prevents -- matching, and also things like --include are supposed to -- match relative to the current directory, which does not make diff --git a/Command/Lock.hs b/Command/Lock.hs index 0e45d92001..6fcd45eb65 100644 --- a/Command/Lock.hs +++ b/Command/Lock.hs @@ -50,7 +50,7 @@ start si file key = ifM (isJust <$> isAnnexLink file) go Nothing = ifM (isUnmodified key file) ( cont - , ifM (Annex.getState Annex.force) + , ifM (Annex.getRead Annex.force) ( cont , errorModified ) diff --git a/Command/Map.hs b/Command/Map.hs index 7af7db08c0..bdebbc4b1f 100644 --- a/Command/Map.hs +++ b/Command/Map.hs @@ -52,7 +52,7 @@ start = startingNoMessage (ActionItemOther Nothing) $ do liftIO $ writeFile file (drawMap rs trustmap umap) next $ - ifM (Annex.getState Annex.fast) + ifM (Annex.getRead Annex.fast) ( runViewer file [] , runViewer file [ ("xdot", [File file]) diff --git a/Command/Migrate.hs b/Command/Migrate.hs index 0a4b3c77d0..25d8c3ba27 100644 --- a/Command/Migrate.hs +++ b/Command/Migrate.hs @@ -50,7 +50,7 @@ seek o = withFilesInGitAnnex ww seeker =<< workTreeItems ww (migrateThese o) start :: MigrateOptions -> SeekInput -> RawFilePath -> Key -> CommandStart start o si file key = do - forced <- Annex.getState Annex.force + forced <- Annex.getRead Annex.force v <- Backend.getBackend (fromRawFilePath file) key case v of Nothing -> stop diff --git a/Command/Move.hs b/Command/Move.hs index bc009d9177..2a74fc525d 100644 --- a/Command/Move.hs +++ b/Command/Move.hs @@ -118,7 +118,7 @@ toStart removewhen afile key ai si dest = do toStart' :: Remote -> RemoveWhen -> AssociatedFile -> Key -> ActionItem -> SeekInput -> CommandStart toStart' dest removewhen afile key ai si = do - fast <- Annex.getState Annex.fast + fast <- Annex.getRead Annex.fast if fast && removewhen == RemoveNever then ifM (expectedPresent dest key) ( stop @@ -334,7 +334,7 @@ willDropMakeItWorse srcuuid destuuid (DestStartedWithCopy deststartedwithcopy _) , unlessforced DropWorse ) where - unlessforced r = ifM (Annex.getState Annex.force) + unlessforced r = ifM (Annex.getRead Annex.force) ( return DropAllowed , return r ) diff --git a/Command/ReKey.hs b/Command/ReKey.hs index f06bb62c53..165f48c078 100644 --- a/Command/ReKey.hs +++ b/Command/ReKey.hs @@ -75,7 +75,7 @@ perform file oldkey newkey = do ifM (inAnnex oldkey) ( unlessM (linkKey file oldkey newkey) $ 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)" ) next $ cleanup file newkey diff --git a/Command/Repair.hs b/Command/Repair.hs index 343648851c..c85c77d299 100644 --- a/Command/Repair.hs +++ b/Command/Repair.hs @@ -27,7 +27,7 @@ seek = withNothing (commandAction start) start :: CommandStart start = starting "repair" (ActionItemOther Nothing) (SeekInput []) $ - next $ runRepair =<< Annex.getState Annex.force + next $ runRepair =<< Annex.getRead Annex.force runRepair :: Bool -> Annex Bool runRepair forced = do diff --git a/Command/Sync.hs b/Command/Sync.hs index e734ee4445..9cc40afa8b 100644 --- a/Command/Sync.hs +++ b/Command/Sync.hs @@ -324,7 +324,7 @@ syncRemotes ps = do syncRemotes' :: [String] -> [Remote] -> Annex [Remote] syncRemotes' ps available = - ifM (Annex.getState Annex.fast) ( fastest <$> wanted , wanted ) + ifM (Annex.getRead Annex.fast) ( fastest <$> wanted , wanted ) where wanted | null ps = filterM good (concat $ Remote.byCost available) diff --git a/Command/TestRemote.hs b/Command/TestRemote.hs index 7e85db72be..6d17ba9693 100644 --- a/Command/TestRemote.hs +++ b/Command/TestRemote.hs @@ -74,7 +74,7 @@ seek = commandAction . start start :: TestRemoteOptions -> CommandStart start o = starting "testremote" (ActionItemOther (Just (testRemote o))) si $ do - fast <- Annex.getState Annex.fast + fast <- Annex.getRead Annex.fast cache <- liftIO newRemoteVariantCache r <- either giveup (disableExportTree cache) =<< Remote.byName' (testRemote o) diff --git a/Command/Trust.hs b/Command/Trust.hs index 025c5cb899..176b491fbe 100644 --- a/Command/Trust.hs +++ b/Command/Trust.hs @@ -33,7 +33,7 @@ trustCommand c level = withWords (commandAction . start) starting c (ActionItemOther (Just name)) si (perform name u) perform name uuid = do when (level >= Trusted) $ - unlessM (Annex.getState Annex.force) $ + unlessM (Annex.getRead Annex.force) $ giveup $ trustedNeedsForce name trustSet uuid level when (level == DeadTrusted) $ diff --git a/Command/Unannex.hs b/Command/Unannex.hs index cfb113dd0a..bb98c4960c 100644 --- a/Command/Unannex.hs +++ b/Command/Unannex.hs @@ -26,24 +26,24 @@ cmd = withGlobalOptions [annexedMatchingOptions] $ paramPaths (withParams seek) seek :: CmdParams -> CommandSeek -seek ps = withFilesInGitAnnex ww seeker =<< workTreeItems ww ps +seek ps = withFilesInGitAnnex ww (seeker False) =<< workTreeItems ww ps where ww = WarnUnmatchLsFiles -seeker :: AnnexedFileSeeker -seeker = AnnexedFileSeeker - { startAction = start +seeker :: Bool -> AnnexedFileSeeker +seeker fast = AnnexedFileSeeker + { startAction = start fast , checkContentPresent = Just True , usesLocationLog = False } -start :: SeekInput -> RawFilePath -> Key -> CommandStart -start si file key = +start :: Bool -> SeekInput -> RawFilePath -> Key -> CommandStart +start fast si file key = starting "unannex" (mkActionItem (key, file)) si $ - perform file key + perform fast file key -perform :: RawFilePath -> Key -> CommandPerform -perform file key = do +perform :: Bool -> RawFilePath -> Key -> CommandPerform +perform fast file key = do Annex.Queue.addCommand [] "rm" [ Param "--cached" , Param "--force" @@ -58,7 +58,7 @@ perform file key = do -- (cached in git). Just key' -> do cleanupdb - next $ cleanup file key' + next $ cleanup fast file key' -- If the file is unlocked, it can be unmodified or not and -- does not need to be replaced either way. Nothing -> do @@ -71,11 +71,11 @@ perform file key = do maybe noop Database.Keys.removeInodeCache =<< withTSDelta (liftIO . genInodeCache file) -cleanup :: RawFilePath -> Key -> CommandCleanup -cleanup file key = do +cleanup :: Bool -> RawFilePath -> Key -> CommandCleanup +cleanup fast file key = do liftIO $ removeFile (fromRawFilePath file) src <- calcRepo (gitAnnexLocation key) - ifM (Annex.getState Annex.fast) + ifM (pure fast <||> Annex.getRead Annex.fast) ( do -- Only make a hard link if the annexed file does not -- already have other hard links pointing at it. This diff --git a/Command/Uninit.hs b/Command/Uninit.hs index 3da4de4f9c..38f50c8f6c 100644 --- a/Command/Uninit.hs +++ b/Command/Uninit.hs @@ -8,7 +8,6 @@ module Command.Uninit where import Command -import qualified Annex import qualified Git import qualified Git.Command import qualified Git.Ref @@ -54,8 +53,7 @@ seek ps = do WarnUnmatchWorkTreeItems (\(_, f) -> commandAction $ whenAnnexed (startCheckIncomplete . fromRawFilePath) f) l - Annex.changeState $ \s -> s { Annex.fast = True } - withFilesInGitAnnex ww Command.Unannex.seeker l + withFilesInGitAnnex ww (Command.Unannex.seeker True) l finish where ww = WarnUnmatchLsFiles diff --git a/Command/Unused.hs b/Command/Unused.hs index 0fe969e58c..694b6187ce 100644 --- a/Command/Unused.hs +++ b/Command/Unused.hs @@ -77,7 +77,7 @@ start o = do checkUnused :: RefSpec -> CommandPerform 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 "tmp" staleTmpMsg $ staleKeysPrune gitAnnexTmpObjectDir True ] diff --git a/Remote/GitLFS.hs b/Remote/GitLFS.hs index 29c745e155..7cc79c7a5a 100644 --- a/Remote/GitLFS.hs +++ b/Remote/GitLFS.hs @@ -149,7 +149,7 @@ mySetup ss mu _ c gc = do (c', _encsetup) <- encryptionSetup c gc pc <- either giveup return . parseRemoteConfig c' =<< configParser remote c' let failinitunlessforced msg = case ss of - Init -> unlessM (Annex.getState Annex.force) (giveup msg) + Init -> unlessM (Annex.getRead Annex.force) (giveup msg) Enable _ -> noop AutoEnable _ -> noop case (isEncrypted pc, Git.GCrypt.urlPrefix `isPrefixOf` url) of diff --git a/Remote/Helper/Encryptable.hs b/Remote/Helper/Encryptable.hs index 57b79e81e8..29841b727f 100644 --- a/Remote/Helper/Encryptable.hs +++ b/Remote/Helper/Encryptable.hs @@ -197,7 +197,7 @@ encryptionSetup c gc = do cipher <- liftIO a showNote (describeCipher cipher) return (storeCipher cipher c', EncryptionIsSetup) - highRandomQuality = ifM (Annex.getState Annex.fast) + highRandomQuality = ifM (Annex.getRead Annex.fast) ( return False , case parseHighRandomQuality (fromProposedAccepted <$> M.lookup highRandomQualityField c) of Left err -> giveup err diff --git a/Remote/S3.hs b/Remote/S3.hs index 8c032aaf57..c5ec4563b6 100644 --- a/Remote/S3.hs +++ b/Remote/S3.hs @@ -312,7 +312,7 @@ s3Setup' ss u mcreds c gc use archiveconfig pc' info checkexportimportsafe c' info = - unlessM (Annex.getState Annex.force) $ + unlessM (Annex.getRead Annex.force) $ checkexportimportsafe' c' info checkexportimportsafe' c' info | versioning info = return () diff --git a/Upgrade/V9.hs b/Upgrade/V9.hs index 86ceb4c3f9..06e2c55859 100644 --- a/Upgrade/V9.hs +++ b/Upgrade/V9.hs @@ -27,7 +27,7 @@ upgrade automatic ( return UpgradeDeferred , performUpgrade automatic ) - | otherwise = ifM (oldprocessesdanger <&&> (not <$> Annex.getState Annex.force)) + | otherwise = ifM (oldprocessesdanger <&&> (not <$> Annex.getRead Annex.force)) ( do warning $ unlines unsafeupgrade return UpgradeDeferred diff --git a/doc/todo/move_readonly_values_to_AnnexRead.mdwn b/doc/todo/move_readonly_values_to_AnnexRead.mdwn index 1a2906aabf..70c94f00e7 100644 --- a/doc/todo/move_readonly_values_to_AnnexRead.mdwn +++ b/doc/todo/move_readonly_values_to_AnnexRead.mdwn @@ -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 used. --[[Joey]] -The easy things have been moved now, but some things like Annex.force and -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]] +Many things have been moved, but there are certainly others that can be.