mirror of
https://github.com/CrystalSplitter/ghcitui.git
synced 2024-09-11 10:55:29 +03:00
Add module panel event handling/opening
This adds the new feature of being able to access the Modules panel
This commit is contained in:
parent
9b632cb00d
commit
53c3be7c9a
@ -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
|
||||
|
@ -7,4 +7,7 @@ data AppName
|
||||
| CodeViewportLine Int
|
||||
| LiveInterpreter
|
||||
| LiveInterpreterViewport
|
||||
| BindingViewport
|
||||
| ModulesViewport
|
||||
| TraceViewport
|
||||
deriving (Eq, Show, Ord)
|
||||
|
@ -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.
|
||||
|
@ -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) ()
|
||||
|
Loading…
Reference in New Issue
Block a user