diff options
Diffstat (limited to 'Command')
-rw-r--r-- | Command/Add.hs | 2 | ||||
-rw-r--r-- | Command/AddUrl.hs | 4 | ||||
-rw-r--r-- | Command/Copy.hs | 6 | ||||
-rw-r--r-- | Command/Direct.hs | 2 | ||||
-rw-r--r-- | Command/Drop.hs | 4 | ||||
-rw-r--r-- | Command/Find.hs | 4 | ||||
-rw-r--r-- | Command/Fix.hs | 4 | ||||
-rw-r--r-- | Command/Fsck.hs | 16 | ||||
-rw-r--r-- | Command/Get.hs | 4 | ||||
-rw-r--r-- | Command/ImportFeed.hs | 2 | ||||
-rw-r--r-- | Command/Indirect.hs | 2 | ||||
-rw-r--r-- | Command/List.hs | 4 | ||||
-rw-r--r-- | Command/Log.hs | 12 | ||||
-rw-r--r-- | Command/MetaData.hs | 4 | ||||
-rw-r--r-- | Command/Migrate.hs | 22 | ||||
-rw-r--r-- | Command/Mirror.hs | 4 | ||||
-rw-r--r-- | Command/Move.hs | 4 | ||||
-rw-r--r-- | Command/ReKey.hs | 2 | ||||
-rw-r--r-- | Command/Reinject.hs | 23 | ||||
-rw-r--r-- | Command/RmUrl.hs | 2 | ||||
-rw-r--r-- | Command/Sync.hs | 4 | ||||
-rw-r--r-- | Command/Unannex.hs | 4 | ||||
-rw-r--r-- | Command/Uninit.hs | 2 | ||||
-rw-r--r-- | Command/Unlock.hs | 4 | ||||
-rw-r--r-- | Command/Unused.hs | 4 | ||||
-rw-r--r-- | Command/Whereis.hs | 4 |
26 files changed, 84 insertions, 65 deletions
diff --git a/Command/Add.hs b/Command/Add.hs index f9e2b3342..46a873151 100644 --- a/Command/Add.hs +++ b/Command/Add.hs @@ -73,7 +73,7 @@ start file = ifAnnexed file addpresent add | otherwise -> do showStart "add" file next $ perform file - addpresent (key, _) = ifM isDirect + addpresent key = ifM isDirect ( ifM (goodContent key file) ( stop , add ) , fixup key ) diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs index b108be507..7ffb86997 100644 --- a/Command/AddUrl.hs +++ b/Command/AddUrl.hs @@ -96,7 +96,7 @@ performQuvi :: Bool -> URLString -> URLString -> FilePath -> CommandPerform performQuvi relaxed pageurl videourl file = ifAnnexed file addurl geturl where quviurl = setDownloader pageurl QuviDownloader - addurl (key, _backend) = next $ cleanup quviurl file key Nothing + addurl key = next $ cleanup quviurl file key Nothing geturl = next $ addUrlFileQuvi relaxed quviurl videourl file #endif @@ -130,7 +130,7 @@ perform :: Bool -> URLString -> FilePath -> CommandPerform perform relaxed url file = ifAnnexed file addurl geturl where geturl = next $ addUrlFile relaxed url file - addurl (key, _backend) + addurl key | relaxed = do setUrlPresent key url next $ return True diff --git a/Command/Copy.hs b/Command/Copy.hs index 29606061d..ae254aae2 100644 --- a/Command/Copy.hs +++ b/Command/Copy.hs @@ -30,9 +30,9 @@ seek ps = do {- 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) +start :: Maybe Remote -> Maybe Remote -> FilePath -> Key -> CommandStart +start to from file key = stopUnless shouldCopy $ + Command.Move.start to from False file key where shouldCopy = checkAuto (check <||> numCopiesCheck file key (<)) check = case to of diff --git a/Command/Direct.hs b/Command/Direct.hs index 47f622a81..9727549b6 100644 --- a/Command/Direct.hs +++ b/Command/Direct.hs @@ -47,7 +47,7 @@ perform = do void $ liftIO clean next cleanup where - go = whenAnnexed $ \f (k, _) -> do + go = whenAnnexed $ \f k -> do r <- toDirectGen k f case r of Nothing -> noop diff --git a/Command/Drop.hs b/Command/Drop.hs index 71f19a828..4bac07a53 100644 --- a/Command/Drop.hs +++ b/Command/Drop.hs @@ -34,8 +34,8 @@ seek ps = do from <- getOptionField dropFromOption Remote.byNameWithUUID withFilesInGit (whenAnnexed $ start from) ps -start :: Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart -start from file (key, _) = checkDropAuto from file key $ \numcopies -> +start :: Maybe Remote -> FilePath -> Key -> CommandStart +start from file key = checkDropAuto from file key $ \numcopies -> stopUnless (checkAuto $ wantDrop False (Remote.uuid <$> from) (Just key) (Just file)) $ case from of Nothing -> startLocal (Just file) numcopies key Nothing diff --git a/Command/Find.hs b/Command/Find.hs index c6a32a944..bcf83729a 100644 --- a/Command/Find.hs +++ b/Command/Find.hs @@ -39,8 +39,8 @@ seek ps = do format <- getFormat withFilesInGit (whenAnnexed $ start format) ps -start :: Maybe Utility.Format.Format -> FilePath -> (Key, Backend) -> CommandStart -start format file (key, _) = do +start :: Maybe Utility.Format.Format -> FilePath -> Key -> CommandStart +start format file key = do -- only files inAnnex are shown, unless the user has requested -- others via a limit whenM (limited <||> inAnnex key) $ diff --git a/Command/Fix.hs b/Command/Fix.hs index f730226e3..0c2bf5942 100644 --- a/Command/Fix.hs +++ b/Command/Fix.hs @@ -26,8 +26,8 @@ seek :: CommandSeek seek = withFilesInGit $ whenAnnexed start {- Fixes the symlink to an annexed file. -} -start :: FilePath -> (Key, Backend) -> CommandStart -start file (key, _) = do +start :: FilePath -> Key -> CommandStart +start file key = do link <- inRepo $ gitAnnexLink file key stopUnless ((/=) (Just link) <$> liftIO (catchMaybeIO $ readSymbolicLink file)) $ do showStart "fix" file diff --git a/Command/Fsck.hs b/Command/Fsck.hs index 88a9915c4..a17662d62 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -104,12 +104,16 @@ getIncremental = do resetStartTime return True -start :: Maybe Remote -> Incremental -> FilePath -> (Key, Backend) -> CommandStart -start from inc file (key, backend) = do - numcopies <- getFileNumCopies file - case from of - Nothing -> go $ perform key file backend numcopies - Just r -> go $ performRemote key file backend numcopies r +start :: Maybe Remote -> Incremental -> FilePath -> Key -> CommandStart +start from inc file key = do + v <- Backend.getBackend file key + case v of + Nothing -> stop + Just backend -> do + numcopies <- getFileNumCopies file + case from of + Nothing -> go $ perform key file backend numcopies + Just r -> go $ performRemote key file backend numcopies r where go = runFsck inc file key diff --git a/Command/Get.hs b/Command/Get.hs index bef466724..d0be20018 100644 --- a/Command/Get.hs +++ b/Command/Get.hs @@ -31,8 +31,8 @@ seek ps = do (withFilesInGit $ whenAnnexed $ start from) ps -start :: Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart -start from file (key, _) = start' expensivecheck from key (Just file) +start :: Maybe Remote -> FilePath -> Key -> CommandStart +start from file key = start' expensivecheck from key (Just file) where expensivecheck = checkAuto (numCopiesCheck file key (<) <||> wantGet False (Just key) (Just file)) diff --git a/Command/ImportFeed.hs b/Command/ImportFeed.hs index 3f629af6e..80e59b739 100644 --- a/Command/ImportFeed.hs +++ b/Command/ImportFeed.hs @@ -194,7 +194,7 @@ performDownload relaxed cache todownload = case location todownload of in d </> show n ++ "_" ++ base tryanother = makeunique url (n + 1) file alreadyexists = liftIO $ isJust <$> catchMaybeIO (getSymbolicLinkStatus f) - checksameurl (k, _) = ifM (elem url <$> getUrls k) + checksameurl k = ifM (elem url <$> getUrls k) ( return Nothing , tryanother ) diff --git a/Command/Indirect.hs b/Command/Indirect.hs index c0dd57959..acf40c974 100644 --- a/Command/Indirect.hs +++ b/Command/Indirect.hs @@ -74,7 +74,7 @@ perform = do case r of Just s | isSymbolicLink s -> void $ flip whenAnnexed f $ - \_ (k, _) -> do + \_ k -> do removeInodeCache k removeAssociatedFiles k return Nothing diff --git a/Command/List.hs b/Command/List.hs index 1fa206405..d038d6deb 100644 --- a/Command/List.hs +++ b/Command/List.hs @@ -60,8 +60,8 @@ getList = ifM (Annex.getFlag $ optionName allrepos) printHeader :: [(UUID, RemoteName, TrustLevel)] -> Annex () printHeader l = liftIO $ putStrLn $ header $ map (\(_, n, t) -> (n, t)) l -start :: [(UUID, RemoteName, TrustLevel)] -> FilePath -> (Key, Backend) -> CommandStart -start l file (key, _) = do +start :: [(UUID, RemoteName, TrustLevel)] -> FilePath -> Key -> CommandStart +start l file key = do ls <- S.fromList <$> keyLocations key liftIO $ putStrLn $ format (map (\(u, _, t) -> (t, S.member u ls)) l) file stop diff --git a/Command/Log.hs b/Command/Log.hs index 84583a93a..b0109f117 100644 --- a/Command/Log.hs +++ b/Command/Log.hs @@ -64,9 +64,15 @@ seek ps = do Annex.getField (optionName o) use o v = [Param ("--" ++ optionName o), Param v] -start :: M.Map UUID String -> TimeZone -> [CommandParam] -> Bool -> - FilePath -> (Key, Backend) -> CommandStart -start m zone os gource file (key, _) = do +start + :: M.Map UUID String + -> TimeZone + -> [CommandParam] + -> Bool + -> FilePath + -> Key + -> CommandStart +start m zone os gource file key = do showLog output =<< readLog <$> getLog key os -- getLog produces a zombie; reap it liftIO reapZombies diff --git a/Command/MetaData.hs b/Command/MetaData.hs index d932315ab..38f9b8522 100644 --- a/Command/MetaData.hs +++ b/Command/MetaData.hs @@ -63,8 +63,8 @@ seek ps = do (withFilesInGit (whenAnnexed $ start now getfield modmeta)) ps -start :: POSIXTime -> Maybe MetaField -> [ModMeta] -> FilePath -> (Key, Backend) -> CommandStart -start now f ms file (k, _) = start' (Just file) now f ms k +start :: POSIXTime -> Maybe MetaField -> [ModMeta] -> FilePath -> Key -> CommandStart +start now f ms file = start' (Just file) now f ms startKeys :: POSIXTime -> Maybe MetaField -> [ModMeta] -> Key -> CommandStart startKeys = start' Nothing diff --git a/Command/Migrate.hs b/Command/Migrate.hs index c14c07bdd..18e6e0748 100644 --- a/Command/Migrate.hs +++ b/Command/Migrate.hs @@ -25,15 +25,19 @@ def = [notDirect $ seek :: CommandSeek seek = withFilesInGit $ whenAnnexed start -start :: FilePath -> (Key, Backend) -> CommandStart -start file (key, oldbackend) = do - exists <- inAnnex key - newbackend <- choosebackend =<< chooseBackend file - if (newbackend /= oldbackend || upgradableKey oldbackend key) && exists - then do - showStart "migrate" file - next $ perform file key oldbackend newbackend - else stop +start :: FilePath -> Key -> CommandStart +start file key = do + v <- Backend.getBackend file key + case v of + Nothing -> stop + Just oldbackend -> do + exists <- inAnnex key + newbackend <- choosebackend =<< chooseBackend file + if (newbackend /= oldbackend || upgradableKey oldbackend key) && exists + then do + showStart "migrate" file + next $ perform file key oldbackend newbackend + else stop where choosebackend Nothing = Prelude.head <$> orderedList choosebackend (Just backend) = return backend diff --git a/Command/Mirror.hs b/Command/Mirror.hs index 4a7a8dd99..4e9a85009 100644 --- a/Command/Mirror.hs +++ b/Command/Mirror.hs @@ -31,8 +31,8 @@ seek ps = do (withFilesInGit $ whenAnnexed $ start to from) ps -start :: Maybe Remote -> Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart -start to from file (key, _backend) = startKey to from (Just file) key +start :: Maybe Remote -> Maybe Remote -> FilePath -> Key -> CommandStart +start to from file key = startKey to from (Just file) key startKey :: Maybe Remote -> Maybe Remote -> Maybe FilePath -> Key -> CommandStart startKey to from afile key = do diff --git a/Command/Move.hs b/Command/Move.hs index 206a875b7..396ea4afc 100644 --- a/Command/Move.hs +++ b/Command/Move.hs @@ -33,8 +33,8 @@ seek ps = do (withFilesInGit $ whenAnnexed $ start to from True) ps -start :: Maybe Remote -> Maybe Remote -> Bool -> FilePath -> (Key, Backend) -> CommandStart -start to from move file (key, _) = start' to from move (Just file) key +start :: Maybe Remote -> Maybe Remote -> Bool -> FilePath -> Key -> CommandStart +start to from move file key = start' to from move (Just file) key startKey :: Maybe Remote -> Maybe Remote -> Bool -> Key -> CommandStart startKey to from move = start' to from move Nothing diff --git a/Command/ReKey.hs b/Command/ReKey.hs index 805300f9f..2919a09e9 100644 --- a/Command/ReKey.hs +++ b/Command/ReKey.hs @@ -29,7 +29,7 @@ start :: (FilePath, String) -> CommandStart start (file, keyname) = ifAnnexed file go stop where newkey = fromMaybe (error "bad key") $ file2key keyname - go (oldkey, _) + go oldkey | oldkey == newkey = stop | otherwise = do showStart "rekey" file diff --git a/Command/Reinject.hs b/Command/Reinject.hs index 1609c6097..a516fe93c 100644 --- a/Command/Reinject.hs +++ b/Command/Reinject.hs @@ -12,6 +12,7 @@ import Command import Logs.Location import Annex.Content import qualified Command.Fsck +import qualified Backend def :: [Command] def = [command "reinject" (paramPair "SRC" "DEST") seek @@ -33,16 +34,20 @@ start (src:dest:[]) next $ whenAnnexed (perform src) dest start _ = error "specify a src file and a dest file" -perform :: FilePath -> FilePath -> (Key, Backend) -> CommandPerform -perform src _dest (key, backend) = +perform :: FilePath -> FilePath -> Key -> CommandPerform +perform src dest key = do {- Check the content before accepting it. -} - ifM (Command.Fsck.checkKeySizeOr reject key src - <&&> Command.Fsck.checkBackendOr reject backend key src) - ( do - unlessM move $ error "mv failed!" - next $ cleanup key - , error "not reinjecting" - ) + v <- Backend.getBackend dest key + case v of + Nothing -> stop + Just backend -> + ifM (Command.Fsck.checkKeySizeOr reject key src + <&&> Command.Fsck.checkBackendOr reject backend key src) + ( do + unlessM move $ error "mv failed!" + next $ cleanup key + , error "not reinjecting" + ) where -- the file might be on a different filesystem, -- so mv is used rather than simply calling diff --git a/Command/RmUrl.hs b/Command/RmUrl.hs index 3f304b76e..e961575a3 100644 --- a/Command/RmUrl.hs +++ b/Command/RmUrl.hs @@ -20,7 +20,7 @@ seek :: CommandSeek seek = withPairs start start :: (FilePath, String) -> CommandStart -start (file, url) = flip whenAnnexed file $ \_ (key, _) -> do +start (file, url) = flip whenAnnexed file $ \_ key -> do showStart "rmurl" file next $ next $ cleanup url key diff --git a/Command/Sync.hs b/Command/Sync.hs index dfcb0d22a..a5d6d46f1 100644 --- a/Command/Sync.hs +++ b/Command/Sync.hs @@ -338,8 +338,8 @@ seekSyncContent rs = do (\v -> void (liftIO (tryPutMVar mvar ())) >> syncFile rs f v) noop -syncFile :: [Remote] -> FilePath -> (Key, Backend) -> Annex () -syncFile rs f (k, _) = do +syncFile :: [Remote] -> FilePath -> Key -> Annex () +syncFile rs f k = do locs <- loggedLocations k let (have, lack) = partition (\r -> Remote.uuid r `elem` locs) rs diff --git a/Command/Unannex.hs b/Command/Unannex.hs index ca9788ddb..daa14ce85 100644 --- a/Command/Unannex.hs +++ b/Command/Unannex.hs @@ -58,8 +58,8 @@ wrapUnannex a = ifM isDirect then void (liftIO cleanup) >> return True else void (liftIO cleanup) >> return False -start :: FilePath -> (Key, Backend) -> CommandStart -start file (key, _) = stopUnless (inAnnex key) $ do +start :: FilePath -> Key -> CommandStart +start file key = stopUnless (inAnnex key) $ do showStart "unannex" file next $ ifM isDirect ( performDirect file key diff --git a/Command/Uninit.hs b/Command/Uninit.hs index dccf4a614..0f0628156 100644 --- a/Command/Uninit.hs +++ b/Command/Uninit.hs @@ -44,7 +44,7 @@ seek ps = do {- git annex symlinks that are not checked into git could be left by an - interrupted add. -} -startCheckIncomplete :: FilePath -> (Key, Backend) -> CommandStart +startCheckIncomplete :: FilePath -> Key -> CommandStart startCheckIncomplete file _ = error $ unlines [ file ++ " points to annexed content, but is not checked into git." , "Perhaps this was left behind by an interrupted git annex add?" diff --git a/Command/Unlock.hs b/Command/Unlock.hs index 4cfe39307..0070410a6 100644 --- a/Command/Unlock.hs +++ b/Command/Unlock.hs @@ -25,8 +25,8 @@ seek = withFilesInGit $ whenAnnexed start {- The unlock subcommand replaces the symlink with a copy of the file's - content. -} -start :: FilePath -> (Key, Backend) -> CommandStart -start file (key, _) = do +start :: FilePath -> Key -> CommandStart +start file key = do showStart "unlock" file next $ perform file key diff --git a/Command/Unused.hs b/Command/Unused.hs index 3e844e5a8..5815bbf29 100644 --- a/Command/Unused.hs +++ b/Command/Unused.hs @@ -250,7 +250,7 @@ withKeysReferenced' mdir initial a = do x <- Backend.lookupFile f case x of Nothing -> go v fs - Just (k, _) -> do + Just k -> do !v' <- a k f v go v' fs @@ -294,7 +294,7 @@ withKeysReferencedInGitRef a ref = do forM_ ts $ tKey lookAtWorkingTree >=> maybe noop a liftIO $ void clean where - tKey True = fmap fst <$$> Backend.lookupFile . getTopFilePath . DiffTree.file + tKey True = Backend.lookupFile . getTopFilePath . DiffTree.file tKey False = fileKey . takeFileName . decodeBS <$$> catFile ref . getTopFilePath . DiffTree.file diff --git a/Command/Whereis.hs b/Command/Whereis.hs index 387ffebc9..d2c27eb9b 100644 --- a/Command/Whereis.hs +++ b/Command/Whereis.hs @@ -27,8 +27,8 @@ seek ps = do (withFilesInGit $ whenAnnexed $ start m) ps -start :: M.Map UUID Remote -> FilePath -> (Key, Backend) -> CommandStart -start remotemap file (key, _) = start' remotemap key (Just file) +start :: M.Map UUID Remote -> FilePath -> Key -> CommandStart +start remotemap file key = start' remotemap key (Just file) startKeys :: M.Map UUID Remote -> Key -> CommandStart startKeys remotemap key = start' remotemap key Nothing |