split executable out

README.md

@@ -16,6 +16,10 @@ You can set up a development environment with journeyman by using
 $ git clone git@github.com:mikeplus64/journeyman.git
 $ cd journeyman
 $ nix develop
+$ just repl
+  # Much loading and module compilation goes here :-)
+$ :l Tourney.UI.Main
+$ :main
 ```
 
 I have tested journeyman on Linux only, although macOS should work easily enough

app/Main.hs

@@ -3,7 +3,11 @@
 module Main where
 
 import BasePrelude
+import Tourney.Algebra
 import Tourney.UI.Main qualified
 
+knownTournaments :: [(Text, Tournament TMany)]
+knownTournaments = Tourney.UI.Main.defaultTournaments
+
 main :: IO ()
-main = () <$ Tourney.UI.Main.main
+main = () <$ Tourney.UI.Main.createTourneyUI knownTournaments

journeyman.cabal

@@ -19,7 +19,11 @@ description:
   * Your entrypoint to the eDSL should be the "Tourney.Algebra" module.
   .
   * Your entrypoint to exploring what's possible with Journeyman should be
-  the journeyman-ui executable that comes bundled with this package.
+  the journeyman-ui executable that comes bundled with this package. It
+  uses an extensible tournament UI defined in "Tourney.UI.Main", but all
+  you as a user needs to do is extend the list of known tournaments you
+  pass to 'Tourney.UI.Main.createTourneyUI' with a tournament you create.
+  For an example of how to do this, see the executable in @ app/Main.hs @.
   .
   * To create a special-purpose tournament VM, for instance, to simulate
   a tournament structure under different conditions, see the "Tourney.VM"

src/Tourney/Stream.hs

@@ -21,11 +21,15 @@
 --
 -- These diagrams may help elucidate how this is possible:
 --
--- <https://mikeplus64.github.io/journeyman/ub1.png>
+-- <<https://mikeplus64.github.io/journeyman/ub1.png>>
 --
--- <https://mikeplus64.github.io/journeyman/ub2.png>
+-- <<https://mikeplus64.github.io/journeyman/ub2.png>>
 --
--- <https://mikeplus64.github.io/journeyman/ub3.png>
+-- <<https://mikeplus64.github.io/journeyman/ub3.png>>
+--
+-- Here, an unbalanced combination of overlays and interleaves is turned into a
+-- balanced sequence of overlays by successively re-balancing the tournament
+-- tree.
 module Tourney.Stream (
   -- * Compilation
 

src/Tourney/UI/Main.hs

@@ -4,7 +4,7 @@
 
 {-# HLINT ignore "Avoid lambda" #-}
 
-module Tourney.UI.Main where
+module Tourney.UI.Main (createTourneyUI, defaultTournaments) where
 
 import Brick hiding (Max, Result, zoom)
 import Brick qualified
@@ -44,8 +44,8 @@ import Tourney.VM (VM)
 import Tourney.VM qualified as VM
 import Tourney.VM.Code (TourneyOp (..))
 
-knownTournaments :: [(Text, Tournament TMany)]
-knownTournaments =
+defaultTournaments :: [(Text, Tournament TMany)]
+defaultTournaments =
   [ ("Single Elimination", execSteps id singleElimination)
   , ("Double Elimination", execSteps id doubleElimination)
   , ("Round Robin", execSteps id roundRobin)
@@ -57,9 +57,6 @@ knownTournaments =
   , ("ICan'tBelieveItCanSort", execSteps id iCan'tBelieveItCanSort)
   ]
 
-knownTournamentsLen :: Int
-knownTournamentsLen = length knownTournaments
-
 data MenuForm = MenuForm
   { tournament :: !Int
   , playerCount :: !Text
@@ -71,6 +68,7 @@ data AppState = AppState
   , dialog :: Dialog DialogChoice AppResourceName
   , state :: !(Maybe TournamentState)
   , errors :: [Text]
+  , knownTournaments :: [(Text, Tournament TMany)]
   }
   deriving stock (Generic)
 
@@ -117,15 +115,16 @@ type UIElement = Reader TournamentState (Widget AppResourceName)
 
 data AppEvent deriving stock (Eq, Show, Ord)
 
-main :: IO AppState
-main =
+createTourneyUI :: [(Text, Tournament TMany)] -> IO AppState
+createTourneyUI knownTournaments =
   defaultMain
     app
     AppState
-      { menu = menuForm MenuForm{playerCount = "8", tournament = 0}
+      { menu = menuForm knownTournaments MenuForm{playerCount = "8", tournament = 0}
       , dialog = menuDialog
       , state = Nothing
       , errors = []
+      , knownTournaments
       }
   where
     app :: App AppState AppEvent AppResourceName
@@ -198,19 +197,24 @@ menuDialog =
     (Just (MenuEnter, [("Start", MenuEnter, DialogEnter)]))
     35
 
-menuForm :: MenuForm -> Form MenuForm AppEvent AppResourceName
-menuForm =
+menuForm
+  :: [(Text, Tournament TMany)]
+  -> MenuForm
+  -> Form MenuForm AppEvent AppResourceName
+menuForm knownTournaments =
   newForm
     [ (txt "Player count: " <+>)
         @@= editTextField #playerCount MenuPlayerCountItem (Just 1)
     , ((txt "Tournament type: " <=>) >>> padTop (Pad 1))
         @@= radioField
           #tournament
           [ (i, MenuTournamentItem i, knownTournaments ^?! ix i . _1)
-          | i <- [0 .. knownTournamentsLen - 1]
+          | i <- [0 .. len - 1]
           ]
     ]
     >>> setFormConcat (vBox >>> padAll 1)
+  where
+    len = length knownTournaments
 
 drawMenu :: Reader AppState (Widget AppResourceName)
 drawMenu = do
@@ -220,9 +224,10 @@ drawMenu = do
 
 beginTournament :: EventM AppResourceName AppState ()
 beginTournament = do
+  known <- use #knownTournaments
   mcount <- uses (#menu . to formState . #playerCount) (readEither @PlayerCount . toString)
-  tournIx <- use (#menu . to formState . #tournament)
-  let tournament = knownTournaments ^?! ix tournIx . _2
+  tournIx :: Int <- use (#menu . to formState . #tournament)
+  let tournament = known ^?! ix tournIx . _2
   case mcount of
     Left err -> #errors %= (err :)
     Right count -> do
@@ -388,9 +393,6 @@ drawMain = do
            ]
     )
 
-niceBorder :: Widget a -> Widget a
-niceBorder = joinBorders . withBorderStyle unicodeRounded . border
-
 drawCode :: UIElement
 drawCode = do
   code <- view #codeSoFar