reorg
This commit is contained in:
parent
0ddcaae9c1
commit
cdd27b8920
11 changed files with 54 additions and 43 deletions
|
@ -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
|
||||
|
|
|
@ -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
35
Annex/WorkTree.hs
Normal 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
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
18
Backend.hs
18
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
|
||||
|
|
11
Command.hs
11
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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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)
|
||||
|
||||
|
|
4
Limit.hs
4
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
|
||||
|
|
9
Test.hs
9
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
|
||||
|
|
Loading…
Reference in a new issue