diff options
| -rw-r--r-- | CmdLine/GitAnnex.hs | 4 | ||||
| -rw-r--r-- | Command/Mirror.hs | 61 |
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 |