replace (Key, Backend) with Key

Only fsck and reinject and the test suite used the Backend, and they can
look it up as needed from the Key. This simplifies the code and also speeds
it up.

There is a small behavior change here. Before, all commands would warn when
acting on an annexed file with an unknown backend. Now, only fsck and
reinject show that warning.
This commit is contained in:
Joey Hess 2014-04-17 18:03:39 -04:00
parent 41c7aaa65c
commit e880d0d22c
33 changed files with 112 additions and 94 deletions

View file

@ -73,7 +73,7 @@ start file = ifAnnexed file addpresent add
| otherwise -> do
showStart "add" file
next $ perform file
addpresent (key, _) = ifM isDirect
addpresent key = ifM isDirect
( ifM (goodContent key file) ( stop , add )
, fixup key
)

View file

@ -96,7 +96,7 @@ performQuvi :: Bool -> URLString -> URLString -> FilePath -> CommandPerform
performQuvi relaxed pageurl videourl file = ifAnnexed file addurl geturl
where
quviurl = setDownloader pageurl QuviDownloader
addurl (key, _backend) = next $ cleanup quviurl file key Nothing
addurl key = next $ cleanup quviurl file key Nothing
geturl = next $ addUrlFileQuvi relaxed quviurl videourl file
#endif
@ -130,7 +130,7 @@ perform :: Bool -> URLString -> FilePath -> CommandPerform
perform relaxed url file = ifAnnexed file addurl geturl
where
geturl = next $ addUrlFile relaxed url file
addurl (key, _backend)
addurl key
| relaxed = do
setUrlPresent key url
next $ return True

View file

@ -30,9 +30,9 @@ seek ps = do
{- A copy is just a move that does not delete the source file.
- However, --auto mode avoids unnecessary copies, and avoids getting or
- sending non-preferred content. -}
start :: Maybe Remote -> Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart
start to from file (key, backend) = stopUnless shouldCopy $
Command.Move.start to from False file (key, backend)
start :: Maybe Remote -> Maybe Remote -> FilePath -> Key -> CommandStart
start to from file key = stopUnless shouldCopy $
Command.Move.start to from False file key
where
shouldCopy = checkAuto (check <||> numCopiesCheck file key (<))
check = case to of

View file

@ -47,7 +47,7 @@ perform = do
void $ liftIO clean
next cleanup
where
go = whenAnnexed $ \f (k, _) -> do
go = whenAnnexed $ \f k -> do
r <- toDirectGen k f
case r of
Nothing -> noop

View file

@ -34,8 +34,8 @@ seek ps = do
from <- getOptionField dropFromOption Remote.byNameWithUUID
withFilesInGit (whenAnnexed $ start from) ps
start :: Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart
start from file (key, _) = checkDropAuto from file key $ \numcopies ->
start :: Maybe Remote -> FilePath -> Key -> CommandStart
start from file key = checkDropAuto from file key $ \numcopies ->
stopUnless (checkAuto $ wantDrop False (Remote.uuid <$> from) (Just key) (Just file)) $
case from of
Nothing -> startLocal (Just file) numcopies key Nothing

View file

@ -39,8 +39,8 @@ seek ps = do
format <- getFormat
withFilesInGit (whenAnnexed $ start format) ps
start :: Maybe Utility.Format.Format -> FilePath -> (Key, Backend) -> CommandStart
start format file (key, _) = do
start :: Maybe Utility.Format.Format -> FilePath -> Key -> CommandStart
start format file key = do
-- only files inAnnex are shown, unless the user has requested
-- others via a limit
whenM (limited <||> inAnnex key) $

View file

@ -26,8 +26,8 @@ seek :: CommandSeek
seek = withFilesInGit $ whenAnnexed start
{- Fixes the symlink to an annexed file. -}
start :: FilePath -> (Key, Backend) -> CommandStart
start file (key, _) = do
start :: FilePath -> Key -> CommandStart
start file key = do
link <- inRepo $ gitAnnexLink file key
stopUnless ((/=) (Just link) <$> liftIO (catchMaybeIO $ readSymbolicLink file)) $ do
showStart "fix" file

View file

@ -104,12 +104,16 @@ getIncremental = do
resetStartTime
return True
start :: Maybe Remote -> Incremental -> FilePath -> (Key, Backend) -> CommandStart
start from inc file (key, backend) = do
numcopies <- getFileNumCopies file
case from of
Nothing -> go $ perform key file backend numcopies
Just r -> go $ performRemote key file backend numcopies r
start :: Maybe Remote -> Incremental -> FilePath -> Key -> CommandStart
start from inc file key = do
v <- Backend.getBackend file key
case v of
Nothing -> stop
Just backend -> do
numcopies <- getFileNumCopies file
case from of
Nothing -> go $ perform key file backend numcopies
Just r -> go $ performRemote key file backend numcopies r
where
go = runFsck inc file key

View file

@ -31,8 +31,8 @@ seek ps = do
(withFilesInGit $ whenAnnexed $ start from)
ps
start :: Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart
start from file (key, _) = start' expensivecheck from key (Just file)
start :: Maybe Remote -> FilePath -> Key -> CommandStart
start from file key = start' expensivecheck from key (Just file)
where
expensivecheck = checkAuto (numCopiesCheck file key (<) <||> wantGet False (Just key) (Just file))

View file

@ -194,7 +194,7 @@ performDownload relaxed cache todownload = case location todownload of
in d </> show n ++ "_" ++ base
tryanother = makeunique url (n + 1) file
alreadyexists = liftIO $ isJust <$> catchMaybeIO (getSymbolicLinkStatus f)
checksameurl (k, _) = ifM (elem url <$> getUrls k)
checksameurl k = ifM (elem url <$> getUrls k)
( return Nothing
, tryanother
)

View file

@ -74,7 +74,7 @@ perform = do
case r of
Just s
| isSymbolicLink s -> void $ flip whenAnnexed f $
\_ (k, _) -> do
\_ k -> do
removeInodeCache k
removeAssociatedFiles k
return Nothing

View file

@ -60,8 +60,8 @@ getList = ifM (Annex.getFlag $ optionName allrepos)
printHeader :: [(UUID, RemoteName, TrustLevel)] -> Annex ()
printHeader l = liftIO $ putStrLn $ header $ map (\(_, n, t) -> (n, t)) l
start :: [(UUID, RemoteName, TrustLevel)] -> FilePath -> (Key, Backend) -> CommandStart
start l file (key, _) = do
start :: [(UUID, RemoteName, TrustLevel)] -> FilePath -> Key -> CommandStart
start l file key = do
ls <- S.fromList <$> keyLocations key
liftIO $ putStrLn $ format (map (\(u, _, t) -> (t, S.member u ls)) l) file
stop

View file

@ -64,9 +64,15 @@ seek ps = do
Annex.getField (optionName o)
use o v = [Param ("--" ++ optionName o), Param v]
start :: M.Map UUID String -> TimeZone -> [CommandParam] -> Bool ->
FilePath -> (Key, Backend) -> CommandStart
start m zone os gource file (key, _) = do
start
:: M.Map UUID String
-> TimeZone
-> [CommandParam]
-> Bool
-> FilePath
-> Key
-> CommandStart
start m zone os gource file key = do
showLog output =<< readLog <$> getLog key os
-- getLog produces a zombie; reap it
liftIO reapZombies

View file

@ -63,8 +63,8 @@ seek ps = do
(withFilesInGit (whenAnnexed $ start now getfield modmeta))
ps
start :: POSIXTime -> Maybe MetaField -> [ModMeta] -> FilePath -> (Key, Backend) -> CommandStart
start now f ms file (k, _) = start' (Just file) now f ms k
start :: POSIXTime -> Maybe MetaField -> [ModMeta] -> FilePath -> Key -> CommandStart
start now f ms file = start' (Just file) now f ms
startKeys :: POSIXTime -> Maybe MetaField -> [ModMeta] -> Key -> CommandStart
startKeys = start' Nothing

View file

@ -25,15 +25,19 @@ def = [notDirect $
seek :: CommandSeek
seek = withFilesInGit $ whenAnnexed start
start :: FilePath -> (Key, Backend) -> CommandStart
start file (key, oldbackend) = do
exists <- inAnnex key
newbackend <- choosebackend =<< chooseBackend file
if (newbackend /= oldbackend || upgradableKey oldbackend key) && exists
then do
showStart "migrate" file
next $ perform file key oldbackend newbackend
else stop
start :: FilePath -> Key -> CommandStart
start file key = do
v <- Backend.getBackend file key
case v of
Nothing -> stop
Just oldbackend -> do
exists <- inAnnex key
newbackend <- choosebackend =<< chooseBackend file
if (newbackend /= oldbackend || upgradableKey oldbackend key) && exists
then do
showStart "migrate" file
next $ perform file key oldbackend newbackend
else stop
where
choosebackend Nothing = Prelude.head <$> orderedList
choosebackend (Just backend) = return backend

View file

@ -31,8 +31,8 @@ seek ps = do
(withFilesInGit $ whenAnnexed $ start to from)
ps
start :: Maybe Remote -> Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart
start to from file (key, _backend) = startKey to from (Just file) key
start :: Maybe Remote -> Maybe Remote -> FilePath -> Key -> CommandStart
start to from file key = startKey to from (Just file) key
startKey :: Maybe Remote -> Maybe Remote -> Maybe FilePath -> Key -> CommandStart
startKey to from afile key = do

View file

@ -33,8 +33,8 @@ seek ps = do
(withFilesInGit $ whenAnnexed $ start to from True)
ps
start :: Maybe Remote -> Maybe Remote -> Bool -> FilePath -> (Key, Backend) -> CommandStart
start to from move file (key, _) = start' to from move (Just file) key
start :: Maybe Remote -> Maybe Remote -> Bool -> FilePath -> Key -> CommandStart
start to from move file key = start' to from move (Just file) key
startKey :: Maybe Remote -> Maybe Remote -> Bool -> Key -> CommandStart
startKey to from move = start' to from move Nothing

View file

@ -29,7 +29,7 @@ start :: (FilePath, String) -> CommandStart
start (file, keyname) = ifAnnexed file go stop
where
newkey = fromMaybe (error "bad key") $ file2key keyname
go (oldkey, _)
go oldkey
| oldkey == newkey = stop
| otherwise = do
showStart "rekey" file

View file

@ -12,6 +12,7 @@ import Command
import Logs.Location
import Annex.Content
import qualified Command.Fsck
import qualified Backend
def :: [Command]
def = [command "reinject" (paramPair "SRC" "DEST") seek
@ -33,16 +34,20 @@ start (src:dest:[])
next $ whenAnnexed (perform src) dest
start _ = error "specify a src file and a dest file"
perform :: FilePath -> FilePath -> (Key, Backend) -> CommandPerform
perform src _dest (key, backend) =
perform :: FilePath -> FilePath -> Key -> CommandPerform
perform src dest key = do
{- Check the content before accepting it. -}
ifM (Command.Fsck.checkKeySizeOr reject key src
<&&> Command.Fsck.checkBackendOr reject backend key src)
( do
unlessM move $ error "mv failed!"
next $ cleanup key
, error "not reinjecting"
)
v <- Backend.getBackend dest key
case v of
Nothing -> stop
Just backend ->
ifM (Command.Fsck.checkKeySizeOr reject key src
<&&> Command.Fsck.checkBackendOr reject backend key src)
( do
unlessM move $ error "mv failed!"
next $ cleanup key
, error "not reinjecting"
)
where
-- the file might be on a different filesystem,
-- so mv is used rather than simply calling

View file

@ -20,7 +20,7 @@ seek :: CommandSeek
seek = withPairs start
start :: (FilePath, String) -> CommandStart
start (file, url) = flip whenAnnexed file $ \_ (key, _) -> do
start (file, url) = flip whenAnnexed file $ \_ key -> do
showStart "rmurl" file
next $ next $ cleanup url key

View file

@ -338,8 +338,8 @@ seekSyncContent rs = do
(\v -> void (liftIO (tryPutMVar mvar ())) >> syncFile rs f v)
noop
syncFile :: [Remote] -> FilePath -> (Key, Backend) -> Annex ()
syncFile rs f (k, _) = do
syncFile :: [Remote] -> FilePath -> Key -> Annex ()
syncFile rs f k = do
locs <- loggedLocations k
let (have, lack) = partition (\r -> Remote.uuid r `elem` locs) rs

View file

@ -58,8 +58,8 @@ wrapUnannex a = ifM isDirect
then void (liftIO cleanup) >> return True
else void (liftIO cleanup) >> return False
start :: FilePath -> (Key, Backend) -> CommandStart
start file (key, _) = stopUnless (inAnnex key) $ do
start :: FilePath -> Key -> CommandStart
start file key = stopUnless (inAnnex key) $ do
showStart "unannex" file
next $ ifM isDirect
( performDirect file key

View file

@ -44,7 +44,7 @@ seek ps = do
{- git annex symlinks that are not checked into git could be left by an
- interrupted add. -}
startCheckIncomplete :: FilePath -> (Key, Backend) -> CommandStart
startCheckIncomplete :: FilePath -> Key -> CommandStart
startCheckIncomplete file _ = error $ unlines
[ file ++ " points to annexed content, but is not checked into git."
, "Perhaps this was left behind by an interrupted git annex add?"

View file

@ -25,8 +25,8 @@ seek = withFilesInGit $ whenAnnexed start
{- The unlock subcommand replaces the symlink with a copy of the file's
- content. -}
start :: FilePath -> (Key, Backend) -> CommandStart
start file (key, _) = do
start :: FilePath -> Key -> CommandStart
start file key = do
showStart "unlock" file
next $ perform file key

View file

@ -250,7 +250,7 @@ withKeysReferenced' mdir initial a = do
x <- Backend.lookupFile f
case x of
Nothing -> go v fs
Just (k, _) -> do
Just k -> do
!v' <- a k f v
go v' fs
@ -294,7 +294,7 @@ withKeysReferencedInGitRef a ref = do
forM_ ts $ tKey lookAtWorkingTree >=> maybe noop a
liftIO $ void clean
where
tKey True = fmap fst <$$> Backend.lookupFile . getTopFilePath . DiffTree.file
tKey True = Backend.lookupFile . getTopFilePath . DiffTree.file
tKey False = fileKey . takeFileName . decodeBS <$$>
catFile ref . getTopFilePath . DiffTree.file

View file

@ -27,8 +27,8 @@ seek ps = do
(withFilesInGit $ whenAnnexed $ start m)
ps
start :: M.Map UUID Remote -> FilePath -> (Key, Backend) -> CommandStart
start remotemap file (key, _) = start' remotemap key (Just file)
start :: M.Map UUID Remote -> FilePath -> Key -> CommandStart
start remotemap file key = start' remotemap key (Just file)
startKeys :: M.Map UUID Remote -> Key -> CommandStart
startKeys remotemap key = start' remotemap key Nothing