Move ping command parser to Cardano.CLI.Options.Ping

IntersectMBO · May 28, 2024 · 315e192 · 315e192
1 parent 9b6e30c
commit 315e192
Show file tree

Hide file tree

Showing 5 changed files with 95 additions and 88 deletions.
diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal
@@ -140,6 +140,7 @@ library
                         Cardano.CLI.Legacy.Run.TextView
                         Cardano.CLI.Legacy.Run.Transaction
                         Cardano.CLI.Options
+                        Cardano.CLI.Options.Ping
                         Cardano.CLI.OS.Posix
                         Cardano.CLI.Parser
                         Cardano.CLI.Pretty

diff --git a/cardano-cli/src/Cardano/CLI/Commands.hs b/cardano-cli/src/Cardano/CLI/Commands.hs
@@ -5,9 +5,9 @@ module Cardano.CLI.Commands
   ) where
 
 import           Cardano.CLI.Byron.Commands (ByronCommand)
+import           Cardano.CLI.Commands.Ping (PingCmd (..))
 import           Cardano.CLI.EraBased.Commands
 import           Cardano.CLI.Legacy.Commands
-import           Cardano.CLI.Run.Ping (PingCmd (..))
 
 import           Options.Applicative.Types (ParserInfo (..), ParserPrefs (..))
 

diff --git a/cardano-cli/src/Cardano/CLI/Options.hs b/cardano-cli/src/Cardano/CLI/Options.hs
@@ -15,9 +15,9 @@ import           Cardano.CLI.Environment (EnvCli)
 import           Cardano.CLI.EraBased.Commands
 import           Cardano.CLI.EraBased.Options.Common
 import           Cardano.CLI.Legacy.Options (parseLegacyCmds)
+import           Cardano.CLI.Options.Ping (parsePingCmd)
 import           Cardano.CLI.Render (customRenderHelp)
 import           Cardano.CLI.Run (ClientCommand (..))
-import           Cardano.CLI.Run.Ping (parsePingCmd)
 
 import           Data.Foldable
 import           Options.Applicative

diff --git a/cardano-cli/src/Cardano/CLI/Options/Ping.hs b/cardano-cli/src/Cardano/CLI/Options/Ping.hs
@@ -0,0 +1,91 @@
+{-# LANGUAGE TypeApplications #-}
+
+module Cardano.CLI.Options.Ping
+  ( parsePingCmd
+  ) where
+
+import           Cardano.CLI.Commands.Ping
+import qualified Cardano.Network.Ping as CNP
+
+import           Control.Applicative ((<|>))
+import qualified Options.Applicative as Opt
+import qualified Prettyprinter as PP
+
+parsePingCmd :: Opt.Parser PingCmd
+parsePingCmd = Opt.hsubparser $ mconcat
+  [ Opt.metavar "ping"
+  , Opt.command "ping" $ Opt.info pPing $ Opt.progDescDoc $ Just $ mconcat
+    [ PP.pretty @String "Ping a cardano node either using node-to-node or node-to-client protocol. "
+    , PP.pretty @String "It negotiates a handshake and keeps sending keep alive messages."
+    ]
+  ]
+
+pHost :: Opt.Parser String
+pHost =
+  Opt.strOption $ mconcat
+    [ Opt.long "host"
+    , Opt.short 'h'
+    , Opt.metavar "HOST"
+    , Opt.help "Hostname/IP, e.g. relay.iohk.example."
+    ]
+
+pUnixSocket :: Opt.Parser String
+pUnixSocket =
+  Opt.strOption $ mconcat
+    [ Opt.long "unixsock"
+    , Opt.short 'u'
+    , Opt.metavar "SOCKET"
+    , Opt.help "Unix socket, e.g. file.socket."
+    ]
+
+pEndPoint :: Opt.Parser EndPoint
+pEndPoint = fmap HostEndPoint pHost <|> fmap UnixSockEndPoint pUnixSocket
+
+pPing :: Opt.Parser PingCmd
+pPing = PingCmd
+  <$> ( Opt.option Opt.auto $ mconcat
+        [ Opt.long "count"
+        , Opt.short 'c'
+        , Opt.metavar "COUNT"
+        , Opt.help $ mconcat
+          [ "Stop after sending count requests and receiving count responses.  "
+          , "If this option is not specified, ping will operate until interrupted.  "
+          ]
+        , Opt.value maxBound
+        ]
+      )
+  <*> pEndPoint
+  <*> ( Opt.strOption $ mconcat
+        [ Opt.long "port"
+        , Opt.short 'p'
+        , Opt.metavar "PORT"
+        , Opt.help "Port number, e.g. 1234."
+        , Opt.value "3001"
+        ]
+      )
+  <*> ( Opt.option Opt.auto $ mconcat
+        [ Opt.long "magic"
+        , Opt.short 'm'
+        , Opt.metavar "MAGIC"
+        , Opt.help "Network magic."
+        , Opt.value CNP.mainnetMagic
+        ]
+      )
+  <*> ( Opt.switch $ mconcat
+        [ Opt.long "json"
+        , Opt.short 'j'
+        , Opt.help "JSON output flag."
+        ]
+      )
+  <*> ( Opt.switch $ mconcat
+        [ Opt.long "quiet"
+        , Opt.short 'q'
+        , Opt.help "Quiet flag, CSV/JSON only output"
+        ]
+      )
+  <*> ( Opt.switch $ mconcat
+        [ Opt.long "query-versions"
+        , Opt.short 'Q'
+        , Opt.help "Query the supported protocol versions using the handshake protocol and terminate the connection."
+        ]
+      )
diff --git a/cardano-cli/src/Cardano/CLI/Run/Ping.hs b/cardano-cli/src/Cardano/CLI/Run/Ping.hs
@@ -1,21 +1,17 @@
 {-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE TypeApplications #-}
 
 {- HLINT ignore "Move brackets to avoid $" -}
 
 module Cardano.CLI.Run.Ping
-  ( PingCmd(..)
-  , PingClientCmdError(..)
+  ( PingClientCmdError(..)
   , renderPingClientCmdError
   , runPingCmd
-  , parsePingCmd
   ) where
 
 import           Cardano.CLI.Commands.Ping
 import           Cardano.CLI.Pretty
 import qualified Cardano.Network.Ping as CNP
 
-import           Control.Applicative ((<|>))
 import           Control.Concurrent.Class.MonadSTM.Strict (StrictTMVar)
 import qualified Control.Concurrent.Class.MonadSTM.Strict as STM
 import           Control.Exception (SomeException)
@@ -29,8 +25,6 @@ import qualified Data.List as L
 import qualified Data.List as List
 import           Network.Socket (AddrInfo)
 import qualified Network.Socket as Socket
-import qualified Options.Applicative as Opt
-import qualified Prettyprinter as PP
 import qualified System.Exit as IO
 import qualified System.IO as IO
 
@@ -112,82 +106,3 @@ runPingCmd options = do
 renderPingClientCmdError :: PingClientCmdError -> Doc ann
 renderPingClientCmdError = \case
   PingClientCmdError es -> mconcat $ List.intersperse "\n" $ pshow <$> es
-
-parsePingCmd :: Opt.Parser PingCmd
-parsePingCmd = Opt.hsubparser $ mconcat
-  [ Opt.metavar "ping"
-  , Opt.command "ping" $ Opt.info pPing $ Opt.progDescDoc $ Just $ mconcat
-    [ PP.pretty @String "Ping a cardano node either using node-to-node or node-to-client protocol. "
-    , PP.pretty @String "It negotiates a handshake and keeps sending keep alive messages."
-    ]
-  ]
-
-pHost :: Opt.Parser String
-pHost =
-  Opt.strOption $ mconcat
-    [ Opt.long "host"
-    , Opt.short 'h'
-    , Opt.metavar "HOST"
-    , Opt.help "Hostname/IP, e.g. relay.iohk.example."
-    ]
-
-pUnixSocket :: Opt.Parser String
-pUnixSocket =
-  Opt.strOption $ mconcat
-    [ Opt.long "unixsock"
-    , Opt.short 'u'
-    , Opt.metavar "SOCKET"
-    , Opt.help "Unix socket, e.g. file.socket."
-    ]
-
-pEndPoint :: Opt.Parser EndPoint
-pEndPoint = fmap HostEndPoint pHost <|> fmap UnixSockEndPoint pUnixSocket
-
-pPing :: Opt.Parser PingCmd
-pPing = PingCmd
-  <$> ( Opt.option Opt.auto $ mconcat
-        [ Opt.long "count"
-        , Opt.short 'c'
-        , Opt.metavar "COUNT"
-        , Opt.help $ mconcat
-          [ "Stop after sending count requests and receiving count responses.  "
-          , "If this option is not specified, ping will operate until interrupted.  "
-          ]
-        , Opt.value maxBound
-        ]
-      )
-  <*> pEndPoint
-  <*> ( Opt.strOption $ mconcat
-        [ Opt.long "port"
-        , Opt.short 'p'
-        , Opt.metavar "PORT"
-        , Opt.help "Port number, e.g. 1234."
-        , Opt.value "3001"
-        ]
-      )
-  <*> ( Opt.option Opt.auto $ mconcat
-        [ Opt.long "magic"
-        , Opt.short 'm'
-        , Opt.metavar "MAGIC"
-        , Opt.help "Network magic."
-        , Opt.value CNP.mainnetMagic
-        ]
-      )
-  <*> ( Opt.switch $ mconcat
-        [ Opt.long "json"
-        , Opt.short 'j'
-        , Opt.help "JSON output flag."
-        ]
-      )
-  <*> ( Opt.switch $ mconcat
-        [ Opt.long "quiet"
-        , Opt.short 'q'
-        , Opt.help "Quiet flag, CSV/JSON only output"
-        ]
-      )
-  <*> ( Opt.switch $ mconcat
-        [ Opt.long "query-versions"
-        , Opt.short 'Q'
-        , Opt.help "Query the supported protocol versions using the handshake protocol and terminate the connection."
-        ]
-      )