converted Forget and TestRemote

1 files changed, 24 insertions, 19 deletions

diff --git a/Command/TestRemote.hs b/Command/TestRemote.hs
index 250c6f41a..e51dcaeb3 100644
--- a/Command/TestRemote.hs
+++ b/Command/TestRemote.hs
@@ -27,6 +27,7 @@ import Messages
 import Types.Messages
 import Remote.Helper.Chunked
 import Locations
+import Git.Types
 
 import Test.Tasty
 import Test.Tasty.Runners
@@ -37,25 +38,29 @@ import qualified Data.ByteString.Lazy as L
 import qualified Data.Map as M
 
 cmd :: Command
-cmd = withOptions [sizeOption] $
-	command "testremote" SectionTesting
-		"test transfers to/from a remote"
-		paramRemote (withParams seek)
-
-sizeOption :: Option
-sizeOption = fieldOption [] "size" paramSize "base key size (default 1MiB)"
-
-seek :: CmdParams -> CommandSeek
-seek ps = do
-	basesz <- fromInteger . fromMaybe (1024 * 1024)
-		<$> getOptionField sizeOption (pure . getsize)
-	withWords (start basesz) ps
-  where
-	getsize v = v >>= readSize dataUnits
-
-start :: Int -> [String] -> CommandStart
-start basesz ws = do
-	let name = unwords ws
+cmd = command "testremote" SectionTesting
+	"test transfers to/from a remote"
+	paramRemote (seek <$$> optParser)
+
+data TestRemoteOptions = TestRemoteOptions
+	{ testRemote :: RemoteName
+	, sizeOption :: ByteSize
+	}
+
+optParser :: CmdParamsDesc -> Parser TestRemoteOptions
+optParser desc = TestRemoteOptions
+	<$> argument str ( metavar desc )
+	<*> option (str >>= maybe (fail "parse error") return . readSize dataUnits)
+		( long "size" <> metavar paramSize
+		<> value (1024 * 1024)
+		<> help "base key size (default 1MiB)"
+		)
+
+seek :: TestRemoteOptions -> CommandSeek
+seek o = commandAction $ start (fromInteger $ sizeOption o) (testRemote o) 
+
+start :: Int -> RemoteName -> CommandStart
+start basesz name = do
 	showStart "testremote" name
 	r <- either error id <$> Remote.byName' name
 	showSideAction "generating test keys"