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:
parent
41c7aaa65c
commit
e880d0d22c
33 changed files with 112 additions and 94 deletions
|
@ -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
|
||||
)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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) $
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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))
|
||||
|
||||
|
|
|
@ -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
|
||||
)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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?"
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue