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) $
|
whenM (pure (null locs) <&&> not <$> inAnnex oldk) $
|
||||||
logStatus oldk InfoMissing
|
logStatus oldk InfoMissing
|
||||||
|
|
||||||
{- Enable/disable direct mode. -}
|
{- Git config settings to enable/disable direct mode. -}
|
||||||
setDirect :: Bool -> Annex ()
|
setDirect :: Bool -> Annex ()
|
||||||
setDirect wantdirect = do
|
setDirect wantdirect = do
|
||||||
if wantdirect
|
if wantdirect
|
||||||
|
|
|
@ -22,7 +22,7 @@ import Git.Sha
|
||||||
import Git.HashObject
|
import Git.HashObject
|
||||||
import Git.Types
|
import Git.Types
|
||||||
import Git.FilePath
|
import Git.FilePath
|
||||||
import qualified Backend
|
import Annex.WorkTree
|
||||||
import Annex.Index
|
import Annex.Index
|
||||||
import Annex.Link
|
import Annex.Link
|
||||||
import Annex.CatFile
|
import Annex.CatFile
|
||||||
|
@ -342,7 +342,7 @@ applyView' mkviewedfile getfilemetadata view = do
|
||||||
hasher <- inRepo hashObjectStart
|
hasher <- inRepo hashObjectStart
|
||||||
forM_ l $ \f -> do
|
forM_ l $ \f -> do
|
||||||
relf <- getTopFilePath <$> inRepo (toTopFilePath f)
|
relf <- getTopFilePath <$> inRepo (toTopFilePath f)
|
||||||
go uh hasher relf =<< Backend.lookupFile f
|
go uh hasher relf =<< lookupFile f
|
||||||
liftIO $ do
|
liftIO $ do
|
||||||
hashObjectStop hasher
|
hashObjectStop hasher
|
||||||
void $ stopUpdateIndex uh
|
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.NotificationBroadcaster
|
||||||
import Utility.Batch
|
import Utility.Batch
|
||||||
import qualified Git.LsFiles as LsFiles
|
import qualified Git.LsFiles as LsFiles
|
||||||
import qualified Backend
|
import Annex.WorkTree
|
||||||
import Annex.Content
|
import Annex.Content
|
||||||
import Annex.Wanted
|
import Annex.Wanted
|
||||||
import CmdLine.Action
|
import CmdLine.Action
|
||||||
|
@ -142,7 +142,7 @@ expensiveScan urlrenderer rs = batch <~> do
|
||||||
(unwanted', ts) <- maybe
|
(unwanted', ts) <- maybe
|
||||||
(return (unwanted, []))
|
(return (unwanted, []))
|
||||||
(findtransfers f unwanted)
|
(findtransfers f unwanted)
|
||||||
=<< liftAnnex (Backend.lookupFile f)
|
=<< liftAnnex (lookupFile f)
|
||||||
mapM_ (enqueue f) ts
|
mapM_ (enqueue f) ts
|
||||||
scan unwanted' fs
|
scan unwanted' fs
|
||||||
|
|
||||||
|
|
|
@ -28,7 +28,7 @@ import qualified Annex.Queue
|
||||||
import qualified Git
|
import qualified Git
|
||||||
import qualified Git.UpdateIndex
|
import qualified Git.UpdateIndex
|
||||||
import qualified Git.LsFiles as LsFiles
|
import qualified Git.LsFiles as LsFiles
|
||||||
import qualified Backend
|
import Annex.WorkTree
|
||||||
import Annex.Direct
|
import Annex.Direct
|
||||||
import Annex.Content.Direct
|
import Annex.Content.Direct
|
||||||
import Annex.CatFile
|
import Annex.CatFile
|
||||||
|
@ -270,7 +270,7 @@ onAddDirect symlinkssupported matcher file fs = do
|
||||||
onAddSymlink :: Bool -> Handler
|
onAddSymlink :: Bool -> Handler
|
||||||
onAddSymlink isdirect file filestatus = unlessIgnored file $ do
|
onAddSymlink isdirect file filestatus = unlessIgnored file $ do
|
||||||
linktarget <- liftIO (catchMaybeIO $ readSymbolicLink file)
|
linktarget <- liftIO (catchMaybeIO $ readSymbolicLink file)
|
||||||
kv <- liftAnnex (Backend.lookupFile file)
|
kv <- liftAnnex (lookupFile file)
|
||||||
onAddSymlink' linktarget kv isdirect file filestatus
|
onAddSymlink' linktarget kv isdirect file filestatus
|
||||||
|
|
||||||
onAddSymlink' :: Maybe String -> Maybe Key -> Bool -> Handler
|
onAddSymlink' :: Maybe String -> Maybe Key -> Bool -> Handler
|
||||||
|
|
18
Backend.hs
18
Backend.hs
|
@ -9,7 +9,6 @@ module Backend (
|
||||||
list,
|
list,
|
||||||
orderedList,
|
orderedList,
|
||||||
genKey,
|
genKey,
|
||||||
lookupFile,
|
|
||||||
getBackend,
|
getBackend,
|
||||||
chooseBackend,
|
chooseBackend,
|
||||||
lookupBackendName,
|
lookupBackendName,
|
||||||
|
@ -20,8 +19,6 @@ module Backend (
|
||||||
import Common.Annex
|
import Common.Annex
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
import Annex.CheckAttr
|
import Annex.CheckAttr
|
||||||
import Annex.CatFile
|
|
||||||
import Annex.Link
|
|
||||||
import Types.Key
|
import Types.Key
|
||||||
import Types.KeySource
|
import Types.KeySource
|
||||||
import qualified Types.Backend as B
|
import qualified Types.Backend as B
|
||||||
|
@ -76,21 +73,6 @@ genKey' (b:bs) source = do
|
||||||
| c == '\n' = '_'
|
| c == '\n' = '_'
|
||||||
| otherwise = c
|
| 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 :: FilePath -> Key -> Annex (Maybe Backend)
|
||||||
getBackend file k = let bname = keyBackendName k in
|
getBackend file k = let bname = keyBackendName k in
|
||||||
case maybeLookupBackendName bname of
|
case maybeLookupBackendName bname of
|
||||||
|
|
11
Command.hs
11
Command.hs
|
@ -18,12 +18,13 @@ module Command (
|
||||||
stopUnless,
|
stopUnless,
|
||||||
whenAnnexed,
|
whenAnnexed,
|
||||||
ifAnnexed,
|
ifAnnexed,
|
||||||
|
lookupFile,
|
||||||
isBareRepo,
|
isBareRepo,
|
||||||
module ReExported
|
module ReExported
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Common.Annex
|
import Common.Annex
|
||||||
import qualified Backend
|
import Annex.WorkTree
|
||||||
import qualified Git
|
import qualified Git
|
||||||
import Types.Command as ReExported
|
import Types.Command as ReExported
|
||||||
import Types.Option as ReExported
|
import Types.Option as ReExported
|
||||||
|
@ -100,13 +101,5 @@ stop = return Nothing
|
||||||
stopUnless :: Annex Bool -> Annex (Maybe a) -> Annex (Maybe a)
|
stopUnless :: Annex Bool -> Annex (Maybe a) -> Annex (Maybe a)
|
||||||
stopUnless c a = ifM c ( a , stop )
|
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 :: Annex Bool
|
||||||
isBareRepo = fromRepo Git.repoIsLocalBare
|
isBareRepo = fromRepo Git.repoIsLocalBare
|
||||||
|
|
|
@ -24,7 +24,6 @@ import qualified Git.Branch
|
||||||
import qualified Git.RefLog
|
import qualified Git.RefLog
|
||||||
import qualified Git.LsFiles as LsFiles
|
import qualified Git.LsFiles as LsFiles
|
||||||
import qualified Git.DiffTree as DiffTree
|
import qualified Git.DiffTree as DiffTree
|
||||||
import qualified Backend
|
|
||||||
import qualified Remote
|
import qualified Remote
|
||||||
import qualified Annex.Branch
|
import qualified Annex.Branch
|
||||||
import Annex.CatFile
|
import Annex.CatFile
|
||||||
|
@ -215,7 +214,7 @@ withKeysReferenced' mdir initial a = do
|
||||||
Just dir -> inRepo $ LsFiles.inRepo [dir]
|
Just dir -> inRepo $ LsFiles.inRepo [dir]
|
||||||
go v [] = return v
|
go v [] = return v
|
||||||
go v (f:fs) = do
|
go v (f:fs) = do
|
||||||
x <- Backend.lookupFile f
|
x <- lookupFile f
|
||||||
case x of
|
case x of
|
||||||
Nothing -> go v fs
|
Nothing -> go v fs
|
||||||
Just k -> do
|
Just k -> do
|
||||||
|
@ -266,7 +265,7 @@ withKeysReferencedInGitRef a ref = do
|
||||||
forM_ ts $ tKey lookAtWorkingTree >=> maybe noop a
|
forM_ ts $ tKey lookAtWorkingTree >=> maybe noop a
|
||||||
liftIO $ void clean
|
liftIO $ void clean
|
||||||
where
|
where
|
||||||
tKey True = Backend.lookupFile . getTopFilePath . DiffTree.file
|
tKey True = lookupFile . getTopFilePath . DiffTree.file
|
||||||
tKey False = fileKey . takeFileName . decodeBS <$$>
|
tKey False = fileKey . takeFileName . decodeBS <$$>
|
||||||
catFile ref . getTopFilePath . DiffTree.file
|
catFile ref . getTopFilePath . DiffTree.file
|
||||||
|
|
||||||
|
|
|
@ -13,6 +13,7 @@ import Upgrade
|
||||||
|
|
||||||
cmd :: Command
|
cmd :: Command
|
||||||
cmd = dontCheck repoExists $ -- because an old version may not seem to exist
|
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"
|
command "upgrade" SectionMaintenance "upgrade repository layout"
|
||||||
paramNothing (withParams seek)
|
paramNothing (withParams seek)
|
||||||
|
|
||||||
|
|
4
Limit.hs
4
Limit.hs
|
@ -11,8 +11,8 @@ import Common.Annex
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
import qualified Utility.Matcher
|
import qualified Utility.Matcher
|
||||||
import qualified Remote
|
import qualified Remote
|
||||||
import qualified Backend
|
|
||||||
import Annex.Content
|
import Annex.Content
|
||||||
|
import Annex.WorkTree
|
||||||
import Annex.Action
|
import Annex.Action
|
||||||
import Annex.UUID
|
import Annex.UUID
|
||||||
import Logs.Trust
|
import Logs.Trust
|
||||||
|
@ -277,7 +277,7 @@ addTimeLimit s = do
|
||||||
else return True
|
else return True
|
||||||
|
|
||||||
lookupFileKey :: FileInfo -> Annex (Maybe Key)
|
lookupFileKey :: FileInfo -> Annex (Maybe Key)
|
||||||
lookupFileKey = Backend.lookupFile . currFile
|
lookupFileKey = lookupFile . currFile
|
||||||
|
|
||||||
checkKey :: (Key -> Annex Bool) -> MatchInfo -> Annex Bool
|
checkKey :: (Key -> Annex Bool) -> MatchInfo -> Annex Bool
|
||||||
checkKey a (MatchingFile fi) = lookupFileKey fi >>= maybe (return False) a
|
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
|
||||||
import qualified Config.Cost
|
import qualified Config.Cost
|
||||||
import qualified Crypto
|
import qualified Crypto
|
||||||
|
import qualified Annex.WorkTree
|
||||||
import qualified Annex.Init
|
import qualified Annex.Init
|
||||||
import qualified Annex.CatFile
|
import qualified Annex.CatFile
|
||||||
import qualified Annex.View
|
import qualified Annex.View
|
||||||
|
@ -810,7 +811,7 @@ test_unused = intmpclonerepoInDirect $ do
|
||||||
assertEqual ("unused keys differ " ++ desc)
|
assertEqual ("unused keys differ " ++ desc)
|
||||||
(sort expectedkeys) (sort unusedkeys)
|
(sort expectedkeys) (sort unusedkeys)
|
||||||
findkey f = do
|
findkey f = do
|
||||||
r <- Backend.lookupFile f
|
r <- Annex.WorkTree.lookupFile f
|
||||||
return $ fromJust r
|
return $ fromJust r
|
||||||
|
|
||||||
test_describe :: Assertion
|
test_describe :: Assertion
|
||||||
|
@ -1380,7 +1381,7 @@ test_crypto = do
|
||||||
(c,k) <- annexeval $ do
|
(c,k) <- annexeval $ do
|
||||||
uuid <- Remote.nameToUUID "foo"
|
uuid <- Remote.nameToUUID "foo"
|
||||||
rs <- Logs.Remote.readRemoteLog
|
rs <- Logs.Remote.readRemoteLog
|
||||||
Just k <- Backend.lookupFile annexedfile
|
Just k <- Annex.WorkTree.lookupFile annexedfile
|
||||||
return (fromJust $ M.lookup uuid rs, k)
|
return (fromJust $ M.lookup uuid rs, k)
|
||||||
let key = if scheme `elem` ["hybrid","pubkey"]
|
let key = if scheme `elem` ["hybrid","pubkey"]
|
||||||
then Just $ Utility.Gpg.KeyIds [Utility.Gpg.testKeyId]
|
then Just $ Utility.Gpg.KeyIds [Utility.Gpg.testKeyId]
|
||||||
|
@ -1684,7 +1685,7 @@ checkdangling f = ifM (annexeval Config.crippledFileSystem)
|
||||||
checklocationlog :: FilePath -> Bool -> Assertion
|
checklocationlog :: FilePath -> Bool -> Assertion
|
||||||
checklocationlog f expected = do
|
checklocationlog f expected = do
|
||||||
thisuuid <- annexeval Annex.UUID.getUUID
|
thisuuid <- annexeval Annex.UUID.getUUID
|
||||||
r <- annexeval $ Backend.lookupFile f
|
r <- annexeval $ Annex.WorkTree.lookupFile f
|
||||||
case r of
|
case r of
|
||||||
Just k -> do
|
Just k -> do
|
||||||
uuids <- annexeval $ Remote.keyLocations k
|
uuids <- annexeval $ Remote.keyLocations k
|
||||||
|
@ -1695,7 +1696,7 @@ checklocationlog f expected = do
|
||||||
checkbackend :: FilePath -> Types.Backend -> Assertion
|
checkbackend :: FilePath -> Types.Backend -> Assertion
|
||||||
checkbackend file expected = do
|
checkbackend file expected = do
|
||||||
b <- annexeval $ maybe (return Nothing) (Backend.getBackend file)
|
b <- annexeval $ maybe (return Nothing) (Backend.getBackend file)
|
||||||
=<< Backend.lookupFile file
|
=<< Annex.WorkTree.lookupFile file
|
||||||
assertEqual ("backend for " ++ file) (Just expected) b
|
assertEqual ("backend for " ++ file) (Just expected) b
|
||||||
|
|
||||||
inlocationlog :: FilePath -> Assertion
|
inlocationlog :: FilePath -> Assertion
|
||||||
|
|
Loading…
Reference in a new issue