Provide a list command to list available visualisations (#40)

It's a bit cumbersome to have to look at the source file or the README
to know what simulations can be run. Moreover, should we add new
simulations, it will be easy for the documentation to become out of
sync with the actual code.

Add basic roundtrip property test for VizName

Also adjust verbosity of tests output

cabal.project

@@ -14,5 +14,8 @@ index-state:
   , hackage.haskell.org 2024-03-21T15:07:04Z
   , cardano-haskell-packages 2024-03-21T19:04:02Z
 
-packages: 
+tests: True
+test-show-details: direct
+
+packages:
   simulation

simulation/README.md

@@ -11,7 +11,7 @@ The current simulation covers a few examples:
 * A simple block relaying protocol
 * A Leios-like traffic pattern for input blocks over a global-scale p2p network
 
-The tool supports two visulaisation output styles:
+The tool supports two visualisation output styles:
 
 * A live visualisation using a Gtk+ window
 * Output of animation frames to .png files, to turn into a video
@@ -21,33 +21,6 @@ For creating videos use a command like
 ffmpeg -i example/frame-%d.png -vf format=yuv420p example.mp4
 ```
 
-The `ouroboros-net-vis` command line is
-```
-Vizualisations of Ouroboros-related network simulations
-
-Usage: ouroboros-net-vis VIZNAME [--frames-dir DIR] [--seconds SEC] 
-                         [--skip-seconds SEC] [--cpu-render] 
-                         [--720p | --1080p | --resolution (W,H)]
-
-  Either show a visualisation in a window, or output animation frames to a
-  directory.
-
-Available options:
-  -h,--help                Show this help text
-  --frames-dir DIR         Output animation frames to directory
-  --seconds SEC            Output N seconds of animation
-  --skip-seconds SEC       Skip the first N seconds of animation
-  --cpu-render             Use CPU-based client side Cairo rendering
-  --720p                   Use 720p resolution
-  --1080p                  Use 1080p resolution
-  --resolution (W,H)       Use a specific resolution
-```
-The current `VISNAME` examples are:
-
-* tcp-1: a simple example of TCP slow start behaviour
-* tcp-2: comparing different bandwidths
-* tcp-3: comparing different traffic patterns
-* relay-1: a single pair of nodes using the relaying protocol
-* relay-2: four nodes using the relaying protocol
-* p2p-1: a Leios-like traffic pattern simulation of input blocks
-* p2p-2: a variation with more nodes in the p2p graph
+## Running simulator
+
+Assuming the executable has been built in the directory containing this `README`, one can run the simulator with `cabal run ouroboros-net-vis`. Inline help is provided through the usual `--help` or `-h` flags.

simulation/ouroboros-leios-sim.cabal

@@ -39,6 +39,7 @@ library
     TimeCompat
     Viz
     VizChart
+    VizName
     VizSim
     VizSimRelay
     VizSimRelayP2P
@@ -63,6 +64,7 @@ library
     , kdt
     , pango
     , pqueue
+    , QuickCheck
     , random
     , si-timers
     , time
@@ -80,3 +82,20 @@ executable ouroboros-net-vis
 
   default-language: Haskell2010
   ghc-options:      -Wall
+
+test-suite tests
+  default-language:   Haskell2010
+  ghc-options:        -threaded -rtsopts -with-rtsopts=-N
+  hs-source-dirs:     test
+  main-is:            Main.hs
+  type:               exitcode-stdio-1.0
+  other-modules:      VizNameSpec
+  build-depends:
+      base
+    , hspec
+    , hspec-core
+    , ouroboros-leios-sim
+    , QuickCheck
+    , quickcheck-classes
+
+  build-tool-depends: hspec-discover:hspec-discover

simulation/src/Main.hs

@@ -6,23 +6,26 @@ import Control.Applicative (Alternative ((<|>)), optional)
 import Data.Maybe (fromMaybe)
 import qualified Options.Applicative as Opts
 
-import Viz
-
-import qualified ExamplesRelay
-import qualified ExamplesRelayP2P
-import qualified ExamplesTCP
+import Viz (
+  AnimVizConfig (..),
+  GtkVizConfig (..),
+  defaultAnimVizConfig,
+  defaultGtkVizConfig,
+  vizualise,
+  writeAnimationFrames,
+ )
+import VizName (VizName (..), namedViz)
 
 main :: IO ()
 main = do
-  CliCmd
-    { cliVizName
-    , cliOutputFramesDir
-    , cliOutputSeconds
-    , cliOutputStartTime
-    , cliCpuRendering
-    , cliVizSize
-    } <-
-    Opts.execParser cli
+  cmd <- Opts.execParser cli
+  case cmd of
+    Run opts ->
+      runViz opts
+    List -> listVisualizations
+
+runViz :: RunOptions -> IO ()
+runViz RunOptions{cliVizName, cliOutputFramesDir, cliOutputSeconds, cliOutputStartTime, cliCpuRendering, cliVizSize} = do
   let viz = namedViz cliVizName
   case cliOutputFramesDir of
     Nothing ->
@@ -44,18 +47,23 @@ main = do
           , animVizResolution = cliVizSize
           }
 
-cli :: Opts.ParserInfo CliCmd
+listVisualizations :: IO ()
+listVisualizations = do
+  putStrLn "Available visualisations:"
+  mapM_ (putStrLn . ("  " ++) . show) $ enumFrom VizTCP1
+
+cli :: Opts.ParserInfo Command
 cli =
   Opts.info
-    (Opts.helper <*> options)
+    (Opts.helper <*> command)
     ( Opts.fullDesc
         <> Opts.header "Vizualisations of Ouroboros-related network simulations"
         <> Opts.progDesc
           "Either show a visualisation in a window, or output \
           \ animation frames to a directory."
     )
 
-data CliCmd = CliCmd
+data RunOptions = RunOptions
   { cliVizName :: VizName
   , cliOutputFramesDir :: Maybe FilePath
   , cliOutputSeconds :: Maybe Int
@@ -64,11 +72,20 @@ data CliCmd = CliCmd
   , cliVizSize :: Maybe (Int, Int)
   }
 
-options :: Opts.Parser CliCmd
+data Command = Run RunOptions | List
+
+command :: Opts.Parser Command
+command =
+  Opts.hsubparser
+    ( Opts.command "run" (Opts.info (Run <$> options) (Opts.progDesc "Run a visualisation"))
+        <> Opts.command "list" (Opts.info (pure List) (Opts.progDesc "List available visualisations"))
+    )
+
+options :: Opts.Parser RunOptions
 options =
-  CliCmd
+  RunOptions
     <$> Opts.argument
-      (Opts.eitherReader readVizName)
+      Opts.auto
       (Opts.metavar "VIZNAME")
     <*> optional
       ( Opts.strOption
@@ -117,31 +134,3 @@ options =
             <> Opts.metavar "(W,H)"
             <> Opts.help "Use a specific resolution"
         )
-
-data VizName
-  = VizTCP1
-  | VizTCP2
-  | VizTCP3
-  | VizRelay1
-  | VizRelay2
-  | VizRelayP2P1
-  | VizRelayP2P2
-
-readVizName :: String -> Either String VizName
-readVizName "tcp-1" = Right VizTCP1
-readVizName "tcp-2" = Right VizTCP2
-readVizName "tcp-3" = Right VizTCP3
-readVizName "relay-1" = Right VizRelay1
-readVizName "relay-2" = Right VizRelay2
-readVizName "p2p-1" = Right VizRelayP2P1
-readVizName "p2p-2" = Right VizRelayP2P2
-readVizName _ = Left "unknown vizualisation"
-
-namedViz :: VizName -> Vizualisation
-namedViz VizTCP1 = ExamplesTCP.example1
-namedViz VizTCP2 = ExamplesTCP.example2
-namedViz VizTCP3 = ExamplesTCP.example3
-namedViz VizRelay1 = ExamplesRelay.example1
-namedViz VizRelay2 = ExamplesRelay.example2
-namedViz VizRelayP2P1 = ExamplesRelayP2P.example1
-namedViz VizRelayP2P2 = ExamplesRelayP2P.example2

simulation/src/VizName.hs

@@ -0,0 +1,59 @@
+-- | This module list all available `Vizualisation`
+--
+-- Should you add a new `Vizualisation`, you should add it here as well.
+module VizName where
+
+import Data.Char (isSpace)
+import qualified ExamplesRelay
+import qualified ExamplesRelayP2P
+import qualified ExamplesTCP
+import Test.QuickCheck (Arbitrary (..), arbitraryBoundedEnum)
+import Viz (Vizualisation)
+
+data VizName
+  = VizTCP1
+  | VizTCP2
+  | VizTCP3
+  | VizRelay1
+  | VizRelay2
+  | VizRelayP2P1
+  | VizRelayP2P2
+  deriving (Eq, Enum, Bounded)
+
+instance Arbitrary VizName where
+  arbitrary = arbitraryBoundedEnum
+
+instance Show VizName where
+  show VizTCP1 = "tcp-1"
+  show VizTCP2 = "tcp-2"
+  show VizTCP3 = "tcp-3"
+  show VizRelay1 = "relay-1"
+  show VizRelay2 = "relay-2"
+  show VizRelayP2P1 = "p2p-1"
+  show VizRelayP2P2 = "p2p-2"
+
+instance Read VizName where
+  readsPrec _ s = case readVizName s of
+    Right v -> [(v, "")]
+    Left _ -> []
+   where
+    readVizName :: String -> Either String VizName
+    readVizName input =
+      case dropWhile isSpace input of
+        "tcp-1" -> Right VizTCP1
+        "tcp-2" -> Right VizTCP2
+        "tcp-3" -> Right VizTCP3
+        "relay-1" -> Right VizRelay1
+        "relay-2" -> Right VizRelay2
+        "p2p-1" -> Right VizRelayP2P1
+        "p2p-2" -> Right VizRelayP2P2
+        _ -> Left "unknown vizualisation"
+
+namedViz :: VizName -> Vizualisation
+namedViz VizTCP1 = ExamplesTCP.example1
+namedViz VizTCP2 = ExamplesTCP.example2
+namedViz VizTCP3 = ExamplesTCP.example3
+namedViz VizRelay1 = ExamplesRelay.example1
+namedViz VizRelay2 = ExamplesRelay.example2
+namedViz VizRelayP2P1 = ExamplesRelayP2P.example1
+namedViz VizRelayP2P2 = ExamplesRelayP2P.example2

simulation/test/Main.hs

@@ -0,0 +1 @@
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}

simulation/test/VizNameSpec.hs

@@ -0,0 +1,11 @@
+module VizNameSpec where
+
+import Test.Hspec
+
+import Data.Proxy (Proxy (..))
+import Test.QuickCheck.Classes (lawsCheck, showReadLaws)
+import VizName (VizName)
+
+spec :: Spec
+spec =
+  it "read is inverse to show" $ lawsCheck $ showReadLaws (Proxy :: Proxy VizName)