2012-05-31 23:47:18 +00:00
|
|
|
{- git-annex command
|
|
|
|
-
|
2013-08-11 18:31:54 +00:00
|
|
|
- Copyright 2012-2013 Joey Hess <joey@kitenet.net>
|
2012-05-31 23:47:18 +00:00
|
|
|
-
|
|
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
|
|
-}
|
|
|
|
|
|
|
|
module Command.Import where
|
|
|
|
|
2013-05-11 20:03:00 +00:00
|
|
|
import System.PosixCompat.Files
|
|
|
|
|
2012-05-31 23:47:18 +00:00
|
|
|
import Common.Annex
|
|
|
|
import Command
|
|
|
|
import qualified Annex
|
|
|
|
import qualified Command.Add
|
2013-08-11 18:31:54 +00:00
|
|
|
import qualified Option
|
|
|
|
import Utility.CopyFile
|
2013-08-20 15:00:52 +00:00
|
|
|
import Backend
|
|
|
|
import Remote
|
|
|
|
import Types.KeySource
|
2012-05-31 23:47:18 +00:00
|
|
|
|
|
|
|
def :: [Command]
|
2013-08-11 18:31:54 +00:00
|
|
|
def = [withOptions opts $ notBareRepo $ command "import" paramPaths seek
|
2013-03-24 22:28:21 +00:00
|
|
|
SectionCommon "move and add files from outside git working copy"]
|
2012-05-31 23:47:18 +00:00
|
|
|
|
2013-08-11 18:31:54 +00:00
|
|
|
opts :: [Option]
|
|
|
|
opts =
|
|
|
|
[ duplicateOption
|
|
|
|
, deduplicateOption
|
|
|
|
, cleanDuplicatesOption
|
|
|
|
]
|
|
|
|
|
|
|
|
duplicateOption :: Option
|
|
|
|
duplicateOption = Option.flag [] "duplicate" "do not delete outside files"
|
|
|
|
|
|
|
|
deduplicateOption :: Option
|
|
|
|
deduplicateOption = Option.flag [] "deduplicate" "do not add files whose content has been seen"
|
|
|
|
|
|
|
|
cleanDuplicatesOption :: Option
|
|
|
|
cleanDuplicatesOption = Option.flag [] "clean-duplicates" "delete outside duplicate files (import nothing)"
|
|
|
|
|
|
|
|
data DuplicateMode = Default | Duplicate | DeDuplicate | CleanDuplicates
|
|
|
|
deriving (Eq)
|
|
|
|
|
|
|
|
getDuplicateMode :: Annex DuplicateMode
|
|
|
|
getDuplicateMode = gen
|
|
|
|
<$> getflag duplicateOption
|
|
|
|
<*> getflag deduplicateOption
|
|
|
|
<*> getflag cleanDuplicatesOption
|
|
|
|
where
|
|
|
|
getflag = Annex.getFlag . Option.name
|
|
|
|
gen False False False = Default
|
|
|
|
gen True False False = Duplicate
|
|
|
|
gen False True False = DeDuplicate
|
|
|
|
gen False False True = CleanDuplicates
|
|
|
|
gen _ _ _ = error "bad combination of --duplicate, --deduplicate, --clean-duplicates"
|
|
|
|
|
2012-05-31 23:47:18 +00:00
|
|
|
seek :: [CommandSeek]
|
2013-08-11 18:31:54 +00:00
|
|
|
seek = [withValue getDuplicateMode $ \mode -> withPathContents $ start mode]
|
2012-05-31 23:47:18 +00:00
|
|
|
|
2013-08-11 18:31:54 +00:00
|
|
|
start :: DuplicateMode -> (FilePath, FilePath) -> CommandStart
|
|
|
|
start mode (srcfile, destfile) =
|
2012-05-31 23:47:18 +00:00
|
|
|
ifM (liftIO $ isRegularFile <$> getSymbolicLinkStatus srcfile)
|
|
|
|
( do
|
|
|
|
showStart "import" destfile
|
2013-08-11 18:31:54 +00:00
|
|
|
next $ perform mode srcfile destfile
|
2012-05-31 23:47:18 +00:00
|
|
|
, stop
|
|
|
|
)
|
|
|
|
|
2013-08-11 18:31:54 +00:00
|
|
|
perform :: DuplicateMode -> FilePath -> FilePath -> CommandPerform
|
2013-08-20 15:00:52 +00:00
|
|
|
perform mode srcfile destfile =
|
|
|
|
case mode of
|
|
|
|
DeDuplicate -> ifM isdup
|
|
|
|
( deletedup
|
|
|
|
, go
|
|
|
|
)
|
|
|
|
CleanDuplicates -> ifM isdup
|
|
|
|
( deletedup
|
|
|
|
, next $ return True
|
|
|
|
)
|
|
|
|
_ -> go
|
|
|
|
where
|
|
|
|
isdup = do
|
|
|
|
backend <- chooseBackend destfile
|
|
|
|
let ks = KeySource srcfile srcfile Nothing
|
|
|
|
v <- genKey ks backend
|
|
|
|
case v of
|
|
|
|
Just (k, _) -> not . null <$> keyLocations k
|
|
|
|
_ -> return False
|
|
|
|
deletedup = do
|
|
|
|
showNote "duplicate"
|
|
|
|
liftIO $ removeFile srcfile
|
|
|
|
next $ return True
|
|
|
|
go = do
|
|
|
|
whenM (liftIO $ doesFileExist destfile) $
|
|
|
|
unlessM (Annex.getState Annex.force) $
|
|
|
|
error $ "not overwriting existing " ++ destfile ++
|
|
|
|
" (use --force to override)"
|
|
|
|
|
|
|
|
liftIO $ createDirectoryIfMissing True (parentDir destfile)
|
|
|
|
liftIO $ if mode == Duplicate
|
|
|
|
then void $ copyFileExternal srcfile destfile
|
|
|
|
else moveFile srcfile destfile
|
|
|
|
Command.Add.perform destfile
|