wip

Command/Copy.hs

@@ -17,7 +17,7 @@ import Annex.NumCopies
 cmd :: Command
 cmd = command "copy" SectionCommon
 	"copy content of files to/from another repository"
-	paramPaths ((seek <=< finishParse) <$$> optParser)
+	paramPaths (seek <--< optParser)
 
 data CopyOptions = CopyOptions
 	{ moveOptions :: Command.Move.MoveOptions

Command/Fsck.hs

@@ -34,7 +34,6 @@ import Types.CleanupActions
 import Utility.HumanTime
 import Utility.CopyFile
 import Git.FilePath
-import Git.Types (RemoteName)
 import Utility.PID
 import qualified Database.Fsck as FsckDb
 
@@ -48,11 +47,13 @@ cmd = command "fsck" SectionMaintenance
 
 data FsckOptions = FsckOptions
 	{ fsckFiles :: CmdParams
-	, fsckFromOption :: Maybe RemoteName
+	, fsckFromOption :: Maybe (DeferredParse Remote)
 	, incrementalOpt :: Maybe IncrementalOpt
 	, keyOptions :: Maybe KeyOptions
 	}
 
+-- TODO: annexedMatchingOptions
+
 data IncrementalOpt
 	= StartIncrementalO
 	| MoreIncrementalO
@@ -61,7 +62,7 @@ data IncrementalOpt
 optParser :: CmdParamsDesc -> Parser FsckOptions
 optParser desc = FsckOptions
 	<$> cmdParams desc
-	<*> optional (strOption 
+	<*> optional (parseRemoteOption $ strOption 
 		( long "from" <> short 'f' <> metavar paramRemote 
 		<> help "check remote"
 		))
@@ -82,11 +83,9 @@ optParser desc = FsckOptions
 			<> help "schedule incremental fscking"
 			))
 
--- TODO: annexedMatchingOptions
-
 seek :: FsckOptions -> CommandSeek
 seek o = do
-	from <- Remote.byNameWithUUID (fsckFromOption o)
+	from <- maybe (pure Nothing) (Just <$$> getParsed) (fsckFromOption o)
 	u <- maybe getUUID (pure . Remote.uuid) from
 	i <- prepIncremental u (incrementalOpt o)
 	withKeyOptions (keyOptions o) False

Command/FuzzTest.hs

@@ -55,9 +55,9 @@ guardTest = unlessM (fromMaybe False . Git.Config.isTrue <$> getConfig key "") $
 
 fuzz :: Handle -> Annex ()
 fuzz logh = do
-	action <- genFuzzAction
-	record logh $ flip Started action
-	result <- tryNonAsync $ runFuzzAction action
+	fuzzer <- genFuzzAction
+	record logh $ flip Started fuzzer
+	result <- tryNonAsync $ runFuzzAction fuzzer
 	record logh $ flip Finished $
 		either (const False) (const True) result
 

Command/Get.hs

@@ -17,29 +17,39 @@ import Annex.Wanted
 import qualified Command.Move
 
 cmd :: Command
-cmd = withOptions getOptions $ 
-	command "get" SectionCommon 
-		"make content of annexed files available"
-		paramPaths (withParams seek)
+cmd = command "get" SectionCommon 
+	"make content of annexed files available"
+	paramPaths (seek <$$> optParser)
 
-getOptions :: [Option]
-getOptions = fromOption : autoOption : jobsOption : annexedMatchingOptions
-	++ incompleteOption : keyOptions
+data GetOptions = GetOptions
+	{ getFiles :: CmdParams
+	, getFrom :: Maybe (DeferredParse Remote)
+	, autoMode :: Bool
+	, keyOptions :: Maybe KeyOptions
+	}
 
-seek :: CmdParams -> CommandSeek
-seek ps = do
-	from <- getOptionField fromOption Remote.byNameWithUUID
-	auto <- getOptionFlag autoOption
-	withKeyOptions auto
+optParser :: CmdParamsDesc -> Parser GetOptions
+optParser desc = GetOptions
+	<$> cmdParams desc
+	<*> optional parseFromOption
+	<*> parseAutoOption
+	<*> optional (parseKeyOptions True)
+
+-- TODO: jobsOption, annexedMatchingOptions
+
+seek :: GetOptions -> CommandSeek
+seek o = do
+	from <- maybe (pure Nothing) (Just <$$> getParsed) (getFrom o)
+	withKeyOptions (keyOptions o) (autoMode o)
 		(startKeys from)
-		(withFilesInGit $ whenAnnexed $ start auto from)
-		ps
+		(withFilesInGit $ whenAnnexed $ start o from)
+		(getFiles o)
 
-start :: Bool -> Maybe Remote -> FilePath -> Key -> CommandStart
-start auto from file key = start' expensivecheck from key (Just file)
+start :: GetOptions -> Maybe Remote -> FilePath -> Key -> CommandStart
+start o from file key = start' expensivecheck from key (Just file)
   where
 	expensivecheck
-		| auto = numCopiesCheck file key (<) <||> wantGet False (Just key) (Just file)
+		| autoMode o = numCopiesCheck file key (<) <||> wantGet False (Just key) (Just file)
 		| otherwise = return True
 
 startKeys :: Maybe Remote -> Key -> CommandStart

Command/Info.hs

@@ -135,8 +135,8 @@ fileInfo file k = showCustom (unwords ["info", file]) $ do
 
 remoteInfo :: Remote -> Annex ()
 remoteInfo r = showCustom (unwords ["info", Remote.name r]) $ do
-	info <- map (\(k, v) -> simpleStat k (pure v)) <$> Remote.getInfo r
-	l <- selStats (remote_fast_stats r ++ info) (uuid_slow_stats (Remote.uuid r))
+	i <- map (\(k, v) -> simpleStat k (pure v)) <$> Remote.getInfo r
+	l <- selStats (remote_fast_stats r ++ i) (uuid_slow_stats (Remote.uuid r))
 	evalStateT (mapM_ showStat l) emptyStatInfo
 	return True
 

Command/Move.hs

@@ -20,7 +20,7 @@ import Logs.Presence
 cmd :: Command
 cmd = command "move" SectionCommon
 	"move content of files to/from another repository"
-	paramPaths ((seek <=< finishParse) <$$> optParser)
+	paramPaths (seek <--< optParser)
 
 data MoveOptions = MoveOptions
 	{ moveFiles :: CmdParams

Command/TransferKey.hs

@@ -16,41 +16,50 @@ import qualified Remote
 import Types.Remote
 
 cmd :: Command
-cmd = withOptions transferKeyOptions $ noCommit $
+cmd = noCommit $
 	command "transferkey" SectionPlumbing
 		"transfers a key from or to a remote"
-		paramKey (withParams seek)
+		paramKey (seek <--< optParser)
 
-transferKeyOptions :: [Option]
-transferKeyOptions = fileOption : fromToOptions
+data TransferKeyOptions = TransferKeyOptions
+	{ keyOptions :: CmdParams 
+	, fromToOptions :: FromToOptions
+	, fileOption :: AssociatedFile
+	}
 
-fileOption :: Option
-fileOption = fieldOption [] "file" paramFile "the associated file"
+optParser :: CmdParamsDesc -> Parser TransferKeyOptions
+optParser desc  = TransferKeyOptions
+	<$> cmdParams desc
+	<*> parseFromToOptions
+	<*> optional (strOption
+		( long "file" <> metavar paramFile
+		<> help "the associated file"
+		))
 
-seek :: CmdParams -> CommandSeek
-seek ps = do
-	to <- getOptionField toOption Remote.byNameWithUUID
-	from <- getOptionField fromOption Remote.byNameWithUUID
-	file <- getOptionField fileOption return
-	withKeys (start to from file) ps
+instance DeferredParseClass TransferKeyOptions where
+	finishParse v = TransferKeyOptions
+		<$> pure (keyOptions v)
+		<*> finishParse (fromToOptions v)
+		<*> pure (fileOption v)
 
-start :: Maybe Remote -> Maybe Remote -> AssociatedFile -> Key -> CommandStart
-start to from file key =
-	case (from, to) of
-		(Nothing, Just dest) -> next $ toPerform dest key file
-		(Just src, Nothing) -> next $ fromPerform src key file
-		_ -> error "specify either --from or --to"
+seek :: TransferKeyOptions -> CommandSeek
+seek o = withKeys (start o) (keyOptions o)
 
-toPerform :: Remote -> Key -> AssociatedFile -> CommandPerform
-toPerform remote key file = go Upload file $
+start :: TransferKeyOptions -> Key -> CommandStart
+start o key = case fromToOptions o of
+	ToRemote dest -> next $ toPerform key (fileOption o) =<< getParsed dest
+	FromRemote src -> next $ fromPerform key (fileOption o) =<< getParsed src
+
+toPerform :: Key -> AssociatedFile -> Remote -> CommandPerform
+toPerform key file remote = go Upload file $
 	upload (uuid remote) key file forwardRetry noObserver $ \p -> do
 		ok <- Remote.storeKey remote key file p
 		when ok $
 			Remote.logStatus remote key InfoPresent
 		return ok
 
-fromPerform :: Remote -> Key -> AssociatedFile -> CommandPerform
-fromPerform remote key file = go Upload file $
+fromPerform :: Key -> AssociatedFile -> Remote -> CommandPerform
+fromPerform key file remote = go Upload file $
 	download (uuid remote) key file forwardRetry noObserver $ \p ->
 		getViaTmp key $ \t -> Remote.retrieveKeyFile remote key file t p
 

Command/TransferKeys.hs

@@ -45,7 +45,7 @@ start = do
 			download (Remote.uuid remote) key file forwardRetry observer $ \p ->
 				getViaTmp key $ \t -> Remote.retrieveKeyFile remote key file t p
 	
-	observer False t info = recordFailedTransfer t info
+	observer False t tinfo = recordFailedTransfer t tinfo
 	observer True _ _ = noop
 
 runRequests
@@ -80,14 +80,14 @@ runRequests readh writeh a = do
 		hFlush writeh
 
 sendRequest :: Transfer -> TransferInfo -> Handle -> IO ()
-sendRequest t info h = do
+sendRequest t tinfo h = do
 	hPutStr h $ intercalate fieldSep
 		[ serialize (transferDirection t)
 		, maybe (serialize (fromUUID (transferUUID t)))
 			(serialize . Remote.name)
-			(transferRemote info)
+			(transferRemote tinfo)
 		, serialize (transferKey t)
-		, serialize (associatedFile info)
+		, serialize (associatedFile tinfo)
 		, "" -- adds a trailing null
 		]
 	hFlush h

Command/Version.hs

@@ -44,9 +44,9 @@ start = do
 	liftIO $ do
 
 		showPackageVersion
-		info "local repository version" $ fromMaybe "unknown" v
-		info "supported repository version" supportedVersion
-		info "upgrade supported from repository versions" $
+		vinfo "local repository version" $ fromMaybe "unknown" v
+		vinfo "supported repository version" supportedVersion
+		vinfo "upgrade supported from repository versions" $
 			unwords upgradableVersions
 	stop
 
@@ -55,10 +55,10 @@ startNoRepo _ = showPackageVersion
 
 showPackageVersion :: IO ()
 showPackageVersion = do
-	info "git-annex version" SysConfig.packageversion
-	info "build flags" $ unwords buildFlags
-	info "key/value backends" $ unwords $ map B.name Backend.list
-	info "remote types" $ unwords $ map R.typename Remote.remoteTypes
+	vinfo "git-annex version" SysConfig.packageversion
+	vinfo "build flags" $ unwords buildFlags
+	vinfo "key/value backends" $ unwords $ map B.name Backend.list
+	vinfo "remote types" $ unwords $ map R.typename Remote.remoteTypes
 
-info :: String -> String -> IO ()
-info k v = putStrLn $ k ++ ": " ++ v
+vinfo :: String -> String -> IO ()
+vinfo k v = putStrLn $ k ++ ": " ++ v