{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
module Ghcitui.Brick.BrickUI
( launchBrick
, AppState (..)
) where
import qualified Brick as B
import qualified Brick.Widgets.Border as B
import qualified Brick.Widgets.Center as B
import Brick.Widgets.Core ((<+>), (<=>))
import qualified Brick.Widgets.Dialog as B
import qualified Brick.Widgets.Edit as BE
import Control.Error (headMay)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Graphics.Vty as V
import Lens.Micro ((&), (^.))
import qualified Text.Wrap as Wrap
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 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
type AppS = AppState AppName
appDraw :: AppS -> [B.Widget AppName]
appDraw :: AppS -> [Widget AppName]
appDraw AppS
s =
[ AppS -> Widget AppName
drawDialogLayer AppS
s
, AppS -> Widget AppName
drawBaseLayer AppS
s
]
dialogMaxWidth :: (Integral a) => a
dialogMaxWidth :: forall a. Integral a => a
dialogMaxWidth = a
94
drawDialogLayer :: AppS -> B.Widget AppName
drawDialogLayer :: AppS -> Widget AppName
drawDialogLayer AppState{$sel:activeWindow:AppState :: forall n. AppState n -> ActiveWindow
activeWindow = ActiveWindow
ActiveDialogQuit} =
AttrName -> Widget AppName -> Widget AppName
forall n. AttrName -> Widget n -> Widget n
B.withAttr (String -> AttrName
B.attrName String
"dialog") (Widget AppName -> Widget AppName)
-> Widget AppName -> Widget AppName
forall a b. (a -> b) -> a -> b
$ Dialog Any AppName -> Widget AppName -> Widget AppName
forall n a. Ord n => Dialog a n -> Widget n -> Widget n
B.renderDialog Dialog Any AppName
forall {a}. Dialog a AppName
dialogObj Widget AppName
forall {n}. Widget n
body
where
dialogObj :: Dialog a AppName
dialogObj = Maybe (Widget AppName)
-> Maybe (AppName, [(String, AppName, a)])
-> Int
-> Dialog a AppName
forall n a.
Eq n =>
Maybe (Widget n)
-> Maybe (n, [(String, n, a)]) -> Int -> Dialog a n
B.dialog (Widget AppName -> Maybe (Widget AppName)
forall a. a -> Maybe a
Just Widget AppName
forall {n}. Widget n
titleW) Maybe (AppName, [(String, AppName, a)])
forall a. Maybe a
Nothing Int
forall a. Integral a => a
dialogMaxWidth
titleW :: Widget n
titleW = Text -> Widget n
forall n. Text -> Widget n
B.txt Text
"Please don't go. The drones need you. They look up to you."
body :: Widget n
body =
Widget n -> Widget n
forall n. Widget n -> Widget n
B.hCenter
(Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
B.padAll Int
1 (Text -> Widget n
forall n. Text -> Widget n
B.txt Text
"Do you want to halt the current program and quit?"))
Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<=> Widget n -> Widget n
forall n. Widget n -> Widget n
B.hCenter (Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
B.padAll Int
1 (Text -> Widget n
forall n. Text -> Widget n
B.txt Text
"[Enter] -> QUIT" Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<=> Text -> Widget n
forall n. Text -> Widget n
B.txt Text
"[Esc/q] -> Go back"))
drawDialogLayer AppState{$sel:activeWindow:AppState :: forall n. AppState n -> ActiveWindow
activeWindow = ActiveWindow
ActiveDialogHelp} =
AttrName -> Widget AppName -> Widget AppName
forall n. AttrName -> Widget n -> Widget n
B.withAttr (String -> AttrName
B.attrName String
"dialog") (Widget AppName -> Widget AppName)
-> Widget AppName -> Widget AppName
forall a b. (a -> b) -> a -> b
$ Dialog Any AppName -> Widget AppName -> Widget AppName
forall n a. Ord n => Dialog a n -> Widget n -> Widget n
B.renderDialog Dialog Any AppName
forall {a}. Dialog a AppName
dialogObj Widget AppName
body
where
dialogObj :: Dialog a AppName
dialogObj = Maybe (Widget AppName)
-> Maybe (AppName, [(String, AppName, a)])
-> Int
-> Dialog a AppName
forall n a.
Eq n =>
Maybe (Widget n)
-> Maybe (n, [(String, n, a)]) -> Int -> Dialog a n
B.dialog (Widget AppName -> Maybe (Widget AppName)
forall a. a -> Maybe a
Just Widget AppName
forall {n}. Widget n
titleW) Maybe (AppName, [(String, AppName, a)])
forall a. Maybe a
Nothing Int
forall a. Integral a => a
dialogMaxWidth
titleW :: Widget n
titleW = Text -> Widget n
forall n. Text -> Widget n
B.txt Text
"Actually reading the manual, huh?"
body :: Widget AppName
body =
( Widget AppName -> Widget AppName
forall n. Widget n -> Widget n
B.hCenter
(Widget AppName -> Widget AppName)
-> (Widget AppName -> Widget AppName)
-> Widget AppName
-> Widget AppName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VScrollBarOrientation -> Widget AppName -> Widget AppName
forall n. VScrollBarOrientation -> Widget n -> Widget n
B.withVScrollBars VScrollBarOrientation
B.OnRight
(Widget AppName -> Widget AppName)
-> (Widget AppName -> Widget AppName)
-> Widget AppName
-> Widget AppName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppName -> ViewportType -> Widget AppName -> Widget AppName
forall n.
(Ord n, Show n) =>
n -> ViewportType -> Widget n -> Widget n
B.viewport AppName
HelpViewport ViewportType
B.Vertical
(Widget AppName -> Widget AppName)
-> Widget AppName -> Widget AppName
forall a b. (a -> b) -> a -> b
$ Int -> Widget AppName -> Widget AppName
forall n. Int -> Widget n -> Widget n
B.padAll Int
1 (Text -> Widget AppName
forall n. Text -> Widget n
B.txt Text
forall a. IsString a => a
HelpText.helpText)
)
Widget AppName -> Widget AppName -> Widget AppName
forall n. Widget n -> Widget n -> Widget n
<=> ( Widget AppName -> Widget AppName
forall n. Widget n -> Widget n
B.hCenter
(Widget AppName -> Widget AppName)
-> (Widget AppName -> Widget AppName)
-> Widget AppName
-> Widget AppName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Widget AppName -> Widget AppName
forall n. Int -> Widget n -> Widget n
B.padAll Int
1
(Widget AppName -> Widget AppName)
-> Widget AppName -> Widget AppName
forall a b. (a -> b) -> a -> b
$ Text -> Widget AppName
forall n. Text -> Widget n
B.txt Text
"[Esc/Enter/q] -> Go back"
)
drawDialogLayer AppS
_ = Widget AppName
forall {n}. Widget n
B.emptyWidget
drawBaseLayer :: AppS -> B.Widget AppName
drawBaseLayer :: AppS -> Widget AppName
drawBaseLayer AppS
s =
(Widget AppName
sourceWindowBox Widget AppName -> Widget AppName -> Widget AppName
forall n. Widget n -> Widget n -> Widget n
<=> Widget AppName
interpreterBox Widget AppName -> Widget AppName -> Widget AppName
forall n. Widget n -> Widget n -> Widget n
<=> Widget AppName
debugBox) Widget AppName -> Widget AppName -> Widget AppName
forall n. Widget n -> Widget n -> Widget n
<+> AppS -> Widget AppName
infoBox AppS
s
where
sourceLabel :: Widget AppName
sourceLabel =
Bool -> Text -> Text -> Widget AppName
forall a. Bool -> Text -> Text -> Widget a
markLabel
(AppS
s.activeWindow ActiveWindow -> ActiveWindow -> Bool
forall a. Eq a => a -> a -> Bool
== ActiveWindow
ActiveCodeViewport)
( Text
"Source: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> (String -> Text) -> Maybe String -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"?" String -> Text
T.pack (AppS -> Maybe String
forall n. AppState n -> Maybe String
AppState.selectedFile AppS
s)
)
Text
"[Esc]"
interpreterLabel :: Widget AppName
interpreterLabel =
Bool -> Text -> Text -> Widget AppName
forall a. Bool -> Text -> Text -> Widget a
markLabel
(AppS
s.activeWindow ActiveWindow -> ActiveWindow -> Bool
forall a. Eq a => a -> a -> Bool
== ActiveWindow
ActiveLiveInterpreter)
( if AppS
s AppS -> Getting Bool AppS Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (AppInterpState Text AppName
-> Const Bool (AppInterpState Text AppName))
-> AppS -> Const Bool AppS
forall n (f :: * -> *).
Functor f =>
(AppInterpState Text n -> f (AppInterpState Text n))
-> AppState n -> f (AppState n)
appInterpState ((AppInterpState Text AppName
-> Const Bool (AppInterpState Text AppName))
-> AppS -> Const Bool AppS)
-> ((Bool -> Const Bool Bool)
-> AppInterpState Text AppName
-> Const Bool (AppInterpState Text AppName))
-> Getting Bool AppS Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool)
-> AppInterpState Text AppName
-> Const Bool (AppInterpState Text AppName)
forall s n (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> AppInterpState s n -> f (AppInterpState s n)
AIS.viewLock
then Text
"GHCi"
else Text
"GHCi (Scrolling)"
)
Text
"[Ctrl+x]"
sourceWindowBox :: B.Widget AppName
sourceWindowBox :: Widget AppName
sourceWindowBox =
Widget AppName -> Widget AppName -> Widget AppName
forall n. Widget n -> Widget n -> Widget n
B.borderWithLabel Widget AppName
sourceLabel
(Widget AppName -> Widget AppName)
-> (Widget AppName -> Widget AppName)
-> Widget AppName
-> Widget AppName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Widget AppName -> Widget AppName
appendLastCommand
(Widget AppName -> Widget AppName)
-> (Widget AppName -> Widget AppName)
-> Widget AppName
-> Widget AppName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Padding -> Widget AppName -> Widget AppName
forall n. Padding -> Widget n -> Widget n
B.padRight Padding
B.Max
(Widget AppName -> Widget AppName)
-> (Widget AppName -> Widget AppName)
-> Widget AppName
-> Widget AppName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Padding -> Widget AppName -> Widget AppName
forall n. Padding -> Widget n -> Widget n
B.padBottom Padding
B.Max
(Widget AppName -> Widget AppName)
-> Widget AppName -> Widget AppName
forall a b. (a -> b) -> a -> b
$ AppS -> Widget AppName
DrawSourceViewer.drawSourceViewer AppS
s
where
appendLastCommand :: Widget AppName -> Widget AppName
appendLastCommand Widget AppName
w =
Padding -> Widget AppName -> Widget AppName
forall n. Padding -> Widget n -> Widget n
B.padBottom Padding
B.Max (Widget AppName
w Widget AppName -> Widget AppName -> Widget AppName
forall n. Widget n -> Widget n -> Widget n
<=> Widget AppName
forall {n}. Widget n
B.hBorder Widget AppName -> Widget AppName -> Widget AppName
forall n. Widget n -> Widget n -> Widget n
<=> (Widget AppName
lastCmdWidget Widget AppName -> Widget AppName -> Widget AppName
forall n. Widget n -> Widget n -> Widget n
<+> Widget AppName
lineNumRatioWidget))
where
selectedLine :: Int
selectedLine = AppS -> Int
forall n. AppState n -> Int
AppState.selectedLine AppS
s
totalLines :: Int
totalLines = AppS
s AppS
-> Getting
(SourceWindow AppName Text) AppS (SourceWindow AppName Text)
-> SourceWindow AppName Text
forall s a. s -> Getting a s a -> a
^. Getting
(SourceWindow AppName Text) AppS (SourceWindow AppName Text)
forall n (f :: * -> *).
Functor f =>
(SourceWindow n Text -> f (SourceWindow n Text))
-> AppState n -> f (AppState n)
AppState.sourceWindow SourceWindow AppName Text
-> (SourceWindow AppName Text -> Int) -> Int
forall a b. a -> (a -> b) -> b
& SourceWindow AppName Text -> Int
forall n e. SourceWindow n e -> Int
SourceWindow.srcWindowLength
percentageNum :: Int
percentageNum =
if Int
totalLines Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
then (Int
selectedLine Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
100) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
totalLines
else Int
0
lineNumRatioWidget :: Widget AppName
lineNumRatioWidget =
Text -> Widget AppName
forall n. Text -> Widget n
B.txt
( Int -> Text
forall a. Show a => a -> Text
Util.showT Int
selectedLine
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
Util.showT Int
totalLines
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"L ("
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
Util.showT Int
percentageNum
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"%)"
)
lastCmdWidget :: Widget AppName
lastCmdWidget =
Padding -> Widget AppName -> Widget AppName
forall n. Padding -> Widget n -> Widget n
B.padRight
Padding
B.Max
( case [Text] -> Maybe Text
forall a. [a] -> Maybe a
headMay (InterpState () -> [Text]
forall a. InterpState a -> [Text]
Daemon.execHist (AppS -> InterpState ()
forall n. AppState n -> InterpState ()
AppState.interpState AppS
s)) of
Just Text
h -> Text -> Widget AppName
forall n. Text -> Widget n
B.txt Text
h
Maybe Text
_ -> Text -> Widget AppName
forall n. Text -> Widget n
B.txt Text
" "
)
interpreterBox :: B.Widget AppName
interpreterBox :: Widget AppName
interpreterBox =
Widget AppName -> Widget AppName -> Widget AppName
forall n. Widget n -> Widget n -> Widget n
B.borderWithLabel Widget AppName
interpreterLabel
(Widget AppName -> Widget AppName)
-> (Widget AppName -> Widget AppName)
-> Widget AppName
-> Widget AppName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Widget AppName -> Widget AppName
forall n. Int -> Widget n -> Widget n
B.vLimit (AppS -> Int
forall n. AppState n -> Int
AppState.getReplHeight AppS
s)
(Widget AppName -> Widget AppName)
-> (Widget AppName -> Widget AppName)
-> Widget AppName
-> Widget AppName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VScrollBarOrientation -> Widget AppName -> Widget AppName
forall n. VScrollBarOrientation -> Widget n -> Widget n
B.withVScrollBars VScrollBarOrientation
B.OnRight
(Widget AppName -> Widget AppName)
-> (Widget AppName -> Widget AppName)
-> Widget AppName
-> Widget AppName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppName -> ViewportType -> Widget AppName -> Widget AppName
forall n.
(Ord n, Show n) =>
n -> ViewportType -> Widget n -> Widget n
B.viewport AppName
LiveInterpreterViewport ViewportType
B.Vertical
(Widget AppName -> Widget AppName)
-> Widget AppName -> Widget AppName
forall a b. (a -> b) -> a -> b
$ Widget AppName
previousOutput Widget AppName -> Widget AppName -> Widget AppName
forall n. Widget n -> Widget n -> Widget n
<=> Widget AppName -> Widget AppName
lockToBottomOnViewLock Widget AppName
promptLine
where
enableCursor :: Bool
enableCursor = Bool
True
previousOutput :: Widget AppName
previousOutput =
if [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null AppS
s.interpLogs
then Widget AppName
forall {n}. Widget n
B.emptyWidget
else
Text -> Widget AppName
forall n. Text -> Widget n
B.txt
(Text -> Widget AppName)
-> ([Text] -> Text) -> [Text] -> Widget AppName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines
([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
forall a. [a] -> [a]
reverse
([Text] -> Widget AppName) -> [Text] -> Widget AppName
forall a b. (a -> b) -> a -> b
$ AppS
s.interpLogs
promptLine :: B.Widget AppName
promptLine :: Widget AppName
promptLine =
Text -> Widget AppName
forall n. Text -> Widget n
B.txt (AppConfig -> Text
AppConfig.getInterpreterPrompt (AppConfig -> Text) -> (AppS -> AppConfig) -> AppS -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppS -> AppConfig
forall n. AppState n -> AppConfig
AppState.appConfig (AppS -> Text) -> AppS -> Text
forall a b. (a -> b) -> a -> b
$ AppS
s)
Widget AppName -> Widget AppName -> Widget AppName
forall n. Widget n -> Widget n -> Widget n
<+> ([Text] -> Widget AppName)
-> Bool -> Editor Text AppName -> Widget AppName
forall n t.
(Ord n, Show n, Monoid t, TextWidth t, GenericTextZipper t) =>
([t] -> Widget n) -> Bool -> Editor t n -> Widget n
BE.renderEditor [Text] -> Widget AppName
displayF Bool
enableCursor (AppS
s AppS
-> Getting (Editor Text AppName) AppS (Editor Text AppName)
-> Editor Text AppName
forall s a. s -> Getting a s a -> a
^. Getting (Editor Text AppName) AppS (Editor Text AppName)
forall n (f :: * -> *).
Functor f =>
(Editor Text n -> f (Editor Text n))
-> AppState n -> f (AppState n)
liveEditor)
where
displayF :: [T.Text] -> B.Widget AppName
displayF :: [Text] -> Widget AppName
displayF [Text]
t = [Widget AppName] -> Widget AppName
forall n. [Widget n] -> Widget n
B.vBox ([Widget AppName] -> Widget AppName)
-> [Widget AppName] -> Widget AppName
forall a b. (a -> b) -> a -> b
$ Text -> Widget AppName
forall n. Text -> Widget n
B.txt (Text -> Widget AppName) -> [Text] -> [Widget AppName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
t
lockToBottomOnViewLock :: Widget AppName -> Widget AppName
lockToBottomOnViewLock Widget AppName
w =
if AppS
s AppS -> Getting Bool AppS Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (AppInterpState Text AppName
-> Const Bool (AppInterpState Text AppName))
-> AppS -> Const Bool AppS
forall n (f :: * -> *).
Functor f =>
(AppInterpState Text n -> f (AppInterpState Text n))
-> AppState n -> f (AppState n)
appInterpState ((AppInterpState Text AppName
-> Const Bool (AppInterpState Text AppName))
-> AppS -> Const Bool AppS)
-> ((Bool -> Const Bool Bool)
-> AppInterpState Text AppName
-> Const Bool (AppInterpState Text AppName))
-> Getting Bool AppS Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool)
-> AppInterpState Text AppName
-> Const Bool (AppInterpState Text AppName)
forall s n (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> AppInterpState s n -> f (AppInterpState s n)
AIS.viewLock
then Widget AppName -> Widget AppName
forall n. Widget n -> Widget n
B.visible Widget AppName
w
else Widget AppName
w
debugBox :: Widget AppName
debugBox =
if AppS
s.displayDebugConsoleLogs
then
let logDisplay :: [Text]
logDisplay =
if [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null AppS
s.debugConsoleLogs then [Text
" "] else AppS
s.debugConsoleLogs
applyVisTo :: [Widget n] -> [Widget n]
applyVisTo (Widget n
x : [Widget n]
xs) = Widget n -> Widget n
forall n. Widget n -> Widget n
B.visible Widget n
x Widget n -> [Widget n] -> [Widget n]
forall a. a -> [a] -> [a]
: [Widget n]
xs
applyVisTo [] = []
in Widget AppName -> Widget AppName -> Widget AppName
forall n. Widget n -> Widget n -> Widget n
B.borderWithLabel (Text -> Widget AppName
forall n. Text -> Widget n
B.txt Text
"Debug")
(Widget AppName -> Widget AppName)
-> ([Widget AppName] -> Widget AppName)
-> [Widget AppName]
-> Widget AppName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Widget AppName -> Widget AppName
forall n. Int -> Widget n -> Widget n
B.vLimit Int
10
(Widget AppName -> Widget AppName)
-> ([Widget AppName] -> Widget AppName)
-> [Widget AppName]
-> Widget AppName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VScrollBarOrientation -> Widget AppName -> Widget AppName
forall n. VScrollBarOrientation -> Widget n -> Widget n
B.withVScrollBars VScrollBarOrientation
B.OnRight
(Widget AppName -> Widget AppName)
-> ([Widget AppName] -> Widget AppName)
-> [Widget AppName]
-> Widget AppName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppName -> ViewportType -> Widget AppName -> Widget AppName
forall n.
(Ord n, Show n) =>
n -> ViewportType -> Widget n -> Widget n
B.viewport AppName
DebugPanel ViewportType
B.Vertical
(Widget AppName -> Widget AppName)
-> ([Widget AppName] -> Widget AppName)
-> [Widget AppName]
-> Widget AppName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Padding -> Widget AppName -> Widget AppName
forall n. Padding -> Widget n -> Widget n
B.padRight Padding
B.Max
(Widget AppName -> Widget AppName)
-> ([Widget AppName] -> Widget AppName)
-> [Widget AppName]
-> Widget AppName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Widget AppName] -> Widget AppName
forall n. [Widget n] -> Widget n
B.vBox
([Widget AppName] -> Widget AppName)
-> ([Widget AppName] -> [Widget AppName])
-> [Widget AppName]
-> Widget AppName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Widget AppName] -> [Widget AppName]
forall a. [a] -> [a]
reverse
([Widget AppName] -> [Widget AppName])
-> ([Widget AppName] -> [Widget AppName])
-> [Widget AppName]
-> [Widget AppName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Widget AppName] -> [Widget AppName]
forall {n}. [Widget n] -> [Widget n]
applyVisTo
([Widget AppName] -> Widget AppName)
-> [Widget AppName] -> Widget AppName
forall a b. (a -> b) -> a -> b
$ (Text -> Widget AppName
forall n. Text -> Widget n
B.txt (Text -> Widget AppName) -> [Text] -> [Widget AppName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
logDisplay)
else Widget AppName
forall {n}. Widget n
B.emptyWidget
infoBox :: AppS -> B.Widget AppName
infoBox :: AppS -> Widget AppName
infoBox AppS
appState =
Widget AppName -> Widget AppName -> Widget AppName
forall n. Widget n -> Widget n -> Widget n
B.borderWithLabel Widget AppName
forall {n}. Widget n
infoLabel
(Widget AppName -> Widget AppName)
-> (Widget AppName -> Widget AppName)
-> Widget AppName
-> Widget AppName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Widget AppName -> Widget AppName
forall n. Int -> Widget n -> Widget n
B.hLimit (AppS -> Int
forall n. AppState n -> Int
AppState.getInfoWidth AppS
appState)
(Widget AppName -> Widget AppName)
-> (Widget AppName -> Widget AppName)
-> Widget AppName
-> Widget AppName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Padding -> Widget AppName -> Widget AppName
forall n. Padding -> Widget n -> Widget n
B.padRight Padding
B.Max
(Widget AppName -> Widget AppName)
-> (Widget AppName -> Widget AppName)
-> Widget AppName
-> Widget AppName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Padding -> Widget AppName -> Widget AppName
forall n. Padding -> Widget n -> Widget n
B.padBottom Padding
B.Max
(Widget AppName -> Widget AppName)
-> Widget AppName -> Widget AppName
forall a b. (a -> b) -> a -> b
$ Widget AppName
bindingBox
Widget AppName -> Widget AppName -> Widget AppName
forall n. Widget n -> Widget n -> Widget n
<=> Widget AppName -> Widget AppName
forall n. Widget n -> Widget n
B.hBorderWithLabel Widget AppName
modulesLabel
Widget AppName -> Widget AppName -> Widget AppName
forall n. Widget n -> Widget n -> Widget n
<=> AppS -> Widget AppName
moduleBox AppS
appState
Widget AppName -> Widget AppName -> Widget AppName
forall n. Widget n -> Widget n -> Widget n
<=> Widget AppName -> Widget AppName
forall n. Widget n -> Widget n
B.hBorderWithLabel (Text -> Widget AppName
forall n. Text -> Widget n
B.txt Text
"Trace History")
Widget AppName -> Widget AppName -> Widget AppName
forall n. Widget n -> Widget n -> Widget n
<=> AppS -> Widget AppName
drawTraceBox AppS
appState
where
isActive :: Bool
isActive = AppS -> ActiveWindow
forall n. AppState n -> ActiveWindow
activeWindow AppS
appState ActiveWindow -> ActiveWindow -> Bool
forall a. Eq a => a -> a -> Bool
== ActiveWindow
ActiveInfoWindow
infoLabel :: Widget n
infoLabel = Text -> Widget n
forall n. Text -> Widget n
B.txt Text
"Info"
modulesLabel :: Widget AppName
modulesLabel =
Bool -> Text -> Text -> Widget AppName
forall a. Bool -> Text -> Text -> Widget a
markLabel
Bool
isActive
Text
"Modules"
(if AppS -> ActiveWindow
forall n. AppState n -> ActiveWindow
activeWindow AppS
appState ActiveWindow -> ActiveWindow -> Bool
forall a. Eq a => a -> a -> Bool
/= ActiveWindow
ActiveLiveInterpreter then Text
"[M]" else Text
forall a. Monoid a => a
mempty)
intState :: InterpState ()
intState = AppS -> InterpState ()
forall n. AppState n -> InterpState ()
interpState AppS
appState
bindingBox :: B.Widget AppName
bindingBox :: Widget AppName
bindingBox = AppName -> ViewportType -> Widget AppName -> Widget AppName
forall n.
(Ord n, Show n) =>
n -> ViewportType -> Widget n -> Widget n
B.viewport AppName
BindingViewport ViewportType
B.Vertical Widget AppName
contents
where
contents :: Widget AppName
contents = case [NameBinding Text] -> [Text]
forall (f :: * -> *). Functor f => f (NameBinding Text) -> f Text
NameBinding.renderNamesTxt ([NameBinding Text] -> [Text])
-> Either DaemonError [NameBinding Text]
-> Either DaemonError [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InterpState () -> Either DaemonError [NameBinding Text]
forall a. InterpState a -> Either DaemonError [NameBinding Text]
Daemon.bindings InterpState ()
intState of
Left DaemonError
_ -> Text -> Widget AppName
forall n. Text -> Widget n
B.txt Text
"<Error displaying bindings>"
Right [] -> Text -> Widget AppName
forall n. Text -> Widget n
B.txt Text
" "
Right [Text]
bs -> [Widget AppName] -> Widget AppName
forall n. [Widget n] -> Widget n
B.vBox (WrapSettings -> Text -> Widget AppName
forall n. WrapSettings -> Text -> Widget n
B.txtWrapWith WrapSettings
wrapSettings (Text -> Widget AppName) -> [Text] -> [Widget AppName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
bs)
wrapSettings :: WrapSettings
wrapSettings =
WrapSettings
Wrap.defaultWrapSettings
{ Wrap.preserveIndentation = True
, Wrap.breakLongWords = True
, Wrap.fillStrategy = Wrap.FillIndent 2
}
moduleBox :: AppS -> B.Widget AppName
moduleBox :: AppS -> Widget AppName
moduleBox AppS
appState =
AppName -> Widget AppName -> Widget AppName
forall n. Ord n => n -> Widget n -> Widget n
B.cached AppName
ModulesViewport (Widget AppName -> Widget AppName)
-> Widget AppName -> Widget AppName
forall a b. (a -> b) -> a -> b
$
if [(Text, String)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Text, String)]
mfmAssocs
then Widget AppName -> Widget AppName
forall n. Widget n -> Widget n
B.hCenter (Widget AppName -> Widget AppName)
-> Widget AppName -> Widget AppName
forall a b. (a -> b) -> a -> b
$ Text -> Widget AppName
forall n. Text -> Widget n
B.txt Text
"<No module mappings>"
else
VScrollBarOrientation -> Widget AppName -> Widget AppName
forall n. VScrollBarOrientation -> Widget n -> Widget n
B.withVScrollBars VScrollBarOrientation
B.OnRight
(Widget AppName -> Widget AppName)
-> (Widget AppName -> Widget AppName)
-> Widget AppName
-> Widget AppName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppName -> ViewportType -> Widget AppName -> Widget AppName
forall n.
(Ord n, Show n) =>
n -> ViewportType -> Widget n -> Widget n
B.viewport AppName
ModulesViewport ViewportType
B.Vertical
(Widget AppName -> Widget AppName)
-> Widget AppName -> Widget AppName
forall a b. (a -> b) -> a -> b
$ [Widget AppName] -> Widget AppName
forall n. [Widget n] -> Widget n
B.vBox [Widget AppName]
moduleEntries
where
mfmAssocs :: [(Text, String)]
mfmAssocs = ModuleFileMap -> [(Text, String)]
Loc.moduleFileMapAssocs (InterpState () -> ModuleFileMap
forall a. InterpState a -> ModuleFileMap
Daemon.moduleFileMap (AppS -> InterpState ()
forall n. AppState n -> InterpState ()
AppState.interpState AppS
appState))
moduleEntries :: [Widget AppName]
moduleEntries = (Int -> (Text, String) -> Widget AppName)
-> [Int] -> [(Text, String)] -> [Widget AppName]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> (Text, String) -> Widget AppName
forall n. Int -> (Text, String) -> Widget n
mkModEntryWidget [Int
0 ..] [(Text, String)]
mfmAssocs
mkModEntryWidget :: Int -> (T.Text, FilePath) -> B.Widget n
mkModEntryWidget :: forall n. Int -> (Text, String) -> Widget n
mkModEntryWidget Int
idx (Text
modName, String
fp) =
if Bool
isSelected Bool -> Bool -> Bool
&& Bool
isActive
then
Widget n -> Widget n
forall n. Widget n -> Widget n
B.visible
( AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
B.withAttr
(String -> AttrName
B.attrName String
"selected-marker")
(Text -> Widget n
forall n. Text -> Widget n
B.txt Text
cursor Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> WrapSettings -> Text -> Widget n
forall n. WrapSettings -> Text -> Widget n
B.txtWrapWith WrapSettings
wrapSettings Text
entryText)
)
else Text -> Widget n
forall n. Text -> Widget n
B.txt Text
padding Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Text -> Widget n
forall n. Text -> Widget n
B.txt Text
entryText
where
isSelected :: Bool
isSelected = AppS -> Int
forall n. AppState n -> Int
AppState.getSelectedModuleInInfoPanel AppS
appState Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
idx
isActive :: Bool
isActive = AppS -> ActiveWindow
forall n. AppState n -> ActiveWindow
AppState.activeWindow AppS
appState ActiveWindow -> ActiveWindow -> Bool
forall a. Eq a => a -> a -> Bool
== ActiveWindow
ActiveInfoWindow
entryText :: Text
entryText = Text
modName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
fp
padding :: Text
padding = Text
" "
cursor :: Text
cursor = Text
"> "
wrapSettings :: WrapSettings
wrapSettings =
WrapSettings
Wrap.defaultWrapSettings
{ Wrap.preserveIndentation = True
, Wrap.breakLongWords = True
, Wrap.fillStrategy = Wrap.FillIndent 2
}
drawTraceBox :: AppState AppName -> B.Widget AppName
drawTraceBox :: AppS -> Widget AppName
drawTraceBox AppS
s = Widget AppName
forall {n}. Widget n
contents
where
contents :: Widget n
contents =
if [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
traceHist
then Text -> Widget n
forall n. Text -> Widget n
B.txt Text
"<No trace>"
else [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
B.vBox ([Widget n] -> Widget n) -> [Widget n] -> Widget n
forall a b. (a -> b) -> a -> b
$ Text -> Widget n
forall n. Text -> Widget n
B.txt (Text -> Widget n) -> [Text] -> [Widget n]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
traceHist
traceHist :: [T.Text]
traceHist :: [Text]
traceHist = InterpState () -> [Text]
forall a. InterpState a -> [Text]
Daemon.traceHist (AppS -> InterpState ()
forall n. AppState n -> InterpState ()
AppState.interpState AppS
s)
markLabel
:: Bool
-> T.Text
-> T.Text
-> B.Widget a
markLabel :: forall a. Bool -> Text -> Text -> Widget a
markLabel Bool
False Text
labelTxt Text
focus = Text -> Widget a
forall n. Text -> Widget n
B.txt (Text -> Widget a) -> (Text -> Text) -> Text -> Widget a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
appendFocusButton (Text -> Widget a) -> Text -> Widget a
forall a b. (a -> b) -> a -> b
$ Text
labelTxt
where
appendFocusButton :: Text -> Text
appendFocusButton Text
t = if Text
focus Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
forall a. Monoid a => a
mempty then Text
t else Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
focus
markLabel Bool
True Text
labelTxt Text
_ =
AttrName -> Widget a -> Widget a
forall n. AttrName -> Widget n -> Widget n
B.withAttr (String -> AttrName
B.attrName String
"highlight") (Text -> Widget a
forall n. Text -> Widget n
B.txt (Text
"#> " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
labelTxt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" <#"))
brickApp :: B.App AppS e AppName
brickApp :: forall e. App AppS e AppName
brickApp =
B.App
{ appDraw :: AppS -> [Widget AppName]
B.appDraw = AppS -> [Widget AppName]
appDraw
, appChooseCursor :: AppS -> [CursorLocation AppName] -> Maybe (CursorLocation AppName)
B.appChooseCursor = AppS -> [CursorLocation AppName] -> Maybe (CursorLocation AppName)
Events.handleCursorPosition
, appHandleEvent :: BrickEvent AppName e -> EventM AppName AppS ()
B.appHandleEvent = BrickEvent AppName e -> EventM AppName AppS ()
forall e. BrickEvent AppName e -> EventM AppName AppS ()
Events.handleEvent
, appStartEvent :: EventM AppName AppS ()
B.appStartEvent = () -> EventM AppName AppS ()
forall a. a -> EventM AppName AppS a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
, appAttrMap :: AppS -> AttrMap
B.appAttrMap =
AttrMap -> AppS -> AttrMap
forall a b. a -> b -> a
const (AttrMap -> AppS -> AttrMap) -> AttrMap -> AppS -> AttrMap
forall a b. (a -> b) -> a -> b
$
Attr -> [(AttrName, Attr)] -> AttrMap
B.attrMap
Attr
V.defAttr
[ (String -> AttrName
B.attrName String
"stop-line", Color -> Attr
B.fg Color
V.red)
, (String -> AttrName
B.attrName String
"line-numbers", Color -> Attr
B.fg Color
V.cyan)
, (String -> AttrName
B.attrName String
"selected-line-numbers", Color -> Attr
B.fg Color
V.yellow)
, (String -> AttrName
B.attrName String
"selected-line", Color -> Attr
B.bg Color
V.brightBlack)
, (String -> AttrName
B.attrName String
"selected-marker", Color -> Attr
B.fg Color
V.yellow)
, (String -> AttrName
B.attrName String
"breakpoint-marker", Color -> Attr
B.fg Color
V.red)
, (String -> AttrName
B.attrName String
"underline", Style -> Attr
B.style Style
V.underline)
, (String -> AttrName
B.attrName String
"styled", Color -> Attr
B.fg Color
V.magenta Attr -> Style -> Attr
`V.withStyle` Style
V.bold)
, (String -> AttrName
B.attrName String
"highlight", Style -> Attr
B.style Style
V.standout)
, (String -> AttrName
B.attrName String
"dialog", Style -> Attr
B.style Style
V.standout)
]
}
launchBrick :: AppConfig.AppConfig -> T.Text -> FilePath -> IO ()
launchBrick :: AppConfig -> Text -> String -> IO ()
launchBrick AppConfig
conf Text
target String
cwd = do
Text -> IO ()
T.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Starting up GHCiTUI with: `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> AppConfig -> Text
AppConfig.getCmd AppConfig
conf Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`..."
Text -> IO ()
T.putStrLn Text
"This can take a while..."
AppS
initialState <- AppConfig -> Text -> String -> IO AppS
makeInitialState AppConfig
conf Text
target String
cwd
AppS
_ <- App AppS Any AppName -> AppS -> IO AppS
forall n s e. Ord n => App s e n -> s -> IO s
B.defaultMain App AppS Any AppName
forall e. App AppS e AppName
brickApp AppS
initialState
Text -> IO ()
T.putStrLn Text
"GHCiTUI has shut down; have a nice day :)"
() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()