diff options
author | Joey Hess <joeyh@joeyh.name> | 2015-07-11 00:42:32 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2015-07-11 00:42:32 -0400 |
commit | e2f434c2a07d8aa8a27eeeb6394bebd7684285ef (patch) | |
tree | ce706ea24348ab4c3c2347569b7f6cd84ab7ec49 /Command/TestRemote.hs | |
parent | 45acd1f959b4c7e7381ac1f03b30f937330cfa88 (diff) |
converted Forget and TestRemote
Diffstat (limited to 'Command/TestRemote.hs')
-rw-r--r-- | Command/TestRemote.hs | 43 |
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" |