diff --git a/CmdLine/GitAnnex/Options.hs b/CmdLine/GitAnnex/Options.hs index 143bb64982..34b11bae46 100644 --- a/CmdLine/GitAnnex/Options.hs +++ b/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 diff --git a/Command/Move.hs b/Command/Move.hs index f523a74e3c..844d9ad013 100644 --- a/Command/Move.hs +++ b/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)