unregisterurl: New command

Implemented by generalizing registerurl. Without the implicit batch mode
of registerurl since that is only a backwards compatability thing
(see commit 1d1054faa6).

Command/RegisterUrl.hs

@@ -32,43 +32,43 @@ optParser desc = RegisterUrlOptions
 
 seek :: RegisterUrlOptions -> CommandSeek
 seek o = case (batchOption o, keyUrlPairs o) of
-	(Batch fmt, _) -> commandAction $ startMass fmt
+	(Batch fmt, _) -> commandAction $ startMass setUrlPresent fmt
 	-- older way of enabling batch input, does not support BatchNull
-	(NoBatch, []) -> commandAction $ startMass BatchLine
-	(NoBatch, ps) -> withWords (commandAction . start) ps
+	(NoBatch, []) -> commandAction $ startMass setUrlPresent BatchLine
+	(NoBatch, ps) -> withWords (commandAction . start setUrlPresent) ps
 
-start :: [String] -> CommandStart
-start (keyname:url:[]) = 
+start :: (Key -> URLString -> Annex ()) -> [String] -> CommandStart
+start a (keyname:url:[]) = 
 	starting "registerurl" ai si $
-		perform (keyOpt keyname) url
+		perform a (keyOpt keyname) url
   where
 	ai = ActionItemOther (Just url)
 	si = SeekInput [keyname, url]
-start _ = giveup "specify a key and an url"
+start _ _ = giveup "specify a key and an url"
 
-startMass :: BatchFormat -> CommandStart
-startMass fmt = 
+startMass :: (Key -> URLString -> Annex ()) -> BatchFormat -> CommandStart
+startMass a fmt = 
 	starting "registerurl" (ActionItemOther (Just "stdin")) (SeekInput []) $
-		massAdd fmt
+		performMass a fmt
 
-massAdd :: BatchFormat -> CommandPerform
-massAdd fmt = go True =<< map (separate (== ' ')) <$> batchLines fmt
+performMass :: (Key -> URLString -> Annex ()) -> BatchFormat -> CommandPerform
+performMass a fmt = go True =<< map (separate (== ' ')) <$> batchLines fmt
   where
 	go status [] = next $ return status
 	go status ((keyname,u):rest) | not (null keyname) && not (null u) = do
 		let key = keyOpt keyname
-		ok <- perform' key u
+		ok <- perform' a key u
 		let !status' = status && ok
 		go status' rest
 	go _ _ = giveup "Expected pairs of key and url on stdin, but got something else."
 
-perform :: Key -> URLString -> CommandPerform
-perform key url = do
-	ok <- perform' key url
+perform :: (Key -> URLString -> Annex ()) -> Key -> URLString -> CommandPerform
+perform a key url = do
+	ok <- perform' a key url
 	next $ return ok
 
-perform' :: Key -> URLString -> Annex Bool
-perform' key url = do
+perform' :: (Key -> URLString -> Annex ()) -> Key -> URLString -> Annex Bool
+perform' a key url = do
 	r <- Remote.claimingUrl url
-	setUrlPresent key (setDownloader' url r)
+	a key (setDownloader' url r)
 	return True

Command/UnregisterUrl.hs

@@ -0,0 +1,25 @@
+{- git-annex command
+ -
+ - Copyright 2015-2021 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU AGPL version 3 or higher.
+ -}
+
+{-# LANGUAGE BangPatterns #-}
+
+module Command.UnregisterUrl where
+
+import Command
+import Logs.Web
+import Command.RegisterUrl (start, startMass, optParser, RegisterUrlOptions(..))
+
+cmd :: Command
+cmd = command "unregisterurl"
+	SectionPlumbing "unregisters an url for a key"
+	(paramPair paramKey paramUrl)
+	(seek <$$> optParser)
+
+seek :: RegisterUrlOptions -> CommandSeek
+seek o = case (batchOption o, keyUrlPairs o) of
+	(Batch fmt, _) -> commandAction $ startMass setUrlMissing fmt
+	(NoBatch, ps) -> withWords (commandAction . start setUrlMissing) ps