converted copy and move

Got a little tricky..

1 files changed, 45 insertions, 34 deletions

diff --git a/Command/Move.hs b/Command/Move.hs
index fc13ca254..153114f8b 100644
--- a/Command/Move.hs
+++ b/Command/Move.hs
@@ -18,36 +18,47 @@ import Annex.Transfer
 import Logs.Presence
 
 cmd :: Command
-cmd = withOptions moveOptions $ 
-	command "move" SectionCommon
-		"move content of files to/from another repository"
-		paramPaths (withParams seek)
-
-moveOptions :: [Option]
-moveOptions = fromToOptions ++ [jobsOption] ++ keyOptions ++ annexedMatchingOptions
-
-seek :: CmdParams -> CommandSeek
-seek ps = do
-	to <- getOptionField toOption Remote.byNameWithUUID
-	from <- getOptionField fromOption Remote.byNameWithUUID
-	withKeyOptions False
-		(startKey to from True)
-		(withFilesInGit $ whenAnnexed $ start to from True)
-		ps
-
-start :: Maybe Remote -> Maybe Remote -> Bool -> FilePath -> Key -> CommandStart
-start to from move = start' to from move . Just
-
-startKey :: Maybe Remote -> Maybe Remote -> Bool -> Key -> CommandStart
-startKey to from move = start' to from move Nothing
-
-start' :: Maybe Remote -> Maybe Remote -> Bool -> AssociatedFile -> Key -> CommandStart
-start' to from move afile key = do
-	case (from, to) of
-		(Nothing, Nothing) -> error "specify either --from or --to"
-		(Nothing, Just dest) -> toStart dest move afile key
-		(Just src, Nothing) -> fromStart src move afile key
-		_ -> error "only one of --from or --to can be specified"
+cmd = command "move" SectionCommon
+	"move content of files to/from another repository"
+	paramPaths ((seek <=< finishParse) <$$> optParser)
+
+data MoveOptions = MoveOptions
+	{ moveFiles :: CmdParams
+	, fromToOptions :: FromToOptions
+	, keyOptions :: Maybe KeyOptions
+	}
+
+-- TODO: jobsOption, annexedMatchingOptions
+
+optParser :: CmdParamsDesc -> Parser MoveOptions
+optParser desc = MoveOptions
+	<$> cmdParams desc
+	<*> parseFromToOptions
+	<*> optional (parseKeyOptions False)
+
+instance DeferredParseClass MoveOptions where
+	finishParse v = MoveOptions
+		<$> pure (moveFiles v)
+		<*> finishParse (fromToOptions v)
+		<*> pure (keyOptions v)
+
+seek :: MoveOptions -> CommandSeek
+seek o = withKeyOptions (keyOptions o) False
+	(startKey o True)
+	(withFilesInGit $ whenAnnexed $ start o True)
+	(moveFiles o)
+
+start :: MoveOptions -> Bool -> FilePath -> Key -> CommandStart
+start o move = start' o move . Just
+
+startKey :: MoveOptions -> Bool -> Key -> CommandStart
+startKey o move = start' o move Nothing
+
+start' :: MoveOptions -> Bool -> AssociatedFile -> Key -> CommandStart
+start' o move afile key = 
+	case fromToOptions o of
+		FromRemote src -> fromStart move afile key =<< getParsed src
+		ToRemote dest -> toStart move afile key =<< getParsed dest
 
 showMoveAction :: Bool -> Key -> AssociatedFile -> Annex ()
 showMoveAction move = showStart' (if move then "move" else "copy")
@@ -61,8 +72,8 @@ showMoveAction move = showStart' (if move then "move" else "copy")
  - A file's content can be moved even if there are insufficient copies to
  - allow it to be dropped.
  -}
-toStart :: Remote -> Bool -> AssociatedFile -> Key -> CommandStart
-toStart dest move afile key = do
+toStart :: Bool -> AssociatedFile -> Key -> Remote -> CommandStart
+toStart move afile key dest = do
 	u <- getUUID
 	ishere <- inAnnex key
 	if not ishere || u == Remote.uuid dest
@@ -124,8 +135,8 @@ toPerform dest move key afile fastcheck isthere =
  - If the current repository already has the content, it is still removed
  - from the remote.
  -}
-fromStart :: Remote -> Bool -> AssociatedFile -> Key -> CommandStart
-fromStart src move afile key
+fromStart :: Bool -> AssociatedFile -> Key -> Remote -> CommandStart
+fromStart move afile key src
 	| move = go
 	| otherwise = stopUnless (not <$> inAnnex key) go
   where