summaryrefslogtreecommitdiff
path: root/Command/Mirror.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2015-07-10 21:05:34 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2015-07-10 21:05:34 -0400
commit45acd1f959b4c7e7381ac1f03b30f937330cfa88 (patch)
tree1ccec6773f1953c717306f361fb0a9ee561a8ac5 /Command/Mirror.hs
parentc882b3e9c5dd6dbb28818e6ebfbe8b41b88c9cd3 (diff)
converted Mirror
Diffstat (limited to 'Command/Mirror.hs')
-rw-r--r--Command/Mirror.hs61
1 files changed, 34 insertions, 27 deletions
diff --git a/Command/Mirror.hs b/Command/Mirror.hs
index f0880e87e..0555d025c 100644
--- a/Command/Mirror.hs
+++ b/Command/Mirror.hs
@@ -17,42 +17,48 @@ import Annex.Content
import Annex.NumCopies
cmd :: Command
-cmd = withOptions mirrorOptions $
+cmd = withGlobalOptions ([jobsOption] ++ annexedMatchingOptions) $
command "mirror" SectionCommon
"mirror content of files to/from another repository"
- paramPaths (withParams seek)
+ paramPaths (seek <--< optParser)
-mirrorOptions :: [Option]
-mirrorOptions = fromToOptions ++ [jobsOption] ++ annexedMatchingOptions ++ keyOptions
+data MirrorOptions = MirrorOptions
+ { mirrorFiles :: CmdParams
+ , fromToOptions :: FromToOptions
+ , keyOptions :: Maybe KeyOptions
+ }
-seek :: CmdParams -> CommandSeek
-seek ps = do
- to <- getOptionField toOption Remote.byNameWithUUID
- from <- getOptionField fromOption Remote.byNameWithUUID
- withKeyOptions False
- (startKey to from Nothing)
- (withFilesInGit $ whenAnnexed $ start to from)
- ps
+optParser :: CmdParamsDesc -> Parser MirrorOptions
+optParser desc = MirrorOptions
+ <$> cmdParams desc
+ <*> parseFromToOptions
+ <*> optional (parseKeyOptions False)
-start :: Maybe Remote -> Maybe Remote -> FilePath -> Key -> CommandStart
-start to from file = startKey to from (Just file)
+instance DeferredParseClass MirrorOptions where
+ finishParse v = MirrorOptions
+ <$> pure (mirrorFiles v)
+ <*> finishParse (fromToOptions v)
+ <*> pure (keyOptions v)
-startKey :: Maybe Remote -> Maybe Remote -> Maybe FilePath -> Key -> CommandStart
-startKey to from afile key =
- case (from, to) of
- (Nothing, Nothing) -> error "specify either --from or --to"
- (Nothing, Just r) -> mirrorto r
- (Just r, Nothing) -> mirrorfrom r
- _ -> error "only one of --from or --to can be specified"
- where
- mirrorto r = ifM (inAnnex key)
- ( Command.Move.toStart r False afile key
+seek :: MirrorOptions -> CommandSeek
+seek o = withKeyOptions (keyOptions o) False
+ (startKey o Nothing)
+ (withFilesInGit $ whenAnnexed $ start o)
+ (mirrorFiles o)
+
+start :: MirrorOptions -> FilePath -> Key -> CommandStart
+start o file = startKey o (Just file)
+
+startKey :: MirrorOptions -> Maybe FilePath -> Key -> CommandStart
+startKey o afile key = case fromToOptions o of
+ ToRemote r -> ifM (inAnnex key)
+ ( Command.Move.toStart False afile key =<< getParsed r
, do
numcopies <- getnumcopies
- Command.Drop.startRemote afile numcopies key r
+ Command.Drop.startRemote afile numcopies key =<< getParsed r
)
- mirrorfrom r = do
- haskey <- Remote.hasKey r key
+ FromRemote r -> do
+ haskey <- flip Remote.hasKey key =<< getParsed r
case haskey of
Left _ -> stop
Right True -> Command.Get.start' (return True) Nothing key afile
@@ -62,4 +68,5 @@ startKey to from afile key =
Command.Drop.startLocal afile numcopies key Nothing
, stop
)
+ where
getnumcopies = maybe getNumCopies getFileNumCopies afile