Reorganise modules to create the Ghcitui.Brick module

This commit is contained in:
CrystalSplitter 2024-01-19 01:27:45 -08:00 committed by Jordan R AW
parent ec7737ab16
commit 9f2bb3c45b
12 changed files with 100 additions and 87 deletions

View File

@ -10,8 +10,7 @@ import Control.Applicative (many)
import qualified Data.Text as T
import qualified Options.Applicative as Opt
import qualified AppConfig
import BrickUI (launchBrick)
import qualified Ghcitui.Brick as GB
-- | Holds passed in command line options.
data CmdOptions = CmdOptions
@ -85,16 +84,16 @@ main = do
putStrLn $ programName <> " " <> programVersion
else do
let conf =
AppConfig.defaultConfig
{ AppConfig.getDebugConsoleOnStart = debugConsole opts
, AppConfig.getVerbosity = verbosity opts
, AppConfig.getDebugLogPath = debugLogPath opts
, AppConfig.getCmd =
GB.defaultConfig
{ GB.getDebugConsoleOnStart = debugConsole opts
, GB.getVerbosity = verbosity opts
, GB.getDebugLogPath = debugLogPath opts
, GB.getCmd =
if T.null $ cmd opts
then AppConfig.getCmd AppConfig.defaultConfig
then GB.getCmd GB.defaultConfig
else cmd opts
}
launchBrick conf (target opts) (workdir opts)
GB.launchBrick conf (target opts) (workdir opts)
where
programName = "ghcitui"
programDescription = Opt.progDesc (programName <> ": A TUI interface for GHCi")

View File

@ -39,34 +39,13 @@ source-repository head
executable ghcitui
main-is: Main.hs
build-depends: base >= 4.17 && < 5
, brick >= 2.2 && < 2.4
, containers >= 0.6.7 && < 0.8
, errors ^>= 2.3.0
, file-embed ^>= 0.0.15
build-depends: base
, ghcitui-brick
, ghcitui-core
, microlens ^>= 0.4.13.1
, microlens-th ^>= 0.4.3.14
, optparse-applicative ^>= 0.18.1.0
, safe ^>= 0.3.19
, text ^>= 2.0.2
, text-zipper ^>= 0.13
, vector ^>= 0.13.1.0
, vty >= 5.38 && < 6.1
, word-wrap ^>= 0.5
, ghcitui
, text
hs-source-dirs: app
other-modules: BrickUI
, AppConfig
, AppInterpState
, AppState
, AppTopLevel
, DrawSourceViewer
, Events
, HelpText
-- Cabal autogen module for package version info.
, Paths_ghcitui
, SplashTextEmbed
other-modules: Paths_ghcitui
autogen-modules: Paths_ghcitui
ghc-options: -rtsopts
-threaded
@ -76,16 +55,11 @@ executable ghcitui
-Wpartial-fields
-Wredundant-constraints
default-language: Haskell2010
default-extensions: DuplicateRecordFields
LambdaCase
MonoLocalBinds
NamedFieldPuns
OverloadedRecordDot
default-extensions: MonoLocalBinds
OverloadedStrings
RecordWildCards
TupleSections
library ghcitui-core
library
hs-source-dirs: lib/ghcitui-core
build-depends: base >= 4.17 && < 5
, array ^>= 0.5.4.0
@ -125,28 +99,49 @@ library ghcitui-brick
, brick >= 2.2 && < 2.4
, containers >= 0.6.7 && < 0.8
, errors ^>= 2.3.0
, ghcitui-core
, file-embed ^>= 0.0.15
, ghcitui
, microlens ^>= 0.4.13.1
, microlens-th ^>= 0.4.3.14
, safe ^>= 0.3.19
, text ^>= 2.0.2
, text-zipper ^>= 0.13
, vector ^>= 0.13.1.0
exposed-modules: Ghcitui.Brick.SourceWindow
, vty >= 5.38 && < 6.1
, word-wrap ^>= 0.5
exposed-modules: Ghcitui.Brick
other-modules: Ghcitui.Brick.AppConfig
, Ghcitui.Brick.AppInterpState
, Ghcitui.Brick.AppState
, Ghcitui.Brick.AppTopLevel
, Ghcitui.Brick.BrickUI
, Ghcitui.Brick.DrawSourceViewer
, Ghcitui.Brick.Events
, Ghcitui.Brick.HelpText
, Ghcitui.Brick.SourceWindow
, Ghcitui.Brick.SplashTextEmbed
ghc-options: -Wall
-Wcompat
-Wincomplete-record-updates
-Wpartial-fields
-Wredundant-constraints
default-language: Haskell2010
default-extensions: OverloadedStrings
default-extensions: DuplicateRecordFields
LambdaCase
MonoLocalBinds
NamedFieldPuns
OverloadedRecordDot
OverloadedStrings
RecordWildCards
TupleSections
test-suite spec
hs-source-dirs: test
main-is: Spec.hs
type: exitcode-stdio-1.0
build-depends: base >= 4.17 && < 5
, ghcitui-core
, ghcitui
, hspec ^>= 2.11.5
other-modules: LocSpec
, UtilSpec

View File

@ -0,0 +1,10 @@
module Ghcitui.Brick
( -- * Configuration settings for the BrickUI
module Ghcitui.Brick.AppConfig
-- * Display BrickUI
, module Ghcitui.Brick.BrickUI
) where
import Ghcitui.Brick.AppConfig
import Ghcitui.Brick.BrickUI

View File

@ -1,13 +1,19 @@
{-# LANGUAGE OverloadedStrings #-}
module AppConfig (AppConfig (..), defaultConfig, loadStartupSplash, userConfigDir) where
module Ghcitui.Brick.AppConfig
( AppConfig (..)
, defaultConfig
, loadStartupSplash
, userConfigDir
)
where
import Data.Maybe (fromMaybe)
import Data.String (IsString)
import qualified Data.Text as T
import System.Environment (lookupEnv)
import qualified SplashTextEmbed
import qualified Ghcitui.Brick.SplashTextEmbed as SplashTextEmbed
userConfigDir :: IO FilePath
userConfigDir = fromMaybe (error errorMsg) <$> result

View File

@ -1,4 +1,6 @@
module AppInterpState
{-# LANGUAGE RecordWildCards #-}
module Ghcitui.Brick.AppInterpState
( AppInterpState (_liveEditor, _viewLock, _commandBuffer, historyPos)
, commandBuffer
, emptyAppInterpState

View File

@ -1,6 +1,6 @@
{-# LANGUAGE NamedFieldPuns #-}
module AppState
module Ghcitui.Brick.AppState
( ActiveWindow (..)
, AppConfig (..)
, AppState (..)
@ -41,9 +41,10 @@ import qualified Data.Vector as Vec
import Lens.Micro ((^.))
import qualified Lens.Micro as Lens
import AppConfig (AppConfig (..), loadStartupSplash)
import qualified AppInterpState as AIS
import AppTopLevel (AppName (..))
import Ghcitui.Brick.AppConfig (AppConfig (..))
import qualified Ghcitui.Brick.AppConfig as AppConfig
import qualified Ghcitui.Brick.AppInterpState as AIS
import Ghcitui.Brick.AppTopLevel (AppName (..))
import qualified Ghcitui.Brick.SourceWindow as SourceWindow
import Ghcitui.Ghcid.Daemon (toggleBreakpointLine)
@ -303,7 +304,7 @@ makeInitialState appConfig target cwd = do
Daemon.run (Daemon.startup (T.unpack fullCmd) cwd' startupConfig) >>= \case
Right iState -> pure iState
Left er -> error (show er)
splashContents <- loadStartupSplash appConfig
splashContents <- AppConfig.loadStartupSplash appConfig
let selectedFile' =
case Loc.moduleFileMapAssocs (Daemon.moduleFileMap interpState) of
-- If we just have one file, select that.

View File

@ -1,4 +1,4 @@
module AppTopLevel (AppName (..)) where
module Ghcitui.Brick.AppTopLevel (AppName (..)) where
-- | Unique identifiers for components of the App.
data AppName

View File

@ -1,6 +1,6 @@
{-# LANGUAGE OverloadedStrings #-}
module BrickUI
module Ghcitui.Brick.BrickUI
( launchBrick
, AppState (..)
) where
@ -18,25 +18,25 @@ import qualified Graphics.Vty as V
import Lens.Micro ((&), (^.))
import qualified Text.Wrap as Wrap
import qualified AppConfig
import qualified AppInterpState as AIS
import AppState
import qualified Ghcitui.Brick.AppConfig as AppConfig
import qualified Ghcitui.Brick.AppInterpState as AIS
import Ghcitui.Brick.AppState
( ActiveWindow (..)
, AppState (..)
, appInterpState
, liveEditor
, makeInitialState
)
import qualified AppState
import AppTopLevel (AppName (..))
import qualified DrawSourceViewer
import qualified Events
import qualified Ghcitui.Brick.AppState as AppState
import Ghcitui.Brick.AppTopLevel (AppName (..))
import qualified Ghcitui.Brick.DrawSourceViewer as DrawSourceViewer
import qualified Ghcitui.Brick.Events as Events
import qualified Ghcitui.Brick.HelpText as HelpText
import qualified Ghcitui.Brick.SourceWindow as SourceWindow
import qualified Ghcitui.Ghcid.Daemon as Daemon
import qualified Ghcitui.Loc as Loc
import qualified Ghcitui.NameBinding as NameBinding
import qualified Ghcitui.Util as Util
import qualified HelpText
-- | Alias for 'AppState AppName' convenience.
type AppS = AppState AppName

View File

@ -1,6 +1,6 @@
{-# LANGUAGE NamedFieldPuns #-}
module DrawSourceViewer (drawSourceViewer) where
module Ghcitui.Brick.DrawSourceViewer (drawSourceViewer) where
import qualified Brick as B
import qualified Brick.Widgets.Center as B
@ -13,9 +13,9 @@ import qualified Data.Vector as Vec
import qualified Graphics.Vty as V
import Lens.Micro ((^.))
import AppState (AppState)
import qualified AppState
import AppTopLevel (AppName (..))
import Ghcitui.Brick.AppState (AppState)
import qualified Ghcitui.Brick.AppState as AppState
import Ghcitui.Brick.AppTopLevel (AppName (..))
import qualified Ghcitui.Brick.SourceWindow as SourceWindow
import qualified Ghcitui.Ghcid.Daemon as Daemon
import qualified Ghcitui.Loc as Loc

View File

@ -1,7 +1,7 @@
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE NamedFieldPuns #-}
module Events (handleEvent, handleCursorPosition) where
module Ghcitui.Brick.Events (handleEvent, handleCursorPosition) where
import qualified Brick.Main as B
import qualified Brick.Types as B
@ -14,9 +14,9 @@ import qualified Graphics.Vty as V
import Lens.Micro ((^.))
import qualified Lens.Micro as Lens
import qualified AppInterpState as AIS
import AppState
import AppTopLevel
import qualified Ghcitui.Brick.AppInterpState as AIS
import Ghcitui.Brick.AppState as AppState
import Ghcitui.Brick.AppTopLevel
( AppName (..)
)
import qualified Ghcitui.Brick.SourceWindow as SourceWindow
@ -32,11 +32,11 @@ handleEvent ev = do
updatedSourceWindow <- SourceWindow.updateSrcWindowEnd (appState ^. AppState.sourceWindow)
let appStateUpdated = Lens.set AppState.sourceWindow updatedSourceWindow appState
let handler = case appStateUpdated.activeWindow of
ActiveCodeViewport -> handleSrcWindowEvent
ActiveLiveInterpreter -> handleInterpreterEvent
ActiveInfoWindow -> handleInfoEvent
ActiveDialogQuit -> handleDialogQuit
ActiveDialogHelp -> handleDialogHelp
AppState.ActiveCodeViewport -> handleSrcWindowEvent
AppState.ActiveLiveInterpreter -> handleInterpreterEvent
AppState.ActiveInfoWindow -> handleInfoEvent
AppState.ActiveDialogQuit -> handleDialogQuit
AppState.ActiveDialogHelp -> handleDialogHelp
handler ev
-- -------------------------------------------------------------------------------------------------
@ -61,11 +61,11 @@ handleInfoEvent ev = do
invalidateLineCache
Nothing -> pure ()
| key == V.KEsc || key == V.KChar 'C' -> do
B.put appState{activeWindow = ActiveCodeViewport}
B.put appState{activeWindow = AppState.ActiveCodeViewport}
B.VtyEvent (V.EvKey (V.KChar 'x') [V.MCtrl]) -> do
B.put appState{activeWindow = ActiveLiveInterpreter}
B.put appState{activeWindow = AppState.ActiveLiveInterpreter}
B.VtyEvent (V.EvKey (V.KChar '?') _) -> do
B.put appState{activeWindow = ActiveDialogHelp}
B.put appState{activeWindow = AppState.ActiveDialogHelp}
-- Resizing
B.VtyEvent (V.EvKey (V.KChar '-') []) -> do
@ -270,9 +270,9 @@ handleSrcWindowEvent (B.VtyEvent (V.EvKey key ms))
B.put . toggleActiveLineInterpreter =<< B.get
| key == V.KChar 'M' = do
appState <- B.get
B.put appState{activeWindow = ActiveInfoWindow}
B.put appState{activeWindow = AppState.ActiveInfoWindow}
B.invalidateCacheEntry ModulesViewport
| key == V.KChar '?' = B.modify (\state -> state{activeWindow = ActiveDialogHelp})
| key == V.KChar '?' = B.modify (\state -> state{activeWindow = AppState.ActiveDialogHelp})
handleSrcWindowEvent _ = pure ()
moveSelectedLineby :: Int -> B.EventM AppName (AppState AppName) ()
@ -298,7 +298,7 @@ scrollPage dir = do
-- | Open up the quit dialog. See 'quit' for the actual quitting.
confirmQuit :: B.EventM AppName (AppState AppName) ()
confirmQuit = B.put . (\s -> s{activeWindow = ActiveDialogQuit}) =<< B.get
confirmQuit = B.put . (\s -> s{activeWindow = AppState.ActiveDialogQuit}) =<< B.get
invalidateCachedLine :: Int -> B.EventM AppName s ()
invalidateCachedLine lineno = B.invalidateCacheEntry (SourceWindowLine lineno)
@ -376,7 +376,7 @@ handleCursorPosition
-> Maybe (B.CursorLocation AppName)
-- ^ The chosen cursor location if any.
handleCursorPosition s ls =
if s.activeWindow == ActiveLiveInterpreter
if s.activeWindow == AppState.ActiveLiveInterpreter
then -- If we're in the interpreter window, show the cursor.
B.showCursorNamed widgetName ls
else -- No cursor
@ -413,7 +413,7 @@ handleDialogQuit ev = do
case ev of
(B.VtyEvent (V.EvKey key _))
| key == V.KChar 'q' || key == V.KEsc -> do
B.put $ appState{activeWindow = ActiveCodeViewport}
B.put $ appState{activeWindow = AppState.ActiveCodeViewport}
| key == V.KEnter -> quit appState
_ -> pure ()
pure ()
@ -422,7 +422,7 @@ handleDialogHelp :: B.BrickEvent AppName e -> B.EventM AppName (AppState AppName
handleDialogHelp (B.VtyEvent (V.EvKey key _))
| key == V.KChar 'q' || key == V.KEsc || key == V.KEnter = do
appState <- B.get
B.put $ appState{activeWindow = ActiveCodeViewport}
B.put $ appState{activeWindow = AppState.ActiveCodeViewport}
| key == V.KPageDown = B.vScrollPage scroller B.Down
| key == V.KPageUp = B.vScrollPage scroller B.Up
| key == V.KDown = B.vScrollBy scroller 1

View File

@ -1,6 +1,6 @@
{-# LANGUAGE TemplateHaskell #-}
module HelpText (helpText) where
module Ghcitui.Brick.HelpText (helpText) where
import Data.String (IsString)

View File

@ -1,6 +1,6 @@
{-# LANGUAGE TemplateHaskell #-}
module SplashTextEmbed (splashText) where
module Ghcitui.Brick.SplashTextEmbed (splashText) where
import Data.String (IsString)