{- git-annex command - - Copyright 2010-2017 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} module Command.Add where import Command import Annex.Ingest import Logs.Location import Annex.Content import Annex.Content.Direct import qualified Annex import qualified Annex.Queue import qualified Database.Keys import Config import Annex.FileMatcher import Annex.Link import Annex.Version import Git.FilePath cmd :: Command cmd = notBareRepo $ withGlobalOptions [jobsOption, jsonOptions, fileMatchingOptions] $ command "add" SectionCommon "add files to annex" paramPaths (seek <$$> optParser) data AddOptions = AddOptions { addThese :: CmdParams , includeDotFiles :: Bool , batchOption :: BatchMode , updateOnly :: Bool } optParser :: CmdParamsDesc -> Parser AddOptions optParser desc = AddOptions <$> cmdParams desc <*> switch ( long "include-dotfiles" <> help "don't skip dotfiles" ) <*> parseBatchOption <*> switch ( long "update" <> short 'u' <> help "only update tracked files" ) seek :: AddOptions -> CommandSeek seek o = allowConcurrentOutput $ do matcher <- largeFilesMatcher let gofile file = ifM (checkFileMatcher matcher file <||> Annex.getState Annex.force) ( start file , ifM (annexAddSmallFiles <$> Annex.getGitConfig) ( startSmall file , stop ) ) case batchOption o of Batch fmt | updateOnly o -> giveup "--update --batch is not supported" | otherwise -> batchFilesMatching fmt gofile NoBatch -> do l <- workTreeItems (addThese o) let go a = a (commandAction . gofile) l unless (updateOnly o) $ go (withFilesNotInGit (not $ includeDotFiles o)) go withFilesMaybeModified ifM versionSupportsUnlockedPointers ( go withUnmodifiedUnlockedPointers , unlessM isDirect $ go withFilesOldUnlocked ) {- Pass file off to git-add. -} startSmall :: FilePath -> CommandStart startSmall file = do showStart "add" file next $ next $ addSmall file addSmall :: FilePath -> Annex Bool addSmall file = do showNote "non-large file; adding content to git repository" addFile file addFile :: FilePath -> Annex Bool addFile file = do ps <- forceParams Annex.Queue.addCommand "add" (ps++[Param "--"]) [file] return True start :: FilePath -> CommandStart start file = do ifM versionSupportsUnlockedPointers ( do mk <- liftIO $ isPointerFile file maybe go fixuppointer mk , go ) where go = ifAnnexed file addpresent add add = liftIO (catchMaybeIO $ getSymbolicLinkStatus file) >>= \case Nothing -> stop Just s | not (isRegularFile s) && not (isSymbolicLink s) -> stop | otherwise -> do showStart "add" file next $ if isSymbolicLink s then next $ addFile file else perform file addpresent key = ifM versionSupportsUnlockedPointers ( liftIO (catchMaybeIO $ getSymbolicLinkStatus file) >>= \case Just s | isSymbolicLink s -> fixuplink key _ -> add , ifM isDirect ( liftIO (catchMaybeIO $ getSymbolicLinkStatus file) >>= \case Just s | isSymbolicLink s -> fixuplink key _ -> ifM (goodContent key file) ( stop , add ) , fixuplink key ) ) fixuplink key = do -- the annexed symlink is present but not yet added to git showStart "add" file liftIO $ removeFile file addLink file key Nothing next $ next $ cleanup key =<< inAnnex key fixuppointer key = do -- the pointer file is present, but not yet added to git showStart "add" file Database.Keys.addAssociatedFile key =<< inRepo (toTopFilePath file) next $ next $ addFile file perform :: FilePath -> CommandPerform perform file = do lockingfile <- not <$> addUnlocked let cfg = LockDownConfig { lockingFile = lockingfile , hardlinkFileTmp = True } lockDown cfg file >>= ingestAdd >>= finish where finish (Just key) = next $ cleanup key True finish Nothing = stop cleanup :: Key -> Bool -> CommandCleanup cleanup key hascontent = do maybeShowJSON $ JSONChunk [("key", key2file key)] when hascontent $ logStatus key InfoPresent return True