Add module panel event handling/opening

This adds the new feature of being able to access the Modules panel

app/AppState.hs

@@ -6,12 +6,15 @@ module AppState
     , AppState (..)
     , WidgetSizes
     , changeInfoWidgetSize
-    , changeReplWidgetSize
     , getInfoWidth
     , getReplHeight
+    , changeReplWidgetSize
+    , getSelectedModuleInInfoPanel
+    , changeSelectedModuleInInfoPanel
     , appInterpState
     , getSourceContents
     , getSourceLineCount
+    , filePathOfInfoSelectedModule
     , listAvailableSources
     , liveEditor'
     , makeInitialState
@@ -23,7 +26,7 @@ module AppState
     ) where
 
 import qualified Brick.Widgets.Edit as BE
-import Control.Error (fromMaybe, lastMay)
+import Control.Error (atMay, fromMaybe, lastMay)
 import Control.Exception (IOException, SomeException, catch, try)
 import Control.Monad.IO.Class (MonadIO (..))
 import qualified Data.Map.Strict as Map
@@ -40,7 +43,10 @@ import qualified Ghcid.Daemon as Daemon
 import qualified Loc
 import qualified Util
 
-data ActiveWindow = ActiveCodeViewport | ActiveLiveInterpreter | ActiveInfoWindow
+data ActiveWindow
+    = ActiveCodeViewport
+    | ActiveLiveInterpreter
+    | ActiveInfoWindow
     deriving (Show, Eq, Ord)
 
 data MaxState = NoMaxState | Maximised | Minimised
@@ -77,7 +83,9 @@ data AppState n = AppState
     , selectedFile :: !(Maybe FilePath)
     -- ^ Filepath to the current code viewport contents, if set.
     , selectedLine :: !Int
-    -- ^ Currently selected line number. Resets back to 1.
+    -- ^ Currently selected line number. One indexed. Resets back to 1.
+    , _infoPanelSelectedModule :: !Int
+    -- ^ Currently selected module in the info sidebar, zero indexed.
     , sourceMap :: Map.Map FilePath T.Text
     -- ^ Mapping between source filepaths and their contents.
     , _currentWidgetSizes :: WidgetSizes
@@ -168,17 +176,25 @@ updateSourceMapWithFilepath s filepath
         eContents <- try $ T.readFile adjustedFilepath :: IO (Either IOException T.Text)
         case eContents of
             Left err -> do
-                pure $ writeDebugLog (T.pack $ show err) s
+                pure $
+                    writeDebugLog
+                        ( "failed to update source map with "
+                            <> T.pack filepath
+                            <> ": "
+                            <> T.pack (show err)
+                        )
+                        s
             Right contents -> do
                 let newSourceMap = Map.insert filepath contents s.sourceMap
-                pure s{sourceMap = newSourceMap}
+                let logMsg = "updated source map with " <> T.pack filepath
+                pure (writeDebugLog logMsg s{sourceMap = newSourceMap})
 
 listAvailableSources :: AppState n -> [(T.Text, FilePath)]
 listAvailableSources = Loc.moduleFileMapAssocs . Daemon.moduleFileMap . interpState
 
 -- | Return the potential contents of the current paused file location.
 getSourceContents :: AppState n -> Maybe T.Text
-getSourceContents s = s.selectedFile >>= (s.sourceMap Map.!?)
+getSourceContents s = selectedFile s >>= (sourceMap s Map.!?)
 
 {- | Return the number of lines in the current source viewer.
      Returns Nothing if there's no currently viewed source.
@@ -202,6 +218,13 @@ changeReplWidgetSize amnt s =
         (Util.clamp (1, 80) (getReplHeight s + amnt))
         s
 
+changeSelectedModuleInInfoPanel :: Int -> AppState n -> AppState n
+changeSelectedModuleInInfoPanel amnt s =
+    s{_infoPanelSelectedModule = _infoPanelSelectedModule s + amnt}
+
+getSelectedModuleInInfoPanel :: AppState n -> Int
+getSelectedModuleInInfoPanel = _infoPanelSelectedModule
+
 -- | Return the info box's desired width in character columns.
 getInfoWidth :: AppState n -> Int
 getInfoWidth = _wsInfoWidth . _currentWidgetSizes
@@ -210,6 +233,14 @@ getInfoWidth = _wsInfoWidth . _currentWidgetSizes
 getReplHeight :: AppState n -> Int
 getReplHeight = _wsReplHeight . _currentWidgetSizes
 
+filePathOfInfoSelectedModule :: AppState n -> Maybe FilePath
+filePathOfInfoSelectedModule AppState{interpState, _infoPanelSelectedModule} =
+    fmap snd
+        . flip atMay _infoPanelSelectedModule
+        . Loc.moduleFileMapAssocs
+        . Daemon.moduleFileMap
+        $ interpState
+
 -- | Initialise the state from the config.
 makeInitialState
     :: AppConfig
@@ -253,6 +284,7 @@ makeInitialState appConfig target cwd = do
             , interpLogs = mempty
             , selectedFile
             , selectedLine = 1
+            , _infoPanelSelectedModule = 0
             , sourceMap = mempty
             , _currentWidgetSizes =
                 WidgetSizes

app/AppTopLevel.hs

@@ -7,4 +7,7 @@ data AppName
     | CodeViewportLine Int
     | LiveInterpreter
     | LiveInterpreterViewport
+    | BindingViewport
+    | ModulesViewport
+    | TraceViewport
     deriving (Eq, Show, Ord)

app/BrickUI.hs

@@ -12,6 +12,7 @@ import qualified Brick.Widgets.Center as B
 import Brick.Widgets.Core ((<+>), (<=>))
 import qualified Brick.Widgets.Edit as BE
 import Control.Error (headMay)
+import Data.Bifunctor (second)
 import Data.Maybe (fromMaybe)
 import qualified Data.Text as T
 import qualified Graphics.Vty as V
@@ -118,54 +119,94 @@ appDraw s =
                         $ logDisplay
             else B.emptyWidget
 
+-- | Draw the info panel.
 infoBox :: AppS -> B.Widget AppName
 infoBox appState =
-    B.borderWithLabel (B.txt "Info")
+    B.borderWithLabel infoLabel
         . B.hLimit (AppState.getInfoWidth appState)
         . B.padRight B.Max
         . B.padBottom B.Max
         $ bindingBox
-            <=> B.hBorderWithLabel (B.txt "Modules")
+            <=> B.hBorderWithLabel modulesLabel
             <=> moduleBox
             <=> B.hBorderWithLabel (B.txt "Trace History")
-            <=> traceBox
+            <=> drawTraceBox appState
   where
-    wrapSettings =
-        Wrap.defaultWrapSettings
-            { Wrap.preserveIndentation = True
-            , Wrap.breakLongWords = True
-            , Wrap.fillStrategy = Wrap.FillIndent 2
-            }
+    isActive = activeWindow appState == ActiveInfoWindow
+    infoLabel = B.txt "Info"
+    modulesLabel =
+        markLabel
+            isActive
+            "Modules"
+            (if activeWindow appState /= ActiveLiveInterpreter then "[M]" else mempty)
     intState = interpState appState
 
     bindingBox :: B.Widget AppName
-    bindingBox = case NameBinding.renderNamesTxt <$> Daemon.bindings intState of
-        Left _ -> B.txt "<Error displaying bindings>"
-        Right [] -> B.txt " " -- Can't be an empty widget due to padding?
-        Right bs -> B.vBox (B.txtWrapWith wrapSettings <$> bs)
+    bindingBox = B.viewport BindingViewport B.Vertical contents
+      where
+        contents = case NameBinding.renderNamesTxt <$> Daemon.bindings intState of
+            Left _ -> B.txt "<Error displaying bindings>"
+            Right [] -> B.txt " " -- Can't be an empty widget due to padding?
+            Right bs -> B.vBox (B.txtWrapWith wrapSettings <$> bs)
+        wrapSettings =
+            Wrap.defaultWrapSettings
+                { Wrap.preserveIndentation = True
+                , Wrap.breakLongWords = True
+                , Wrap.fillStrategy = Wrap.FillIndent 2
+                }
 
     moduleBox :: B.Widget AppName
     moduleBox =
-        if null mfmAssocs
-            then B.txt "<No module mappings>"
-            else foldr1 (<=>) (mkModEntryWidget <$> mfmAssocs)
+        B.cached ModulesViewport $
+            if null mfmAssocs
+                then B.hCenter $ B.txt "<No module mappings>"
+                else
+                    B.withVScrollBars B.OnRight
+                        . B.viewport ModulesViewport B.Vertical
+                        $ B.vBox moduleEntries
       where
         mfmAssocs = Loc.moduleFileMapAssocs (Daemon.moduleFileMap intState)
-        mkModEntryWidget (modName, fp) = B.txt (modName <> " > " <> T.pack fp)
+        moduleEntries =
+            (\(idx, t) -> highlightSelectedModWidget (isSelected idx && isActive) t)
+                . second mkModEntryWidget
+                <$> zip [0 ..] mfmAssocs
+          where
+            mkModEntryWidget (modName, fp) = B.txt (modName <> " = " <> T.pack fp)
+            isSelected idx = AppState.getSelectedModuleInInfoPanel appState == idx
 
-    traceBox :: B.Widget AppName
-    traceBox =
+            highlightSelectedModWidget :: Bool -> B.Widget n -> B.Widget n
+            highlightSelectedModWidget cond modW =
+                if cond
+                    then
+                        B.visible
+                            . B.withAttr (B.attrName "selected-marker")
+                            $ (B.txt "> " <+> modW)
+                    else B.txt "  " <+> modW
+
+-- | Draw the trace box in the info panel.
+drawTraceBox :: AppState AppName -> B.Widget AppName
+drawTraceBox s = contents
+  where
+    contents =
         if null traceHist
             then B.txt "<No trace>"
             else B.vBox $ B.txt <$> traceHist
-      where
-        traceHist :: [T.Text]
-        traceHist = Daemon.traceHist intState
+    traceHist :: [T.Text]
+    traceHist = Daemon.traceHist (AppState.interpState s)
 
 -- | Mark the label if the first arg is True.
-markLabel :: Bool -> T.Text -> B.Widget a
-markLabel False labelTxt = B.txt (labelTxt <> " [Ctrl+x]")
-markLabel True labelTxt =
+markLabel
+    :: Bool
+    -- ^ Conditional to mark with.
+    -> T.Text
+    -- ^ Text to use for the label.
+    -> T.Text
+    -- ^ Addendum unfocused text.
+    -> B.Widget a
+markLabel False labelTxt focus = B.txt . appendFocusButton $ labelTxt
+  where
+    appendFocusButton t = if focus == mempty then t else t <> " " <> focus
+markLabel True labelTxt _ =
     B.withAttr (B.attrName "highlight") (B.txt ("#> " <> labelTxt <> " <#"))
 
 -- | Information used to compute the gutter status of each line.

app/Events.hs

@@ -25,12 +25,54 @@ import Util (showT)
 
 -- | Handle any Brick event and update the state.
 handleEvent :: B.BrickEvent AppName e -> B.EventM AppName (AppState AppName) ()
+handleEvent (B.VtyEvent (V.EvResize _ _)) = B.invalidateCache
 handleEvent ev = do
     appState <- B.get
     case appState.activeWindow of
         ActiveCodeViewport -> handleViewportEvent ev
         ActiveLiveInterpreter -> handleInterpreterEvent ev
+-- -------------------------------------------------------------------------------------------------
+-- Info Event Handling
+----------------------------------------------------------------------------------------------------
+
+handleInfoEvent :: B.BrickEvent AppName e -> B.EventM AppName (AppState AppName) ()
+handleInfoEvent ev = do
+    appState <- B.get
+    case ev of
+        B.VtyEvent (V.EvKey key _ms)
+            | key `elem` [V.KChar 'j', V.KDown] -> do
+                B.put $ AppState.changeSelectedModuleInInfoPanel 1 appState
+            | key `elem` [V.KChar 'k', V.KUp] -> do
+                B.put $ AppState.changeSelectedModuleInInfoPanel (-1) appState
+            | key == V.KEnter || key == V.KChar 'o' -> do
+                let mayFp = AppState.filePathOfInfoSelectedModule appState
+                case mayFp of
+                    Just _ -> do
+                        updatedState <-
+                            liftIO
+                                ( AppState.updateSourceMap
+                                    appState
+                                        { selectedFile = mayFp
+                                        , selectedLine = 1
+                                        }
+                                )
+                        B.put updatedState
+                        invalidateLineCache
+                    Nothing -> pure ()
+            | key == V.KEsc || key == V.KChar 'C' -> do
+                B.put appState{activeWindow = ActiveCodeViewport}
+        B.VtyEvent (V.EvKey (V.KChar 'x') [V.MCtrl]) -> do
+            B.put appState{activeWindow = ActiveLiveInterpreter}
+        B.VtyEvent (V.EvKey (V.KChar '?') _) -> do
+            B.put appState{activeWindow = ActiveDialogHelp}
+
+        -- Resizing
+        B.VtyEvent (V.EvKey (V.KChar '-') []) -> do
+            B.put (AppState.changeInfoWidgetSize (-1) appState)
+        B.VtyEvent (V.EvKey (V.KChar '+') []) -> do
+            B.put (AppState.changeInfoWidgetSize 1 appState)
         _ -> pure ()
+    B.invalidateCacheEntry ModulesViewport
 
 -- -------------------------------------------------------------------------------------------------
 -- Interpreter Event Handling
@@ -204,10 +246,12 @@ handleViewportEvent (B.VtyEvent (V.EvKey key ms))
     -- '+' and '-' move the middle border.
     | key == V.KChar '+' && null ms = do
         appState <- B.get
-        B.put (AppState.changeInfoWidgetSize 1 appState)
+        B.put (AppState.changeInfoWidgetSize (-1) appState)
+        B.invalidateCacheEntry ModulesViewport
     | key == V.KChar '-' && null ms = do
         appState <- B.get
-        B.put (AppState.changeInfoWidgetSize (-1) appState)
+        B.put (AppState.changeInfoWidgetSize 1 appState)
+        B.invalidateCacheEntry ModulesViewport
     | key == V.KPageDown = do
         appState <- B.get
         mViewport <- B.lookupViewport CodeViewport
@@ -240,6 +284,10 @@ handleViewportEvent (B.VtyEvent (V.EvKey key ms))
         B.vScrollPage scroller B.Up
     | key == V.KChar 'x' && ms == [V.MCtrl] =
         B.put . toggleActiveLineInterpreter =<< B.get
+    | key == V.KChar 'M' = do
+        appState <- B.get
+        B.put appState{activeWindow = ActiveInfoWindow}
+        B.invalidateCacheEntry ModulesViewport
 handleViewportEvent _ = pure ()
 
 moveSelectedLineBy :: Int -> B.EventM AppName (AppState n) ()