git-annex/Command/RmUrl.hs

69 lines
2 KiB
Haskell
Raw Normal View History

{- git-annex command
-
- Copyright 2013-2021 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
module Command.RmUrl where
import Command
import Logs.Web
import Annex.WorkTree
cmd :: Command
cmd = notBareRepo $
command "rmurl" SectionCommon
"record file is not available at url"
(paramRepeating (paramPair paramFile paramUrl))
(seek <$$> optParser)
data RmUrlOptions = RmUrlOptions
{ rmThese :: CmdParams
, batchOption :: BatchMode
}
optParser :: CmdParamsDesc -> Parser RmUrlOptions
optParser desc = RmUrlOptions
<$> cmdParams desc
<*> parseBatchOption False
seek :: RmUrlOptions -> CommandSeek
seek o = case batchOption o of
Batch fmt -> batchOnly Nothing (rmThese o) $
batchInput fmt batchParser (batchCommandAction . start)
NoBatch -> withPairs (commandAction . start) (rmThese o)
-- Split on the last space, since a FilePath can contain whitespace,
-- but a url should not.
batchParser :: String -> Annex (Either String (FilePath, URLString))
batchParser s = case separate (== ' ') (reverse s) of
(ru, rf)
| null ru || null rf -> return $ Left "Expected: \"file url\""
| otherwise -> do
let f = reverse rf
f' <- liftIO $ fromRawFilePath
<$> relPathCwdToFile (toRawFilePath f)
return $ Right (f', reverse ru)
start :: (SeekInput, (FilePath, URLString)) -> CommandStart
use lookupKeyStaged in --batch code paths Make --batch mode handle unstaged annexed files consistently whether the file is unlocked or not. Before this, a unstaged locked file would have the symlink on disk examined and operated on in --batch mode, while an unstaged unlocked file would be skipped. Note that, when not in batch mode, unstaged files are skipped over too. That is actually somewhat new behavior; as late as 7.20191114 a command like `git-annex whereis .` would operate on unstaged locked files and skip over unstaged unlocked files. That changed during optimisation of CmdLine.Seek with apparently little fanfare or notice. Turns out that rmurl still behaved that way when given an unstaged file on the command line. It was changed to use lookupKeyStaged to handle its --batch mode. That also affected its non-batch mode, but since that's just catching up to the change earlier made to most other commands, I have not mentioed that in the changelog. It may be that other uses of lookupKey should also change to lookupKeyStaged. But it may also be that would slow down some things, or lead to unwanted behavior changes, so I've kept the changes minimal for now. An example of a place where the use of lookupKey is better than lookupKeyStaged is in Command.AddUrl, where it looks to see if the file already exists, and adds the url to the file when so. It does not matter there whether the file is staged or not (when it's locked). The use of lookupKey in Command.Unused likewise seems good (and faster). Sponsored-by: Nicholas Golder-Manning on Patreon
2022-10-26 18:23:06 +00:00
start (si, (file, url)) = lookupKeyStaged file' >>= \case
Nothing -> stop
Just key -> do
let ai = mkActionItem (key, AssociatedFile (Just file'))
starting "rmurl" ai si $
next $ cleanup url key
where
file' = toRawFilePath file
cleanup :: String -> Key -> CommandCleanup
cleanup url key = do
-- Remove the url, no matter what downloader.
forM_ [minBound..maxBound] $ \dl ->
setUrlMissing key (setDownloader url dl)
return True
-- Unlike addurl, this does not update location tracking
-- for remotes other than the web special remote. Doing so with
-- a remote that git-annex can drop content from would rather
-- unexpectedly leave content stranded on that remote.