use nested sum type to simplify panel enumeration (#876)

This trick facilitates use of `listEnums` and more concise pattern matching.

Towards #873.

src/Swarm/TUI/Controller.hs

@@ -49,6 +49,7 @@ import Control.Carrier.State.Lazy qualified as Fused
 import Control.Lens
 import Control.Lens.Extras (is)
 import Control.Monad.Except
+import Control.Monad.Extra (whenJust)
 import Control.Monad.State
 import Data.Bits
 import Data.Either (isRight)
@@ -292,34 +293,37 @@ handleMainEvent ev = do
       | s ^. uiState . uiCheatMode -> gameState . creativeMode %= not
     MouseDown n _ _ mouseLoc ->
       case n of
-        WorldPanel -> do
+        FocusablePanel WorldPanel -> do
           mouseCoordsM <- Brick.zoom gameState (mouseLocToWorldCoords mouseLoc)
           uiState . uiWorldCursor .= mouseCoordsM
-        REPLInput -> do
-          setFocus REPLPanel
-          handleREPLEvent ev
+        REPLInput -> handleREPLEvent ev
         _ -> continueWithoutRedraw
     MouseUp n _ _mouseLoc -> do
       case n of
         InventoryListItem pos -> uiState . uiInventory . traverse . _2 %= BL.listMoveTo pos
         _ -> return ()
-      setFocus $ case n of
+      flip whenJust setFocus $ case n of
         -- Adapt click event origin to their right panel.
         -- For the REPL and the World view, using 'Brick.Widgets.Core.clickable' correctly set the origin.
         -- However this does not seems to work for the robot and info panel.
         -- Thus we force the destination focus here.
-        InventoryList -> RobotPanel
-        InventoryListItem _ -> RobotPanel
-        InfoViewport -> InfoPanel
-        _ -> n
+        InventoryList -> Just RobotPanel
+        InventoryListItem _ -> Just RobotPanel
+        InfoViewport -> Just InfoPanel
+        REPLInput -> Just REPLPanel
+        _ -> Nothing
+      case n of
+        FocusablePanel x -> setFocus x
+        _ -> return ()
     -- dispatch any other events to the focused panel handler
     _ev -> do
       fring <- use $ uiState . uiFocusRing
       case focusGetCurrent fring of
-        Just REPLPanel -> handleREPLEvent ev
-        Just WorldPanel -> handleWorldEvent ev
-        Just RobotPanel -> handleRobotPanelEvent ev
-        Just InfoPanel -> handleInfoPanelEvent infoScroll ev
+        Just (FocusablePanel x) -> ($ ev) $ case x of
+          REPLPanel -> handleREPLEvent
+          WorldPanel -> handleWorldEvent
+          RobotPanel -> handleRobotPanelEvent
+          InfoPanel -> handleInfoPanelEvent infoScroll
         _ -> continueWithoutRedraw
 
 mouseLocToWorldCoords :: Brick.Location -> EventM Name GameState (Maybe W.Coords)
@@ -335,8 +339,8 @@ mouseLocToWorldCoords (Brick.Location mouseLoc) = do
           my = fst mouseLoc' + snd regionStart
        in pure . Just $ W.Coords (mx, my)
 
-setFocus :: Name -> EventM Name AppState ()
-setFocus name = uiState . uiFocusRing %= focusSetCurrent name
+setFocus :: FocusablePanel -> EventM Name AppState ()
+setFocus name = uiState . uiFocusRing %= focusSetCurrent (FocusablePanel name)
 
 -- | Set the game to Running if it was (auto) paused otherwise to paused.
 --
@@ -632,7 +636,7 @@ updateUI = do
     -- them "sticky".  They will be updated as soon as the player moves
     -- the focus away.
     fring <- use $ uiState . uiFocusRing
-    let sticky = focusGetCurrent fring `elem` [Just RobotPanel, Just InfoPanel]
+    let sticky = focusGetCurrent fring `elem` map (Just . FocusablePanel) [RobotPanel, InfoPanel]
 
     -- Check if the robot log was updated and we are allowed to change
     -- the inventory+info panels.

src/Swarm/TUI/Model.hs

@@ -16,6 +16,7 @@ module Swarm.TUI.Model (
   -- * Custom UI label types
   -- $uilabel
   AppEvent (..),
+  FocusablePanel (..),
   Name (..),
 
   -- * Menus and dialogs
@@ -224,9 +225,7 @@ data AppEvent
   | UpstreamVersion (Either NewReleaseFailure String)
   deriving (Show)
 
--- | 'Name' represents names to uniquely identify various components
---   of the UI, such as forms, panels, caches, extents, and lists.
-data Name
+data FocusablePanel
   = -- | The panel containing the REPL.
     REPLPanel
   | -- | The panel containing the world view.
@@ -235,6 +234,12 @@ data Name
     RobotPanel
   | -- | The info panel on the bottom left.
     InfoPanel
+  deriving (Eq, Ord, Show, Read, Bounded, Enum)
+
+-- | 'Name' represents names to uniquely identify various components
+--   of the UI, such as forms, panels, caches, extents, and lists.
+data Name
+  = FocusablePanel FocusablePanel
   | -- | The REPL input form.
     REPLInput
   | -- | The render cache for the world view.
@@ -820,7 +825,7 @@ focusedEntity =
 
 -- | The initial state of the focus ring.
 initFocusRing :: FocusRing Name
-initFocusRing = focusRing [REPLPanel, InfoPanel, RobotPanel, WorldPanel]
+initFocusRing = focusRing $ map FocusablePanel listEnums
 
 -- | The initial tick speed.
 initLgTicksPerSecond :: Int

src/Swarm/TUI/View.hs

@@ -271,11 +271,11 @@ drawGameUI s =
       hBox
         [ hLimitPercent 25 $
             vBox
-              [ vLimitPercent 50 $ panel highlightAttr fr RobotPanel plainBorder $ drawRobotPanel s
+              [ vLimitPercent 50 $ panel highlightAttr fr (FocusablePanel RobotPanel) plainBorder $ drawRobotPanel s
               , panel
                   highlightAttr
                   fr
-                  InfoPanel
+                  (FocusablePanel InfoPanel)
                   ( plainBorder
                       & topLabels . centerLabel
                       .~ (if moreTop then Just (txt " · · · ") else Nothing)
@@ -288,7 +288,7 @@ drawGameUI s =
             [ panel
                 highlightAttr
                 fr
-                WorldPanel
+                (FocusablePanel WorldPanel)
                 ( plainBorder
                     & bottomLabels . rightLabel ?~ padLeftRight 1 (drawTPS s)
                     & topLabels . leftLabel ?~ drawModalMenu s
@@ -297,11 +297,11 @@ drawGameUI s =
                 )
                 (drawWorld (s ^. uiState . uiShowRobots) (s ^. gameState))
             , drawKeyMenu s
-            , clickable REPLPanel $
+            , clickable (FocusablePanel REPLPanel) $
                 panel
                   highlightAttr
                   fr
-                  REPLPanel
+                  (FocusablePanel REPLPanel)
                   ( plainBorder
                       & topLabels . rightLabel .~ (drawType <$> (s ^. uiState . uiREPL . replType))
                   )
@@ -828,24 +828,24 @@ drawKeyMenu s =
     "pop out" | (s ^. uiState . uiMoreInfoBot) || (s ^. uiState . uiMoreInfoTop) -> Alert
     _ -> PanelSpecific
 
-  keyCmdsFor (Just REPLPanel) =
+  keyCmdsFor (Just (FocusablePanel REPLPanel)) =
     [ ("↓↑", "history")
     ]
       ++ [("Enter", "execute") | not isReplWorking]
       ++ [("^c", "cancel") | isReplWorking]
       ++ [("M-p", renderControlModeSwitch ctrlMode) | creative]
-  keyCmdsFor (Just WorldPanel) =
+  keyCmdsFor (Just (FocusablePanel WorldPanel)) =
     [ ("←↓↑→ / hjkl", "scroll") | creative
     ]
       ++ [("c", "recenter") | not viewingBase]
       ++ [("f", "FPS")]
-  keyCmdsFor (Just RobotPanel) =
+  keyCmdsFor (Just (FocusablePanel RobotPanel)) =
     [ ("Enter", "pop out")
     , ("m", "make")
     , ("0", (if showZero then "hide" else "show") <> " 0")
     , (":/;", T.unwords ["Sort:", renderSortMethod inventorySort])
     ]
-  keyCmdsFor (Just InfoPanel) = []
+  keyCmdsFor (Just (FocusablePanel InfoPanel)) = []
   keyCmdsFor _ = []
 
 data KeyHighlight = NoHighlight | Alert | PanelSpecific
@@ -874,7 +874,7 @@ drawWorld showRobots g =
     . cached WorldCache
     . reportExtent WorldExtent
     -- Set the clickable request after the extent to play nice with the cache
-    . clickable WorldPanel
+    . clickable (FocusablePanel WorldPanel)
     . Widget Fixed Fixed
     $ do
       ctx <- getContext
@@ -1217,7 +1217,7 @@ renderREPLPrompt focus repl = ps1 <+> replE
   replE =
     renderEditor
       (color . vBox . map txt)
-      (focusGetCurrent focus `elem` [Nothing, Just REPLPanel, Just REPLInput])
+      (focusGetCurrent focus `elem` [Nothing, Just (FocusablePanel REPLPanel), Just REPLInput])
       replEditor
 
 -- | Draw the REPL.