support parsing options like --to=here

Reworked remote name parsing to allow things like that. Command.Move
uses it for --to=here, although there's not yet an implementation of
that option.

This commit was sponsored by Ignacio on Patreon.

CmdLine/GitAnnex/Options.hs

@@ -1,6 +1,6 @@
 {- git-annex command-line option parsing
  -
- - Copyright 2010-2015 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2017 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -105,10 +105,10 @@ parseAutoOption = switch
 	<> help "automatic mode"
 	)
 
-parseRemoteOption :: Parser RemoteName -> Parser (DeferredParse Remote)
+parseRemoteOption :: RemoteName -> DeferredParse Remote
-parseRemoteOption p = DeferredParse 
+parseRemoteOption = DeferredParse 
 	. (fromJust <$$> Remote.byNameWithUUID)
-	. Just <$> p
+	. Just
 
 data FromToOptions
 	= FromRemote (DeferredParse Remote)
@@ -120,18 +120,18 @@ instance DeferredParseClass FromToOptions where
 
 parseFromToOptions :: Parser FromToOptions
 parseFromToOptions = 
-	(FromRemote <$> parseFromOption) 
+	(FromRemote . parseRemoteOption <$> parseFromOption) 
-	<|> (ToRemote <$> parseToOption)
+	<|> (ToRemote . parseRemoteOption <$> parseToOption)
 
-parseFromOption :: Parser (DeferredParse Remote)
+parseFromOption :: Parser RemoteName
-parseFromOption = parseRemoteOption $ strOption
+parseFromOption = strOption
 	( long "from" <> short 'f' <> metavar paramRemote
 	<> help "source remote"
 	<> completeRemotes
 	)
 
-parseToOption :: Parser (DeferredParse Remote)
+parseToOption :: Parser RemoteName
-parseToOption = parseRemoteOption $ strOption
+parseToOption = strOption
 	( long "to" <> short 't' <> metavar paramRemote
 	<> help "destination remote"
 	<> completeRemotes

Command/Copy.hs

@@ -52,7 +52,7 @@ start o file key = stopUnless shouldCopy $
 		| autoMode o = want <||> numCopiesCheck file key (<)
 		| otherwise = return True
 	want = case Command.Move.fromToOptions (moveOptions o) of
-		ToRemote dest -> (Remote.uuid <$> getParsed dest) >>=
+		Right (ToRemote dest) -> (Remote.uuid <$> getParsed dest) >>=
 			wantSend False (Just key) (AssociatedFile (Just file))
-		FromRemote _ ->
+		Right (FromRemote _) ->
 			wantGet False (Just key) (AssociatedFile (Just file))

Command/Drop.hs

@@ -45,7 +45,7 @@ optParser desc = DropOptions
 	<*> parseBatchOption
 
 parseDropFromOption :: Parser (DeferredParse Remote)
-parseDropFromOption = parseRemoteOption $ strOption
+parseDropFromOption = parseRemoteOption <$> strOption
 	( long "from" <> short 'f' <> metavar paramRemote
 	<> help "drop content from a remote"
 	<> completeRemotes

Command/Fsck.hs

@@ -62,7 +62,7 @@ data IncrementalOpt
 optParser :: CmdParamsDesc -> Parser FsckOptions
 optParser desc = FsckOptions
 	<$> cmdParams desc
-	<*> optional (parseRemoteOption $ strOption 
+	<*> optional (parseRemoteOption <$> strOption 
 		( long "from" <> short 'f' <> metavar paramRemote 
 		<> help "check remote"
 		<> completeRemotes

Command/Get.hs

@@ -32,7 +32,7 @@ data GetOptions = GetOptions
 optParser :: CmdParamsDesc -> Parser GetOptions
 optParser desc = GetOptions
 	<$> cmdParams desc
-	<*> optional parseFromOption
+	<*> optional (parseRemoteOption <$> parseFromOption)
 	<*> parseAutoOption
 	<*> optional (parseIncompleteOption <|> parseKeyOptions <|> parseFailedTransfersOption)
 	<*> parseBatchOption

Command/Move.hs

@@ -27,20 +27,28 @@ cmd = withGlobalOptions (jobsOption : jsonOption : jsonProgressOption : annexedM
 
 data MoveOptions = MoveOptions
 	{ moveFiles :: CmdParams
-	, fromToOptions :: FromToOptions
+	, fromToOptions :: Either ToHere FromToOptions
 	, keyOptions :: Maybe KeyOptions
 	}
 
+data ToHere = ToHere
+
 optParser :: CmdParamsDesc -> Parser MoveOptions
 optParser desc = MoveOptions
 	<$> cmdParams desc
-	<*> parseFromToOptions
+	<*> (parsefrom <|> parseto)
 	<*> optional (parseKeyOptions <|> parseFailedTransfersOption)
+  where
+	parsefrom = Right . FromRemote . parseRemoteOption <$> parseFromOption
+	parseto = herespecialcase <$> parseToOption
+	  where
+		herespecialcase "here" = Left ToHere
+		herespecialcase n = Right $ ToRemote $ parseRemoteOption n
 
 instance DeferredParseClass MoveOptions where
 	finishParse v = MoveOptions
 		<$> pure (moveFiles v)
-		<*> finishParse (fromToOptions v)
+		<*> either (pure . Left) (Right <$$> finishParse) (fromToOptions v)
 		<*> pure (keyOptions v)
 
 seek :: MoveOptions -> CommandSeek
@@ -61,10 +69,12 @@ startKey o move = start' o move (AssociatedFile Nothing)
 start' :: MoveOptions -> Bool -> AssociatedFile -> Key -> ActionItem -> CommandStart
 start' o move afile key ai = 
 	case fromToOptions o of
-		FromRemote src -> checkFailedTransferDirection ai Download $
+		Right (FromRemote src) ->
-			fromStart move afile key ai =<< getParsed src
+			checkFailedTransferDirection ai Download $
-		ToRemote dest -> checkFailedTransferDirection ai Upload $
+				fromStart move afile key ai =<< getParsed src
-			toStart move afile key ai =<< getParsed dest
+		Right (ToRemote dest) ->
+			checkFailedTransferDirection ai Upload $
+				toStart move afile key ai =<< getParsed dest
 
 showMoveAction :: Bool -> Key -> ActionItem -> Annex ()
 showMoveAction move = showStart' (if move then "move" else "copy")