diff options
| -rw-r--r-- | Command/Import.hs | 39 | ||||
| -rw-r--r-- | GitAnnex.hs | 2 | ||||
| -rw-r--r-- | Seek.hs | 10 | ||||
| -rw-r--r-- | Utility/Directory.hs | 32 | ||||
| -rw-r--r-- | debian/changelog | 2 | ||||
| -rw-r--r-- | doc/git-annex.mdwn | 9 |
6 files changed, 89 insertions, 5 deletions
diff --git a/Command/Import.hs b/Command/Import.hs new file mode 100644 index 000000000..e27a421f2 --- /dev/null +++ b/Command/Import.hs @@ -0,0 +1,39 @@ +{- git-annex command + - + - Copyright 2012 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Command.Import where + +import Common.Annex +import Command +import qualified Annex +import qualified Command.Add + +def :: [Command] +def = [command "import" paramPaths seek "move and add files from outside git working copy"] + +seek :: [CommandSeek] +seek = [withPathContents start] + +start :: (FilePath, FilePath) -> CommandStart +start (srcfile, destfile) = notBareRepo $ + ifM (liftIO $ isRegularFile <$> getSymbolicLinkStatus srcfile) + ( do + showStart "import" destfile + next $ perform srcfile destfile + , stop + ) + +perform :: FilePath -> FilePath -> CommandPerform +perform srcfile destfile = 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 $ moveFile srcfile destfile + Command.Add.perform destfile diff --git a/GitAnnex.hs b/GitAnnex.hs index 9910e33d2..149b37f93 100644 --- a/GitAnnex.hs +++ b/GitAnnex.hs @@ -54,6 +54,7 @@ import qualified Command.Semitrust import qualified Command.Dead import qualified Command.Sync import qualified Command.AddUrl +import qualified Command.Import import qualified Command.Map import qualified Command.Upgrade import qualified Command.Version @@ -69,6 +70,7 @@ cmds = concat , Command.Lock.def , Command.Sync.def , Command.AddUrl.def + , Command.Import.def , Command.Init.def , Command.Describe.def , Command.InitRemote.def @@ -4,7 +4,7 @@ - the values a user passes to a command, and prepare actions operating - on them. - - - Copyright 2010-2011 Joey Hess <joey@kitenet.net> + - Copyright 2010-2012 Joey Hess <joey@kitenet.net> - - Licensed under the GNU GPL version 3 or higher. -} @@ -41,6 +41,14 @@ withFilesNotInGit a params = do g <- gitRepo liftIO $ (\p -> LsFiles.notInRepo force p g) l +withPathContents :: ((FilePath, FilePath) -> CommandStart) -> CommandSeek +withPathContents a params = map a . concat <$> liftIO (mapM get params) + where + get p = ifM (isDirectory <$> getFileStatus p) + ( map (\f -> (f, makeRelative p f)) <$> dirContentsRecursive p + , return [(p, takeFileName p)] + ) + withWords :: ([String] -> CommandStart) -> CommandSeek withWords a params = return [a params] diff --git a/Utility/Directory.hs b/Utility/Directory.hs index 3041361df..5bfd49a9c 100644 --- a/Utility/Directory.hs +++ b/Utility/Directory.hs @@ -17,6 +17,7 @@ import System.FilePath import Control.Applicative import Control.Exception (bracket_) import System.Posix.Directory +import System.IO.Unsafe (unsafeInterleaveIO) import Utility.SafeCommand import Utility.TempFile @@ -24,14 +25,37 @@ import Utility.Exception import Utility.Monad import Utility.Path +dirCruft :: FilePath -> Bool +dirCruft "." = True +dirCruft ".." = True +dirCruft _ = False + {- Lists the contents of a directory. - Unlike getDirectoryContents, paths are not relative to the directory. -} dirContents :: FilePath -> IO [FilePath] -dirContents d = map (d </>) . filter notcruft <$> getDirectoryContents d +dirContents d = map (d </>) . filter (not . dirCruft) <$> getDirectoryContents d + +{- Gets contents of directory, and then its subdirectories, recursively, + - and lazily. -} +dirContentsRecursive :: FilePath -> IO [FilePath] +dirContentsRecursive topdir = dirContentsRecursive' topdir [""] + +dirContentsRecursive' :: FilePath -> [FilePath] -> IO [FilePath] +dirContentsRecursive' _ [] = return [] +dirContentsRecursive' topdir (dir:dirs) = unsafeInterleaveIO $ do + (files, dirs') <- collect [] [] =<< dirContents (topdir </> dir) + files' <- dirContentsRecursive' topdir (dirs' ++ dirs) + return (files ++ files') where - notcruft "." = False - notcruft ".." = False - notcruft _ = True + collect files dirs' [] = return (reverse files, reverse dirs') + collect files dirs' (entry:entries) + | dirCruft entry = collect files dirs' entries + | otherwise = do + let dirEntry = dir </> entry + ifM (doesDirectoryExist $ topdir </> dirEntry) + ( collect files (dirEntry:dirs') entries + , collect (dirEntry:files) dirs' entries + ) {- Moves one filename to another. - First tries a rename, but falls back to moving across devices if needed. -} diff --git a/debian/changelog b/debian/changelog index 6b57a5580..a110e94ce 100644 --- a/debian/changelog +++ b/debian/changelog @@ -2,6 +2,8 @@ git-annex (3.20120523) UNRELEASED; urgency=low * sync: Show a nicer message if a user tries to sync to a special remote. * lock: Reset unlocked file to index, rather than to branch head. + * import: New subcommand, pulls files from a directory outside the annex + and adds them. -- Joey Hess <joeyh@debian.org> Sun, 27 May 2012 20:55:29 -0400 diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index 5d41f86e9..c7de59cd2 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -160,6 +160,15 @@ subdirectories). alternate locations from which the file can be downloaded. In this mode, addurl can be used both to add new files, or to add urls to existing files. +* import [path ...] + + Moves files from somewhere outside the git working copy, and adds them to + the annex. Individual files to import can be specified. + If a directory is specified, all files in it are imported, and any + subdirectory structure inside it is preserved. + + git annex import /media/camera/DCIM/ + # REPOSITORY SETUP COMMANDS * init [description] |