diff --git a/Annex/Direct.hs b/Annex/Direct.hs index 8fced2d444..8c3d5bb562 100644 --- a/Annex/Direct.hs +++ b/Annex/Direct.hs @@ -399,7 +399,7 @@ changedDirect oldk f = do whenM (pure (null locs) <&&> not <$> inAnnex oldk) $ logStatus oldk InfoMissing -{- Enable/disable direct mode. -} +{- Git config settings to enable/disable direct mode. -} setDirect :: Bool -> Annex () setDirect wantdirect = do if wantdirect diff --git a/Annex/View.hs b/Annex/View.hs index 567522a541..8ddbb9c638 100644 --- a/Annex/View.hs +++ b/Annex/View.hs @@ -22,7 +22,7 @@ import Git.Sha import Git.HashObject import Git.Types import Git.FilePath -import qualified Backend +import Annex.WorkTree import Annex.Index import Annex.Link import Annex.CatFile @@ -342,7 +342,7 @@ applyView' mkviewedfile getfilemetadata view = do hasher <- inRepo hashObjectStart forM_ l $ \f -> do relf <- getTopFilePath <$> inRepo (toTopFilePath f) - go uh hasher relf =<< Backend.lookupFile f + go uh hasher relf =<< lookupFile f liftIO $ do hashObjectStop hasher void $ stopUpdateIndex uh diff --git a/Annex/WorkTree.hs b/Annex/WorkTree.hs new file mode 100644 index 0000000000..26144e7f9e --- /dev/null +++ b/Annex/WorkTree.hs @@ -0,0 +1,35 @@ +{- git-annex worktree files + - + - Copyright 2013-2015 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Annex.WorkTree where + +import Common.Annex +import Annex.Link +import Annex.CatFile + +{- Looks up the key corresponding to an annexed file, + - by examining what the file links to. + - + - An unlocked file will not have a link on disk, so fall back to + - looking for a pointer to a key in git. + -} +lookupFile :: FilePath -> Annex (Maybe Key) +lookupFile file = do + mkey <- isAnnexLink file + case mkey of + Just key -> makeret key + Nothing -> maybe (return Nothing) makeret =<< catKeyFile file + where + makeret = return . Just + +{- Modifies an action to only act on files that are already annexed, + - and passes the key on to it. -} +whenAnnexed :: (FilePath -> Key -> Annex (Maybe a)) -> FilePath -> Annex (Maybe a) +whenAnnexed a file = ifAnnexed file (a file) (return Nothing) + +ifAnnexed :: FilePath -> (Key -> Annex a) -> Annex a -> Annex a +ifAnnexed file yes no = maybe no yes =<< lookupFile file diff --git a/Assistant/Threads/TransferScanner.hs b/Assistant/Threads/TransferScanner.hs index f35c1f1f53..7386d55286 100644 --- a/Assistant/Threads/TransferScanner.hs +++ b/Assistant/Threads/TransferScanner.hs @@ -25,7 +25,7 @@ import Utility.ThreadScheduler import Utility.NotificationBroadcaster import Utility.Batch import qualified Git.LsFiles as LsFiles -import qualified Backend +import Annex.WorkTree import Annex.Content import Annex.Wanted import CmdLine.Action @@ -142,7 +142,7 @@ expensiveScan urlrenderer rs = batch <~> do (unwanted', ts) <- maybe (return (unwanted, [])) (findtransfers f unwanted) - =<< liftAnnex (Backend.lookupFile f) + =<< liftAnnex (lookupFile f) mapM_ (enqueue f) ts scan unwanted' fs diff --git a/Assistant/Threads/Watcher.hs b/Assistant/Threads/Watcher.hs index 8c6ff378dd..37e0154b45 100644 --- a/Assistant/Threads/Watcher.hs +++ b/Assistant/Threads/Watcher.hs @@ -28,7 +28,7 @@ import qualified Annex.Queue import qualified Git import qualified Git.UpdateIndex import qualified Git.LsFiles as LsFiles -import qualified Backend +import Annex.WorkTree import Annex.Direct import Annex.Content.Direct import Annex.CatFile @@ -270,7 +270,7 @@ onAddDirect symlinkssupported matcher file fs = do onAddSymlink :: Bool -> Handler onAddSymlink isdirect file filestatus = unlessIgnored file $ do linktarget <- liftIO (catchMaybeIO $ readSymbolicLink file) - kv <- liftAnnex (Backend.lookupFile file) + kv <- liftAnnex (lookupFile file) onAddSymlink' linktarget kv isdirect file filestatus onAddSymlink' :: Maybe String -> Maybe Key -> Bool -> Handler diff --git a/Backend.hs b/Backend.hs index d37eed34af..c2f3d28d41 100644 --- a/Backend.hs +++ b/Backend.hs @@ -9,7 +9,6 @@ module Backend ( list, orderedList, genKey, - lookupFile, getBackend, chooseBackend, lookupBackendName, @@ -20,8 +19,6 @@ module Backend ( import Common.Annex import qualified Annex import Annex.CheckAttr -import Annex.CatFile -import Annex.Link import Types.Key import Types.KeySource import qualified Types.Backend as B @@ -76,21 +73,6 @@ genKey' (b:bs) source = do | c == '\n' = '_' | otherwise = c -{- Looks up the key corresponding to an annexed file, - - by examining what the file links to. - - - - An unlocked file will not have a link on disk, so fall back to - - looking for a pointer to a key in git. - -} -lookupFile :: FilePath -> Annex (Maybe Key) -lookupFile file = do - mkey <- isAnnexLink file - case mkey of - Just key -> makeret key - Nothing -> maybe (return Nothing) makeret =<< catKeyFile file - where - makeret = return . Just - getBackend :: FilePath -> Key -> Annex (Maybe Backend) getBackend file k = let bname = keyBackendName k in case maybeLookupBackendName bname of diff --git a/Command.hs b/Command.hs index bee63bb741..387f7b8b56 100644 --- a/Command.hs +++ b/Command.hs @@ -18,12 +18,13 @@ module Command ( stopUnless, whenAnnexed, ifAnnexed, + lookupFile, isBareRepo, module ReExported ) where import Common.Annex -import qualified Backend +import Annex.WorkTree import qualified Git import Types.Command as ReExported import Types.Option as ReExported @@ -100,13 +101,5 @@ stop = return Nothing stopUnless :: Annex Bool -> Annex (Maybe a) -> Annex (Maybe a) stopUnless c a = ifM c ( a , stop ) -{- Modifies an action to only act on files that are already annexed, - - and passes the key on to it. -} -whenAnnexed :: (FilePath -> Key -> Annex (Maybe a)) -> FilePath -> Annex (Maybe a) -whenAnnexed a file = ifAnnexed file (a file) (return Nothing) - -ifAnnexed :: FilePath -> (Key -> Annex a) -> Annex a -> Annex a -ifAnnexed file yes no = maybe no yes =<< Backend.lookupFile file - isBareRepo :: Annex Bool isBareRepo = fromRepo Git.repoIsLocalBare diff --git a/Command/Unused.hs b/Command/Unused.hs index 4756cda5df..4353bd075e 100644 --- a/Command/Unused.hs +++ b/Command/Unused.hs @@ -24,7 +24,6 @@ import qualified Git.Branch import qualified Git.RefLog import qualified Git.LsFiles as LsFiles import qualified Git.DiffTree as DiffTree -import qualified Backend import qualified Remote import qualified Annex.Branch import Annex.CatFile @@ -215,7 +214,7 @@ withKeysReferenced' mdir initial a = do Just dir -> inRepo $ LsFiles.inRepo [dir] go v [] = return v go v (f:fs) = do - x <- Backend.lookupFile f + x <- lookupFile f case x of Nothing -> go v fs Just k -> do @@ -266,7 +265,7 @@ withKeysReferencedInGitRef a ref = do forM_ ts $ tKey lookAtWorkingTree >=> maybe noop a liftIO $ void clean where - tKey True = Backend.lookupFile . getTopFilePath . DiffTree.file + tKey True = lookupFile . getTopFilePath . DiffTree.file tKey False = fileKey . takeFileName . decodeBS <$$> catFile ref . getTopFilePath . DiffTree.file diff --git a/Command/Upgrade.hs b/Command/Upgrade.hs index c02a6709f9..8a34022e3c 100644 --- a/Command/Upgrade.hs +++ b/Command/Upgrade.hs @@ -13,6 +13,7 @@ import Upgrade cmd :: Command cmd = dontCheck repoExists $ -- because an old version may not seem to exist + noDaemonRunning $ -- avoid upgrading repo out from under daemon command "upgrade" SectionMaintenance "upgrade repository layout" paramNothing (withParams seek) diff --git a/Limit.hs b/Limit.hs index 321c1122b3..437c65bc35 100644 --- a/Limit.hs +++ b/Limit.hs @@ -11,8 +11,8 @@ import Common.Annex import qualified Annex import qualified Utility.Matcher import qualified Remote -import qualified Backend import Annex.Content +import Annex.WorkTree import Annex.Action import Annex.UUID import Logs.Trust @@ -277,7 +277,7 @@ addTimeLimit s = do else return True lookupFileKey :: FileInfo -> Annex (Maybe Key) -lookupFileKey = Backend.lookupFile . currFile +lookupFileKey = lookupFile . currFile checkKey :: (Key -> Annex Bool) -> MatchInfo -> Annex Bool checkKey a (MatchingFile fi) = lookupFileKey fi >>= maybe (return False) a diff --git a/Test.hs b/Test.hs index f4035f6051..1a0601b35c 100644 --- a/Test.hs +++ b/Test.hs @@ -65,6 +65,7 @@ import qualified Types.Messages import qualified Config import qualified Config.Cost import qualified Crypto +import qualified Annex.WorkTree import qualified Annex.Init import qualified Annex.CatFile import qualified Annex.View @@ -810,7 +811,7 @@ test_unused = intmpclonerepoInDirect $ do assertEqual ("unused keys differ " ++ desc) (sort expectedkeys) (sort unusedkeys) findkey f = do - r <- Backend.lookupFile f + r <- Annex.WorkTree.lookupFile f return $ fromJust r test_describe :: Assertion @@ -1380,7 +1381,7 @@ test_crypto = do (c,k) <- annexeval $ do uuid <- Remote.nameToUUID "foo" rs <- Logs.Remote.readRemoteLog - Just k <- Backend.lookupFile annexedfile + Just k <- Annex.WorkTree.lookupFile annexedfile return (fromJust $ M.lookup uuid rs, k) let key = if scheme `elem` ["hybrid","pubkey"] then Just $ Utility.Gpg.KeyIds [Utility.Gpg.testKeyId] @@ -1684,7 +1685,7 @@ checkdangling f = ifM (annexeval Config.crippledFileSystem) checklocationlog :: FilePath -> Bool -> Assertion checklocationlog f expected = do thisuuid <- annexeval Annex.UUID.getUUID - r <- annexeval $ Backend.lookupFile f + r <- annexeval $ Annex.WorkTree.lookupFile f case r of Just k -> do uuids <- annexeval $ Remote.keyLocations k @@ -1695,7 +1696,7 @@ checklocationlog f expected = do checkbackend :: FilePath -> Types.Backend -> Assertion checkbackend file expected = do b <- annexeval $ maybe (return Nothing) (Backend.getBackend file) - =<< Backend.lookupFile file + =<< Annex.WorkTree.lookupFile file assertEqual ("backend for " ++ file) (Just expected) b inlocationlog :: FilePath -> Assertion