git-annex/Command/Copy.hs

{- git-annex command
 -
 - Copyright 2010 Joey Hess <joey@kitenet.net>
 -
 - Licensed under the GNU GPL version 3 or higher.
 -}

module Command.Copy where

import Common.Annex
import Command
import qualified Command.Move
import qualified Remote
import Annex.Wanted

def :: [Command]
def = [withOptions Command.Move.options $ command "copy" paramPaths seek
	"copy content of files to/from another repository"]

seek :: [CommandSeek]
seek = [withField Command.Move.toOption Remote.byName $ \to ->
		withField Command.Move.fromOption Remote.byName $ \from ->
			withFilesInGit $ whenAnnexed $ start to from]

{- 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)
  where
	shouldCopy = checkAuto (check <||> numCopiesCheck file key (<))
	check = case to of
		Nothing -> wantGet False (Just file)
		Just r -> wantSend False (Just file) (Remote.uuid r)
add 2010-11-27 21:09:22 +00:00			`{- git-annex command`
			`-`
			`- Copyright 2010 Joey Hess <joey@kitenet.net>`
			`-`
			`- Licensed under the GNU GPL version 3 or higher.`
			`-}`

			`module Command.Copy where`

better limiting of start actions to only run whenAnnexed Mostly only refactoring, but this does remove one redundant stat of the symlink by copy. 2011-11-11 03:35:08 +00:00			`import Common.Annex`
add 2010-11-27 21:09:22 +00:00			`import Command`
			`import qualified Command.Move`
look up --to and --from remote names only once This will speed up commands like move and drop. 2012-01-06 08:02:35 +00:00			`import qualified Remote`
make copy --to check preferred content of the remote 2012-10-08 20:06:56 +00:00			`import Annex.Wanted`
add 2010-11-27 21:09:22 +00:00
clean up check selection code This new approach allows filtering out checks from the default set that are not appropriate for a command, rather than having to list every check that is appropriate. It also reduces some boilerplate. Haskell does not define Eq for functions, so I had to go a long way around with each check having a unique id. Meh. 2011-10-29 19:19:05 +00:00			`def :: [Command]`
More commands work in direct mode repositories: find, whereis, move, copy, drop, log. These started working, for free, once lookupFile supported direct mode. yay!! 2013-01-05 21:16:58 +00:00			`def = [withOptions Command.Move.options $ command "copy" paramPaths seek`
			`"copy content of files to/from another repository"]`
refactor in preparation for adding a git-annex-shell command 2010-12-30 19:06:26 +00:00
rename some stuff and prepare to break out more into Command/* 2010-12-30 18:19:16 +00:00			`seek :: [CommandSeek]`
tweak 2012-01-06 14:14:37 +00:00			`seek = [withField Command.Move.toOption Remote.byName $ \to ->`
			`withField Command.Move.fromOption Remote.byName $ \from ->`
rework git check-attr interface Now gitattributes are looked up, efficiently, in only the places that really need them, using the same approach used for cat-file. The old CheckAttr code seemed very fragile, in the way it streamed files through git check-attr. I actually found that cad8824852aa0623dc41eac02a9e2bae47d88ec4 was still deadlocking with ghc 7.4, at the end of adding a lot of files. This should fix that problem, and avoid future ones. The best part is that this removes withAttrFilesInGit and withNumCopies, which were complicated Seek methods, as well as simplfying the types for several other Seek methods that had a Backend tupled in. 2012-02-14 03:42:44 +00:00			`withFilesInGit $ whenAnnexed $ start to from]`
copy --auto Only does copy when numcopies is not yet satisfied. 2011-09-15 19:27:45 +00:00
make copy --to check preferred content of the remote 2012-10-08 20:06:56 +00:00			`{- 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. -}`
rework git check-attr interface Now gitattributes are looked up, efficiently, in only the places that really need them, using the same approach used for cat-file. The old CheckAttr code seemed very fragile, in the way it streamed files through git check-attr. I actually found that cad8824852aa0623dc41eac02a9e2bae47d88ec4 was still deadlocking with ghc 7.4, at the end of adding a lot of files. This should fix that problem, and avoid future ones. The best part is that this removes withAttrFilesInGit and withNumCopies, which were complicated Seek methods, as well as simplfying the types for several other Seek methods that had a Backend tupled in. 2012-02-14 03:42:44 +00:00			`start :: Maybe Remote -> Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart`
--auto fixes * get/copy --auto: Transfer data even if it would exceed numcopies, when preferred content settings want it. * drop --auto: Fix dropping content when there are no preferred content settings. 2012-12-06 17:22:16 +00:00			`start to from file (key, backend) = stopUnless shouldCopy $`
			`Command.Move.start to from False file (key, backend)`
where indentation 2012-11-12 05:05:04 +00:00			`where`
--auto fixes * get/copy --auto: Transfer data even if it would exceed numcopies, when preferred content settings want it. * drop --auto: Fix dropping content when there are no preferred content settings. 2012-12-06 17:22:16 +00:00			`shouldCopy = checkAuto (check <\|\|> numCopiesCheck file key (<))`
			`check = case to of`
			`Nothing -> wantGet False (Just file)`
			`Just r -> wantSend False (Just file) (Remote.uuid r)`