converted Forget and TestRemote

CmdLine/GitAnnex.hs

@@ -92,10 +92,10 @@ import qualified Command.Map
 import qualified Command.Direct
 import qualified Command.Indirect
 import qualified Command.Upgrade
---import qualified Command.Forget
+import qualified Command.Forget
 import qualified Command.Proxy
 import qualified Command.DiffDriver
---import qualified Command.Undo
+import qualified Command.Undo
 import qualified Command.Version
 #ifdef WITH_ASSISTANT
 --import qualified Command.Watch
@@ -111,7 +111,7 @@ import qualified Command.RemoteDaemon
 import qualified Command.Test
 #ifdef WITH_TESTSUITE
 import qualified Command.FuzzTest
---import qualified Command.TestRemote
+import qualified Command.TestRemote
 #endif
 #ifdef WITH_EKG
 import System.Remote.Monitoring
@@ -197,10 +197,10 @@ cmds =
 	, Command.Direct.cmd
 	, Command.Indirect.cmd
 	, Command.Upgrade.cmd
---	, Command.Forget.cmd
+	, Command.Forget.cmd
 	, Command.Proxy.cmd
 	, Command.DiffDriver.cmd
---	, Command.Undo.cmd
+	, Command.Undo.cmd
 	, Command.Version.cmd
 #ifdef WITH_ASSISTANT
 --	, Command.Watch.cmd
@@ -216,7 +216,7 @@ cmds =
 	, Command.Test.cmd
 #ifdef WITH_TESTSUITE
 	, Command.FuzzTest.cmd
---	, Command.TestRemote.cmd
+	, Command.TestRemote.cmd
 #endif
 	]
 

Command/Forget.hs

@@ -16,28 +16,30 @@ import qualified Annex
 import Data.Time.Clock.POSIX
 
 cmd :: Command
-cmd = withOptions forgetOptions $ 
+cmd = command "forget" SectionMaintenance 
-	command "forget" SectionMaintenance 
 	"prune git-annex branch history"
-		paramNothing (withParams seek)
+	paramNothing (seek <$$> optParser)
 
-forgetOptions :: [Option]
+data ForgetOptions = ForgetOptions
-forgetOptions = [dropDeadOption]
+	{ dropDead :: Bool
+	}
 
-dropDeadOption :: Option
+optParser :: CmdParamsDesc -> Parser ForgetOptions
-dropDeadOption = flagOption [] "drop-dead" "drop references to dead repositories"
+optParser _ = ForgetOptions
+	<$> switch
+		( long "drop-dead"
+		<> help "drop references to dead repositories"
+		)
 
-seek :: CmdParams -> CommandSeek
+seek :: ForgetOptions -> CommandSeek
-seek ps = do
+seek = commandAction . start
-	dropdead <- getOptionFlag dropDeadOption
-	withNothing (start dropdead) ps
 
-start :: Bool -> CommandStart
+start :: ForgetOptions -> CommandStart
-start dropdead = do
+start o = do
 	showStart "forget" "git-annex"
 	now <- liftIO getPOSIXTime
 	let basets = addTransition now ForgetGitHistory noTransitions
-	let ts = if dropdead
+	let ts = if dropDead o
 		then addTransition now ForgetDeadRemotes basets
 		else basets
 	next $ perform ts =<< Annex.getState Annex.force

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] $
+cmd = command "testremote" SectionTesting
-	command "testremote" SectionTesting
 	"test transfers to/from a remote"
-		paramRemote (withParams seek)
+	paramRemote (seek <$$> optParser)
 
-sizeOption :: Option
+data TestRemoteOptions = TestRemoteOptions
-sizeOption = fieldOption [] "size" paramSize "base key size (default 1MiB)"
+	{ testRemote :: RemoteName
+	, sizeOption :: ByteSize
+	}
 
-seek :: CmdParams -> CommandSeek
+optParser :: CmdParamsDesc -> Parser TestRemoteOptions
-seek ps = do
+optParser desc = TestRemoteOptions
-	basesz <- fromInteger . fromMaybe (1024 * 1024)
+	<$> argument str ( metavar desc )
-		<$> getOptionField sizeOption (pure . getsize)
+	<*> option (str >>= maybe (fail "parse error") return . readSize dataUnits)
-	withWords (start basesz) ps
+		( long "size" <> metavar paramSize
-  where
+		<> value (1024 * 1024)
-	getsize v = v >>= readSize dataUnits
+		<> help "base key size (default 1MiB)"
+		)
 
-start :: Int -> [String] -> CommandStart
+seek :: TestRemoteOptions -> CommandSeek
-start basesz ws = do
+seek o = commandAction $ start (fromInteger $ sizeOption o) (testRemote o) 
-	let name = unwords ws
+
+start :: Int -> RemoteName -> CommandStart
+start basesz name = do
 	showStart "testremote" name
 	r <- either error id <$> Remote.byName' name
 	showSideAction "generating test keys"