refactor FromToHereOptions

CmdLine/GitAnnex/Options.hs

@@ -5,6 +5,8 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
+
 module CmdLine.GitAnnex.Options where
 
 import Options.Applicative
@@ -113,6 +115,7 @@ parseRemoteOption = DeferredParse
 	. (fromJust <$$> Remote.byNameWithUUID)
 	. Just
 
+-- | From or To a remote.
 data FromToOptions
 	= FromRemote (DeferredParse Remote)
 	| ToRemote (DeferredParse Remote)
@@ -140,6 +143,24 @@ parseToOption = strOption
 	<> completeRemotes
 	)
 
+-- | Like FromToOptions, but with a special --to=here
+type FromToHereOptions = Either ToHere FromToOptions
+
+data ToHere = ToHere
+
+parseFromToHereOptions :: Parser FromToHereOptions
+parseFromToHereOptions = parsefrom <|> parseto
+  where
+	parsefrom = Right . FromRemote . parseRemoteOption <$> parseFromOption
+	parseto = herespecialcase <$> parseToOption
+	  where
+		herespecialcase "here" = Left ToHere
+		herespecialcase "." = Left ToHere
+		herespecialcase n = Right $ ToRemote $ parseRemoteOption n
+
+instance DeferredParseClass FromToHereOptions where
+	finishParse = either (pure . Left) (Right <$$> finishParse)
+
 -- Options for acting on keys, rather than work tree files.
 data KeyOptions
 	= WantAllKeys

Command/Move.hs

@@ -27,31 +27,22 @@ cmd = withGlobalOptions [jobsOption, jsonOptions, jsonProgressOption, annexedMat
 
 data MoveOptions = MoveOptions
 	{ moveFiles :: CmdParams
-	, fromToOptions :: Either ToHere FromToOptions
+	, fromToOptions :: FromToHereOptions
 	, keyOptions :: Maybe KeyOptions
 	, batchOption :: BatchMode
 	}
 
-data ToHere = ToHere
-
 optParser :: CmdParamsDesc -> Parser MoveOptions
 optParser desc = MoveOptions
 	<$> cmdParams desc
-	<*> (parsefrom <|> parseto)
+	<*> parseFromToHereOptions
 	<*> optional (parseKeyOptions <|> parseFailedTransfersOption)
 	<*> parseBatchOption
-  where
-	parsefrom = Right . FromRemote . parseRemoteOption <$> parseFromOption
-	parseto = herespecialcase <$> parseToOption
-	  where
-		herespecialcase "here" = Left ToHere
-		herespecialcase "." = Left ToHere
-		herespecialcase n = Right $ ToRemote $ parseRemoteOption n
 
 instance DeferredParseClass MoveOptions where
 	finishParse v = MoveOptions
 		<$> pure (moveFiles v)
-		<*> either (pure . Left) (Right <$$> finishParse) (fromToOptions v)
+		<*> finishParse (fromToOptions v)
 		<*> pure (keyOptions v)
 		<*> pure (batchOption v)