diff options
Diffstat (limited to 'Command')
-rw-r--r-- | Command/DropKey.hs | 39 | ||||
-rw-r--r-- | Command/Fix.hs | 12 | ||||
-rw-r--r-- | Command/Sync.hs | 3 | ||||
-rw-r--r-- | Command/Unannex.hs | 1 | ||||
-rw-r--r-- | Command/Unlock.hs | 1 |
5 files changed, 34 insertions, 22 deletions
diff --git a/Command/DropKey.hs b/Command/DropKey.hs index 60d7d5fc7..15d5403a8 100644 --- a/Command/DropKey.hs +++ b/Command/DropKey.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2010 Joey Hess <id@joeyh.name> + - Copyright 2010,2016 Joey Hess <id@joeyh.name> - - Licensed under the GNU GPL version 3 or higher. -} @@ -13,26 +13,45 @@ import Logs.Location import Annex.Content cmd :: Command -cmd = noCommit $ +cmd = noCommit $ withGlobalOptions [jsonOption] $ command "dropkey" SectionPlumbing "drops annexed content for specified keys" (paramRepeating paramKey) - (withParams seek) + (seek <$$> optParser) -seek :: CmdParams -> CommandSeek -seek = withKeys start +data DropKeyOptions = DropKeyOptions + { toDrop :: [String] + , batchOption :: BatchMode + } -start :: Key -> CommandStart -start key = stopUnless (inAnnex key) $ do +optParser :: CmdParamsDesc -> Parser DropKeyOptions +optParser desc = DropKeyOptions + <$> cmdParams desc + <*> parseBatchOption + +seek :: DropKeyOptions -> CommandSeek +seek o = do unlessM (Annex.getState Annex.force) $ error "dropkey can cause data loss; use --force if you're sure you want to do this" + withKeys start (toDrop o) + case batchOption o of + Batch -> batchInput parsekey $ batchCommandAction . start + NoBatch -> noop + where + parsekey = maybe (Left "bad key") Right . file2key + +start :: Key -> CommandStart +start key = do showStart' "dropkey" key Nothing next $ perform key perform :: Key -> CommandPerform -perform key = lockContentForRemoval key $ \contentlock -> do - removeAnnex contentlock - next $ cleanup key +perform key = ifM (inAnnex key) + ( lockContentForRemoval key $ \contentlock -> do + removeAnnex contentlock + next $ cleanup key + , next $ return True + ) cleanup :: Key -> CommandCleanup cleanup key = do diff --git a/Command/Fix.hs b/Command/Fix.hs index 5565a6837..d87bea358 100644 --- a/Command/Fix.hs +++ b/Command/Fix.hs @@ -18,11 +18,7 @@ import Annex.Content import Annex.Perms import qualified Annex.Queue import qualified Database.Keys -#ifdef WITH_CLIBS -#ifndef __ANDROID__ import Utility.Touch -#endif -#endif cmd :: Command cmd = notDirect $ noCommit $ withGlobalOptions annexedMatchingOptions $ @@ -90,21 +86,17 @@ makeHardLink file key = do fixSymlink :: FilePath -> FilePath -> CommandPerform fixSymlink file link = do liftIO $ do -#ifdef WITH_CLIBS -#ifndef __ANDROID__ +#if ! defined(mingw32_HOST_OS) && ! defined(__ANDROID__) -- preserve mtime of symlink mtime <- catchMaybeIO $ TimeSpec . modificationTime <$> getSymbolicLinkStatus file #endif -#endif createDirectoryIfMissing True (parentDir file) removeFile file createSymbolicLink link file -#ifdef WITH_CLIBS -#ifndef __ANDROID__ +#if ! defined(mingw32_HOST_OS) && ! defined(__ANDROID__) maybe noop (\t -> touch file t False) mtime #endif -#endif next $ cleanupSymlink file cleanupSymlink :: FilePath -> CommandCleanup diff --git a/Command/Sync.hs b/Command/Sync.hs index e6a8373ce..4753a8fdc 100644 --- a/Command/Sync.hs +++ b/Command/Sync.hs @@ -522,6 +522,5 @@ syncFile ebloom rs af k = do ) , return [] ) - put dest = includeCommandAction $ do - showStart' "copy" k af + put dest = includeCommandAction $ Command.Move.toStart' dest False af k diff --git a/Command/Unannex.hs b/Command/Unannex.hs index 9e6044109..f01d2b219 100644 --- a/Command/Unannex.hs +++ b/Command/Unannex.hs @@ -13,6 +13,7 @@ import Command import Config import qualified Annex import Annex.Content +import Annex.Perms import Annex.Content.Direct import Annex.Version import qualified Git.Command diff --git a/Command/Unlock.hs b/Command/Unlock.hs index ded44fd2f..ac99d5cd3 100644 --- a/Command/Unlock.hs +++ b/Command/Unlock.hs @@ -9,6 +9,7 @@ module Command.Unlock where import Command import Annex.Content +import Annex.Perms import Annex.CatFile import Annex.Version import Annex.Link |