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.

6 files changed, 32 insertions, 22 deletions

diff --git a/CmdLine/GitAnnex/Options.hs b/CmdLine/GitAnnex/Options.hs
index 726a6963c..aad0536d8 100644
--- a/CmdLine/GitAnnex/Options.hs
+++ b/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 p = DeferredParse 
+parseRemoteOption :: RemoteName -> DeferredParse Remote
+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) 
-	<|> (ToRemote <$> parseToOption)
+	(FromRemote . parseRemoteOption <$> parseFromOption) 
+	<|> (ToRemote . parseRemoteOption <$> parseToOption)
 
-parseFromOption :: Parser (DeferredParse Remote)
-parseFromOption = parseRemoteOption $ strOption
+parseFromOption :: Parser RemoteName
+parseFromOption = strOption
 	( long "from" <> short 'f' <> metavar paramRemote
 	<> help "source remote"
 	<> completeRemotes
 	)
 
-parseToOption :: Parser (DeferredParse Remote)
-parseToOption = parseRemoteOption $ strOption
+parseToOption :: Parser RemoteName
+parseToOption = strOption
 	( long "to" <> short 't' <> metavar paramRemote
 	<> help "destination remote"
 	<> completeRemotes
diff --git a/Command/Copy.hs b/Command/Copy.hs
index 9b41b17d7..1f35d9ce8 100644
--- a/Command/Copy.hs
+++ b/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))
diff --git a/Command/Drop.hs b/Command/Drop.hs
index 52b89b82c..7603a4f54 100644
--- a/Command/Drop.hs
+++ b/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
diff --git a/Command/Fsck.hs b/Command/Fsck.hs
index 8ebc433d1..3dfb45e55 100644
--- a/Command/Fsck.hs
+++ b/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
diff --git a/Command/Get.hs b/Command/Get.hs
index fc6ff7374..3a4a4606a 100644
--- a/Command/Get.hs
+++ b/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
diff --git a/Command/Move.hs b/Command/Move.hs
index ca4febe76..787afd929 100644
--- a/Command/Move.hs
+++ b/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 $
-			fromStart move afile key ai =<< getParsed src
-		ToRemote dest -> checkFailedTransferDirection ai Upload $
-			toStart move afile key ai =<< getParsed dest
+		Right (FromRemote src) ->
+			checkFailedTransferDirection ai Download $
+				fromStart move afile key ai =<< getParsed src
+		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")