This commit is contained in:
Joey Hess 2015-12-15 15:34:28 -04:00
parent 0ddcaae9c1
commit cdd27b8920
Failed to extract signature
11 changed files with 54 additions and 43 deletions

View file

@ -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

View file

@ -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

35
Annex/WorkTree.hs Normal file
View file

@ -0,0 +1,35 @@
{- git-annex worktree files
-
- Copyright 2013-2015 Joey Hess <id@joeyh.name>
-
- 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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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)

View file

@ -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

View file

@ -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