Skip to content

Commit 0151e2f

Browse files
author
Arnaud Bailly
authored
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
1 parent a6a6c53 commit 0151e2f

File tree

7 files changed

+135
-80
lines changed

7 files changed

+135
-80
lines changed

‎cabal.project

+4-1
Original file line numberDiff line numberDiff line change
@@ -14,5 +14,8 @@ index-state:
1414
, hackage.haskell.org 2024-03-21T15:07:04Z
1515
, cardano-haskell-packages 2024-03-21T19:04:02Z
1616

17-
packages:
17+
tests: True
18+
test-show-details: direct
19+
20+
packages:
1821
simulation

‎simulation/README.md

+4-31
Original file line numberDiff line numberDiff line change
@@ -11,7 +11,7 @@ The current simulation covers a few examples:
1111
* A simple block relaying protocol
1212
* A Leios-like traffic pattern for input blocks over a global-scale p2p network
1313

14-
The tool supports two visulaisation output styles:
14+
The tool supports two visualisation output styles:
1515

1616
* A live visualisation using a Gtk+ window
1717
* Output of animation frames to .png files, to turn into a video
@@ -21,33 +21,6 @@ For creating videos use a command like
2121
ffmpeg -i example/frame-%d.png -vf format=yuv420p example.mp4
2222
```
2323

24-
The `ouroboros-net-vis` command line is
25-
```
26-
Vizualisations of Ouroboros-related network simulations
27-
28-
Usage: ouroboros-net-vis VIZNAME [--frames-dir DIR] [--seconds SEC]
29-
[--skip-seconds SEC] [--cpu-render]
30-
[--720p | --1080p | --resolution (W,H)]
31-
32-
Either show a visualisation in a window, or output animation frames to a
33-
directory.
34-
35-
Available options:
36-
-h,--help Show this help text
37-
--frames-dir DIR Output animation frames to directory
38-
--seconds SEC Output N seconds of animation
39-
--skip-seconds SEC Skip the first N seconds of animation
40-
--cpu-render Use CPU-based client side Cairo rendering
41-
--720p Use 720p resolution
42-
--1080p Use 1080p resolution
43-
--resolution (W,H) Use a specific resolution
44-
```
45-
The current `VISNAME` examples are:
46-
47-
* tcp-1: a simple example of TCP slow start behaviour
48-
* tcp-2: comparing different bandwidths
49-
* tcp-3: comparing different traffic patterns
50-
* relay-1: a single pair of nodes using the relaying protocol
51-
* relay-2: four nodes using the relaying protocol
52-
* p2p-1: a Leios-like traffic pattern simulation of input blocks
53-
* p2p-2: a variation with more nodes in the p2p graph
24+
## Running simulator
25+
26+
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

+19
Original file line numberDiff line numberDiff line change
@@ -39,6 +39,7 @@ library
3939
TimeCompat
4040
Viz
4141
VizChart
42+
VizName
4243
VizSim
4344
VizSimRelay
4445
VizSimRelayP2P
@@ -63,6 +64,7 @@ library
6364
, kdt
6465
, pango
6566
, pqueue
67+
, QuickCheck
6668
, random
6769
, si-timers
6870
, time
@@ -80,3 +82,20 @@ executable ouroboros-net-vis
8082

8183
default-language: Haskell2010
8284
ghc-options: -Wall
85+
86+
test-suite tests
87+
default-language: Haskell2010
88+
ghc-options: -threaded -rtsopts -with-rtsopts=-N
89+
hs-source-dirs: test
90+
main-is: Main.hs
91+
type: exitcode-stdio-1.0
92+
other-modules: VizNameSpec
93+
build-depends:
94+
base
95+
, hspec
96+
, hspec-core
97+
, ouroboros-leios-sim
98+
, QuickCheck
99+
, quickcheck-classes
100+
101+
build-tool-depends: hspec-discover:hspec-discover

‎simulation/src/Main.hs

+37-48
Original file line numberDiff line numberDiff line change
@@ -6,23 +6,26 @@ import Control.Applicative (Alternative ((<|>)), optional)
66
import Data.Maybe (fromMaybe)
77
import qualified Options.Applicative as Opts
88

9-
import Viz
10-
11-
import qualified ExamplesRelay
12-
import qualified ExamplesRelayP2P
13-
import qualified ExamplesTCP
9+
import Viz (
10+
AnimVizConfig (..),
11+
GtkVizConfig (..),
12+
defaultAnimVizConfig,
13+
defaultGtkVizConfig,
14+
vizualise,
15+
writeAnimationFrames,
16+
)
17+
import VizName (VizName (..), namedViz)
1418

1519
main :: IO ()
1620
main = do
17-
CliCmd
18-
{ cliVizName
19-
, cliOutputFramesDir
20-
, cliOutputSeconds
21-
, cliOutputStartTime
22-
, cliCpuRendering
23-
, cliVizSize
24-
} <-
25-
Opts.execParser cli
21+
cmd <- Opts.execParser cli
22+
case cmd of
23+
Run opts ->
24+
runViz opts
25+
List -> listVisualizations
26+
27+
runViz :: RunOptions -> IO ()
28+
runViz RunOptions{cliVizName, cliOutputFramesDir, cliOutputSeconds, cliOutputStartTime, cliCpuRendering, cliVizSize} = do
2629
let viz = namedViz cliVizName
2730
case cliOutputFramesDir of
2831
Nothing ->
@@ -44,18 +47,23 @@ main = do
4447
, animVizResolution = cliVizSize
4548
}
4649

47-
cli :: Opts.ParserInfo CliCmd
50+
listVisualizations :: IO ()
51+
listVisualizations = do
52+
putStrLn "Available visualisations:"
53+
mapM_ (putStrLn . (" " ++) . show) $ enumFrom VizTCP1
54+
55+
cli :: Opts.ParserInfo Command
4856
cli =
4957
Opts.info
50-
(Opts.helper <*> options)
58+
(Opts.helper <*> command)
5159
( Opts.fullDesc
5260
<> Opts.header "Vizualisations of Ouroboros-related network simulations"
5361
<> Opts.progDesc
5462
"Either show a visualisation in a window, or output \
5563
\ animation frames to a directory."
5664
)
5765

58-
data CliCmd = CliCmd
66+
data RunOptions = RunOptions
5967
{ cliVizName :: VizName
6068
, cliOutputFramesDir :: Maybe FilePath
6169
, cliOutputSeconds :: Maybe Int
@@ -64,11 +72,20 @@ data CliCmd = CliCmd
6472
, cliVizSize :: Maybe (Int, Int)
6573
}
6674

67-
options :: Opts.Parser CliCmd
75+
data Command = Run RunOptions | List
76+
77+
command :: Opts.Parser Command
78+
command =
79+
Opts.hsubparser
80+
( Opts.command "run" (Opts.info (Run <$> options) (Opts.progDesc "Run a visualisation"))
81+
<> Opts.command "list" (Opts.info (pure List) (Opts.progDesc "List available visualisations"))
82+
)
83+
84+
options :: Opts.Parser RunOptions
6885
options =
69-
CliCmd
86+
RunOptions
7087
<$> Opts.argument
71-
(Opts.eitherReader readVizName)
88+
Opts.auto
7289
(Opts.metavar "VIZNAME")
7390
<*> optional
7491
( Opts.strOption
@@ -117,31 +134,3 @@ options =
117134
<> Opts.metavar "(W,H)"
118135
<> Opts.help "Use a specific resolution"
119136
)
120-
121-
data VizName
122-
= VizTCP1
123-
| VizTCP2
124-
| VizTCP3
125-
| VizRelay1
126-
| VizRelay2
127-
| VizRelayP2P1
128-
| VizRelayP2P2
129-
130-
readVizName :: String -> Either String VizName
131-
readVizName "tcp-1" = Right VizTCP1
132-
readVizName "tcp-2" = Right VizTCP2
133-
readVizName "tcp-3" = Right VizTCP3
134-
readVizName "relay-1" = Right VizRelay1
135-
readVizName "relay-2" = Right VizRelay2
136-
readVizName "p2p-1" = Right VizRelayP2P1
137-
readVizName "p2p-2" = Right VizRelayP2P2
138-
readVizName _ = Left "unknown vizualisation"
139-
140-
namedViz :: VizName -> Vizualisation
141-
namedViz VizTCP1 = ExamplesTCP.example1
142-
namedViz VizTCP2 = ExamplesTCP.example2
143-
namedViz VizTCP3 = ExamplesTCP.example3
144-
namedViz VizRelay1 = ExamplesRelay.example1
145-
namedViz VizRelay2 = ExamplesRelay.example2
146-
namedViz VizRelayP2P1 = ExamplesRelayP2P.example1
147-
namedViz VizRelayP2P2 = ExamplesRelayP2P.example2

‎simulation/src/VizName.hs

+59
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,59 @@
1+
-- | This module list all available `Vizualisation`
2+
--
3+
-- Should you add a new `Vizualisation`, you should add it here as well.
4+
module VizName where
5+
6+
import Data.Char (isSpace)
7+
import qualified ExamplesRelay
8+
import qualified ExamplesRelayP2P
9+
import qualified ExamplesTCP
10+
import Test.QuickCheck (Arbitrary (..), arbitraryBoundedEnum)
11+
import Viz (Vizualisation)
12+
13+
data VizName
14+
= VizTCP1
15+
| VizTCP2
16+
| VizTCP3
17+
| VizRelay1
18+
| VizRelay2
19+
| VizRelayP2P1
20+
| VizRelayP2P2
21+
deriving (Eq, Enum, Bounded)
22+
23+
instance Arbitrary VizName where
24+
arbitrary = arbitraryBoundedEnum
25+
26+
instance Show VizName where
27+
show VizTCP1 = "tcp-1"
28+
show VizTCP2 = "tcp-2"
29+
show VizTCP3 = "tcp-3"
30+
show VizRelay1 = "relay-1"
31+
show VizRelay2 = "relay-2"
32+
show VizRelayP2P1 = "p2p-1"
33+
show VizRelayP2P2 = "p2p-2"
34+
35+
instance Read VizName where
36+
readsPrec _ s = case readVizName s of
37+
Right v -> [(v, "")]
38+
Left _ -> []
39+
where
40+
readVizName :: String -> Either String VizName
41+
readVizName input =
42+
case dropWhile isSpace input of
43+
"tcp-1" -> Right VizTCP1
44+
"tcp-2" -> Right VizTCP2
45+
"tcp-3" -> Right VizTCP3
46+
"relay-1" -> Right VizRelay1
47+
"relay-2" -> Right VizRelay2
48+
"p2p-1" -> Right VizRelayP2P1
49+
"p2p-2" -> Right VizRelayP2P2
50+
_ -> Left "unknown vizualisation"
51+
52+
namedViz :: VizName -> Vizualisation
53+
namedViz VizTCP1 = ExamplesTCP.example1
54+
namedViz VizTCP2 = ExamplesTCP.example2
55+
namedViz VizTCP3 = ExamplesTCP.example3
56+
namedViz VizRelay1 = ExamplesRelay.example1
57+
namedViz VizRelay2 = ExamplesRelay.example2
58+
namedViz VizRelayP2P1 = ExamplesRelayP2P.example1
59+
namedViz VizRelayP2P2 = ExamplesRelayP2P.example2

‎simulation/test/Main.hs

+1
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
{-# OPTIONS_GHC -F -pgmF hspec-discover #-}

‎simulation/test/VizNameSpec.hs

+11
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,11 @@
1+
module VizNameSpec where
2+
3+
import Test.Hspec
4+
5+
import Data.Proxy (Proxy (..))
6+
import Test.QuickCheck.Classes (lawsCheck, showReadLaws)
7+
import VizName (VizName)
8+
9+
spec :: Spec
10+
spec =
11+
it "read is inverse to show" $ lawsCheck $ showReadLaws (Proxy :: Proxy VizName)

0 commit comments

Comments
 (0)