summaryrefslogtreecommitdiff
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
parentc882b3e9c5dd6dbb28818e6ebfbe8b41b88c9cd3 (diff)
converted Mirror
-rw-r--r--CmdLine/GitAnnex.hs4
-rw-r--r--Command/Mirror.hs61
2 files changed, 36 insertions, 29 deletions
diff --git a/CmdLine/GitAnnex.hs b/CmdLine/GitAnnex.hs
index 6677f3b29..dd159385a 100644
--- a/CmdLine/GitAnnex.hs
+++ b/CmdLine/GitAnnex.hs
@@ -81,7 +81,7 @@ import qualified Command.Schedule
import qualified Command.Ungroup
import qualified Command.Vicfg
import qualified Command.Sync
---import qualified Command.Mirror
+import qualified Command.Mirror
--import qualified Command.AddUrl
#ifdef WITH_FEED
--import qualified Command.ImportFeed
@@ -130,7 +130,7 @@ cmds =
, Command.Unlock.editcmd
, Command.Lock.cmd
, Command.Sync.cmd
--- , Command.Mirror.cmd
+ , Command.Mirror.cmd
-- , Command.AddUrl.cmd
#ifdef WITH_FEED
-- , Command.ImportFeed.cmd
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