better limiting of start actions to only run whenAnnexed
Mostly only refactoring, but this does remove one redundant stat of the symlink by copy.
This commit is contained in:
parent
4389782628
commit
b327227ba5
16 changed files with 67 additions and 63 deletions
10
Command.hs
10
Command.hs
|
@ -15,8 +15,8 @@ module Command (
|
||||||
stop,
|
stop,
|
||||||
prepCommand,
|
prepCommand,
|
||||||
doCommand,
|
doCommand,
|
||||||
|
whenAnnexed,
|
||||||
notAnnexed,
|
notAnnexed,
|
||||||
isAnnexed,
|
|
||||||
notBareRepo,
|
notBareRepo,
|
||||||
isBareRepo,
|
isBareRepo,
|
||||||
autoCopies
|
autoCopies
|
||||||
|
@ -65,12 +65,14 @@ doCommand = start
|
||||||
failure = showEndFail >> return False
|
failure = showEndFail >> return False
|
||||||
status r = showEndResult r >> return r
|
status r = showEndResult r >> return r
|
||||||
|
|
||||||
|
{- Modifies an action to only act on files that are already annexed,
|
||||||
|
- and passes the key and backend on to it. -}
|
||||||
|
whenAnnexed :: (FilePath -> (Key, Backend Annex) -> Annex (Maybe a)) -> FilePath -> Annex (Maybe a)
|
||||||
|
whenAnnexed a file = maybe (return Nothing) (a file) =<< Backend.lookupFile file
|
||||||
|
|
||||||
notAnnexed :: FilePath -> Annex (Maybe a) -> Annex (Maybe a)
|
notAnnexed :: FilePath -> Annex (Maybe a) -> Annex (Maybe a)
|
||||||
notAnnexed file a = maybe a (const $ return Nothing) =<< Backend.lookupFile file
|
notAnnexed file a = maybe a (const $ return Nothing) =<< Backend.lookupFile file
|
||||||
|
|
||||||
isAnnexed :: FilePath -> ((Key, Backend Annex) -> Annex (Maybe a)) -> Annex (Maybe a)
|
|
||||||
isAnnexed file a = maybe (return Nothing) a =<< Backend.lookupFile file
|
|
||||||
|
|
||||||
notBareRepo :: Annex a -> Annex a
|
notBareRepo :: Annex a -> Annex a
|
||||||
notBareRepo a = do
|
notBareRepo a = do
|
||||||
whenM isBareRepo $
|
whenM isBareRepo $
|
||||||
|
|
|
@ -7,6 +7,7 @@
|
||||||
|
|
||||||
module Command.Copy where
|
module Command.Copy where
|
||||||
|
|
||||||
|
import Common.Annex
|
||||||
import Command
|
import Command
|
||||||
import qualified Command.Move
|
import qualified Command.Move
|
||||||
|
|
||||||
|
@ -16,11 +17,10 @@ def = [dontCheck toOpt $ dontCheck fromOpt $
|
||||||
"copy content of files to/from another repository"]
|
"copy content of files to/from another repository"]
|
||||||
|
|
||||||
seek :: [CommandSeek]
|
seek :: [CommandSeek]
|
||||||
seek = [withNumCopies start]
|
seek = [withNumCopies $ \n -> whenAnnexed $ start n]
|
||||||
|
|
||||||
-- A copy is just a move that does not delete the source file.
|
-- A copy is just a move that does not delete the source file.
|
||||||
-- However, --auto mode avoids unnecessary copies.
|
-- However, --auto mode avoids unnecessary copies.
|
||||||
start :: FilePath -> Maybe Int -> CommandStart
|
start :: Maybe Int -> FilePath -> (Key, Backend Annex) -> CommandStart
|
||||||
start file numcopies = isAnnexed file $ \(key, _) ->
|
start numcopies file (key, backend) = autoCopies key (<) numcopies $
|
||||||
autoCopies key (<) numcopies $
|
Command.Move.start False file (key, backend)
|
||||||
Command.Move.start False file
|
|
||||||
|
|
|
@ -22,20 +22,19 @@ def = [dontCheck fromOpt $ command "drop" paramPaths seek
|
||||||
"indicate content of files not currently wanted"]
|
"indicate content of files not currently wanted"]
|
||||||
|
|
||||||
seek :: [CommandSeek]
|
seek :: [CommandSeek]
|
||||||
seek = [withNumCopies start]
|
seek = [withNumCopies $ \n -> whenAnnexed $ start n]
|
||||||
|
|
||||||
start :: FilePath -> Maybe Int -> CommandStart
|
start :: Maybe Int -> FilePath -> (Key, Backend Annex) -> CommandStart
|
||||||
start file numcopies = isAnnexed file $ \(key, _) ->
|
start numcopies file (key, _) = autoCopies key (>) numcopies $ do
|
||||||
autoCopies key (>) numcopies $ do
|
from <- Annex.getState Annex.fromremote
|
||||||
from <- Annex.getState Annex.fromremote
|
case from of
|
||||||
case from of
|
Nothing -> startLocal file numcopies key
|
||||||
Nothing -> startLocal file numcopies key
|
Just name -> do
|
||||||
Just name -> do
|
remote <- Remote.byName name
|
||||||
remote <- Remote.byName name
|
u <- getUUID
|
||||||
u <- getUUID
|
if Remote.uuid remote == u
|
||||||
if Remote.uuid remote == u
|
then startLocal file numcopies key
|
||||||
then startLocal file numcopies key
|
else startRemote file numcopies key remote
|
||||||
else startRemote file numcopies key remote
|
|
||||||
|
|
||||||
startLocal :: FilePath -> Maybe Int -> Key -> CommandStart
|
startLocal :: FilePath -> Maybe Int -> Key -> CommandStart
|
||||||
startLocal file numcopies key = do
|
startLocal file numcopies key = do
|
||||||
|
|
|
@ -16,10 +16,10 @@ def :: [Command]
|
||||||
def = [command "find" paramPaths seek "lists available files"]
|
def = [command "find" paramPaths seek "lists available files"]
|
||||||
|
|
||||||
seek :: [CommandSeek]
|
seek :: [CommandSeek]
|
||||||
seek = [withFilesInGit start]
|
seek = [withFilesInGit $ whenAnnexed start]
|
||||||
|
|
||||||
start :: FilePath -> CommandStart
|
start :: FilePath -> (Key, Backend Annex) -> CommandStart
|
||||||
start file = isAnnexed file $ \(key, _) -> do
|
start file (key, _) = do
|
||||||
-- only files inAnnex are shown, unless the user has requested
|
-- only files inAnnex are shown, unless the user has requested
|
||||||
-- others via a limit
|
-- others via a limit
|
||||||
whenM (liftM2 (||) (inAnnex key) limited) $
|
whenM (liftM2 (||) (inAnnex key) limited) $
|
||||||
|
|
|
@ -17,11 +17,11 @@ def = [command "fix" paramPaths seek
|
||||||
"fix up symlinks to point to annexed content"]
|
"fix up symlinks to point to annexed content"]
|
||||||
|
|
||||||
seek :: [CommandSeek]
|
seek :: [CommandSeek]
|
||||||
seek = [withFilesInGit start]
|
seek = [withFilesInGit $ whenAnnexed start]
|
||||||
|
|
||||||
{- Fixes the symlink to an annexed file. -}
|
{- Fixes the symlink to an annexed file. -}
|
||||||
start :: FilePath -> CommandStart
|
start :: FilePath -> (Key, Backend Annex) -> CommandStart
|
||||||
start file = isAnnexed file $ \(key, _) -> do
|
start file (key, _) = do
|
||||||
link <- calcGitLink file key
|
link <- calcGitLink file key
|
||||||
l <- liftIO $ readSymbolicLink file
|
l <- liftIO $ readSymbolicLink file
|
||||||
if link == l
|
if link == l
|
||||||
|
|
|
@ -25,10 +25,13 @@ def :: [Command]
|
||||||
def = [command "fsck" paramPaths seek "check for problems"]
|
def = [command "fsck" paramPaths seek "check for problems"]
|
||||||
|
|
||||||
seek :: [CommandSeek]
|
seek :: [CommandSeek]
|
||||||
seek = [withNumCopies start, withBarePresentKeys startBare]
|
seek =
|
||||||
|
[ withNumCopies $ \n -> whenAnnexed $ start n
|
||||||
|
, withBarePresentKeys startBare
|
||||||
|
]
|
||||||
|
|
||||||
start :: FilePath -> Maybe Int -> CommandStart
|
start :: Maybe Int -> FilePath -> (Key, Backend Annex) -> CommandStart
|
||||||
start file numcopies = isAnnexed file $ \(key, backend) -> do
|
start numcopies file (key, backend) = do
|
||||||
showStart "fsck" file
|
showStart "fsck" file
|
||||||
next $ perform key file backend numcopies
|
next $ perform key file backend numcopies
|
||||||
|
|
||||||
|
|
|
@ -19,10 +19,10 @@ def = [dontCheck fromOpt $ command "get" paramPaths seek
|
||||||
"make content of annexed files available"]
|
"make content of annexed files available"]
|
||||||
|
|
||||||
seek :: [CommandSeek]
|
seek :: [CommandSeek]
|
||||||
seek = [withNumCopies start]
|
seek = [withNumCopies $ \n -> whenAnnexed $ start n]
|
||||||
|
|
||||||
start :: FilePath -> Maybe Int -> CommandStart
|
start :: Maybe Int -> FilePath -> (Key, Backend Annex) -> CommandStart
|
||||||
start file numcopies = isAnnexed file $ \(key, _) -> do
|
start numcopies file (key, _) = do
|
||||||
inannex <- inAnnex key
|
inannex <- inAnnex key
|
||||||
if inannex
|
if inannex
|
||||||
then stop
|
then stop
|
||||||
|
|
|
@ -13,17 +13,16 @@ import qualified Backend
|
||||||
import qualified Types.Key
|
import qualified Types.Key
|
||||||
import Annex.Content
|
import Annex.Content
|
||||||
import qualified Command.Add
|
import qualified Command.Add
|
||||||
import Backend
|
|
||||||
import Logs.Web
|
import Logs.Web
|
||||||
|
|
||||||
def :: [Command]
|
def :: [Command]
|
||||||
def = [command "migrate" paramPaths seek "switch data to different backend"]
|
def = [command "migrate" paramPaths seek "switch data to different backend"]
|
||||||
|
|
||||||
seek :: [CommandSeek]
|
seek :: [CommandSeek]
|
||||||
seek = [withBackendFilesInGit start]
|
seek = [withBackendFilesInGit $ \(b, f) -> whenAnnexed (start b) f]
|
||||||
|
|
||||||
start :: BackendFile -> CommandStart
|
start :: Maybe (Backend Annex) -> FilePath -> (Key, Backend Annex) -> CommandStart
|
||||||
start (b, file) = isAnnexed file $ \(key, oldbackend) -> do
|
start b file (key, oldbackend) = do
|
||||||
exists <- inAnnex key
|
exists <- inAnnex key
|
||||||
newbackend <- choosebackend b
|
newbackend <- choosebackend b
|
||||||
if (newbackend /= oldbackend || upgradableKey key) && exists
|
if (newbackend /= oldbackend || upgradableKey key) && exists
|
||||||
|
|
|
@ -21,14 +21,14 @@ def = [dontCheck toOpt $ dontCheck fromOpt $
|
||||||
"move content of files to/from another repository"]
|
"move content of files to/from another repository"]
|
||||||
|
|
||||||
seek :: [CommandSeek]
|
seek :: [CommandSeek]
|
||||||
seek = [withFilesInGit $ start True]
|
seek = [withFilesInGit $ whenAnnexed $ start True]
|
||||||
|
|
||||||
{- Move (or copy) a file either --to or --from a repository.
|
{- Move (or copy) a file either --to or --from a repository.
|
||||||
-
|
-
|
||||||
- This only operates on the cached file content; it does not involve
|
- This only operates on the cached file content; it does not involve
|
||||||
- moving data in the key-value backend. -}
|
- moving data in the key-value backend. -}
|
||||||
start :: Bool -> FilePath -> CommandStart
|
start :: Bool -> FilePath -> (Key, Backend Annex) -> CommandStart
|
||||||
start move file = isAnnexed file $ \(key, _) -> do
|
start move file (key, _) = do
|
||||||
noAuto
|
noAuto
|
||||||
to <- Annex.getState Annex.toremote
|
to <- Annex.getState Annex.toremote
|
||||||
from <- Annex.getState Annex.fromremote
|
from <- Annex.getState Annex.fromremote
|
||||||
|
|
|
@ -18,8 +18,9 @@ def = [command "pre-commit" paramPaths seek "run by git pre-commit hook"]
|
||||||
{- The pre-commit hook needs to fix symlinks to all files being committed.
|
{- The pre-commit hook needs to fix symlinks to all files being committed.
|
||||||
- And, it needs to inject unlocked files into the annex. -}
|
- And, it needs to inject unlocked files into the annex. -}
|
||||||
seek :: [CommandSeek]
|
seek :: [CommandSeek]
|
||||||
seek = [withFilesToBeCommitted Command.Fix.start,
|
seek =
|
||||||
withFilesUnlockedToBeCommitted start]
|
[ withFilesToBeCommitted $ whenAnnexed Command.Fix.start
|
||||||
|
, withFilesUnlockedToBeCommitted start]
|
||||||
|
|
||||||
start :: BackendFile -> CommandStart
|
start :: BackendFile -> CommandStart
|
||||||
start p = next $ perform p
|
start p = next $ perform p
|
||||||
|
|
|
@ -25,19 +25,19 @@ start (src:dest:[])
|
||||||
| src == dest = stop
|
| src == dest = stop
|
||||||
| otherwise = do
|
| otherwise = do
|
||||||
showStart "reinject" dest
|
showStart "reinject" dest
|
||||||
next $ perform src dest
|
next $ whenAnnexed (perform src) dest
|
||||||
start _ = error "specify a src file and a dest file"
|
start _ = error "specify a src file and a dest file"
|
||||||
|
|
||||||
perform :: FilePath -> FilePath -> CommandPerform
|
perform :: FilePath -> FilePath -> (Key, Backend Annex) -> CommandPerform
|
||||||
perform src dest = isAnnexed dest $ \(key, backend) -> do
|
perform src _dest (key, backend) = do
|
||||||
unlessM (move key) $ error "mv failed!"
|
unlessM move $ error "mv failed!"
|
||||||
next $ cleanup key backend
|
next $ cleanup key backend
|
||||||
where
|
where
|
||||||
-- the file might be on a different filesystem,
|
-- the file might be on a different filesystem,
|
||||||
-- so mv is used rather than simply calling
|
-- so mv is used rather than simply calling
|
||||||
-- moveToObjectDir; disk space is also
|
-- moveToObjectDir; disk space is also
|
||||||
-- checked this way.
|
-- checked this way.
|
||||||
move key = getViaTmp key $ \tmp ->
|
move = getViaTmp key $ \tmp ->
|
||||||
liftIO $ boolSystem "mv" [File src, File tmp]
|
liftIO $ boolSystem "mv" [File src, File tmp]
|
||||||
|
|
||||||
cleanup :: Key -> Backend Annex -> CommandCleanup
|
cleanup :: Key -> Backend Annex -> CommandCleanup
|
||||||
|
|
|
@ -21,11 +21,11 @@ def :: [Command]
|
||||||
def = [command "unannex" paramPaths seek "undo accidential add command"]
|
def = [command "unannex" paramPaths seek "undo accidential add command"]
|
||||||
|
|
||||||
seek :: [CommandSeek]
|
seek :: [CommandSeek]
|
||||||
seek = [withFilesInGit start]
|
seek = [withFilesInGit $ whenAnnexed start]
|
||||||
|
|
||||||
{- The unannex subcommand undoes an add. -}
|
{- The unannex subcommand undoes an add. -}
|
||||||
start :: FilePath -> CommandStart
|
start :: FilePath -> (Key, Backend Annex) -> CommandStart
|
||||||
start file = isAnnexed file $ \(key, _) -> do
|
start file (key, _) = do
|
||||||
ishere <- inAnnex key
|
ishere <- inAnnex key
|
||||||
if ishere
|
if ishere
|
||||||
then do
|
then do
|
||||||
|
|
|
@ -33,15 +33,15 @@ check = do
|
||||||
[Params "rev-parse --abbrev-ref HEAD"]
|
[Params "rev-parse --abbrev-ref HEAD"]
|
||||||
|
|
||||||
seek :: [CommandSeek]
|
seek :: [CommandSeek]
|
||||||
seek = [withFilesInGit startUnannex, withNothing start]
|
seek = [withFilesInGit $ whenAnnexed startUnannex, withNothing start]
|
||||||
|
|
||||||
startUnannex :: FilePath -> CommandStart
|
startUnannex :: FilePath -> (Key, Backend Annex) -> CommandStart
|
||||||
startUnannex file = do
|
startUnannex file info = do
|
||||||
-- Force fast mode before running unannex. This way, if multiple
|
-- Force fast mode before running unannex. This way, if multiple
|
||||||
-- files link to a key, it will be left in the annex and hardlinked
|
-- files link to a key, it will be left in the annex and hardlinked
|
||||||
-- to by each.
|
-- to by each.
|
||||||
Annex.changeState $ \s -> s { Annex.fast = True }
|
Annex.changeState $ \s -> s { Annex.fast = True }
|
||||||
Command.Unannex.start file
|
Command.Unannex.start file info
|
||||||
|
|
||||||
start :: CommandStart
|
start :: CommandStart
|
||||||
start = next perform
|
start = next perform
|
||||||
|
|
|
@ -22,12 +22,12 @@ def =
|
||||||
c n = command n paramPaths seek
|
c n = command n paramPaths seek
|
||||||
|
|
||||||
seek :: [CommandSeek]
|
seek :: [CommandSeek]
|
||||||
seek = [withFilesInGit start]
|
seek = [withFilesInGit $ whenAnnexed start]
|
||||||
|
|
||||||
{- The unlock subcommand replaces the symlink with a copy of the file's
|
{- The unlock subcommand replaces the symlink with a copy of the file's
|
||||||
- content. -}
|
- content. -}
|
||||||
start :: FilePath -> CommandStart
|
start :: FilePath -> (Key, Backend Annex) -> CommandStart
|
||||||
start file = isAnnexed file $ \(key, _) -> do
|
start file (key, _) = do
|
||||||
showStart "unlock" file
|
showStart "unlock" file
|
||||||
next $ perform file key
|
next $ perform file key
|
||||||
|
|
||||||
|
|
|
@ -18,10 +18,10 @@ def = [command "whereis" paramPaths seek
|
||||||
"lists repositories that have file content"]
|
"lists repositories that have file content"]
|
||||||
|
|
||||||
seek :: [CommandSeek]
|
seek :: [CommandSeek]
|
||||||
seek = [withFilesInGit start]
|
seek = [withFilesInGit $ whenAnnexed start]
|
||||||
|
|
||||||
start :: FilePath -> CommandStart
|
start :: FilePath -> (Key, Backend Annex) -> CommandStart
|
||||||
start file = isAnnexed file $ \(key, _) -> do
|
start file (key, _) = do
|
||||||
showStart "whereis" file
|
showStart "whereis" file
|
||||||
next $ perform key
|
next $ perform key
|
||||||
|
|
||||||
|
|
4
Seek.hs
4
Seek.hs
|
@ -33,10 +33,10 @@ withAttrFilesInGit attr a params = do
|
||||||
files <- seekHelper LsFiles.inRepo params
|
files <- seekHelper LsFiles.inRepo params
|
||||||
prepFilteredGen a fst $ inRepo $ Git.checkAttr attr files
|
prepFilteredGen a fst $ inRepo $ Git.checkAttr attr files
|
||||||
|
|
||||||
withNumCopies :: (FilePath -> Maybe Int -> CommandStart) -> CommandSeek
|
withNumCopies :: (Maybe Int -> FilePath -> CommandStart) -> CommandSeek
|
||||||
withNumCopies a params = withAttrFilesInGit "annex.numcopies" go params
|
withNumCopies a params = withAttrFilesInGit "annex.numcopies" go params
|
||||||
where
|
where
|
||||||
go (file, v) = a file (readMaybe v)
|
go (file, v) = a (readMaybe v) file
|
||||||
|
|
||||||
withBackendFilesInGit :: (BackendFile -> CommandStart) -> CommandSeek
|
withBackendFilesInGit :: (BackendFile -> CommandStart) -> CommandSeek
|
||||||
withBackendFilesInGit a params = do
|
withBackendFilesInGit a params = do
|
||||||
|
|
Loading…
Reference in a new issue