{-# 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

-- | Alias for 'AppState AppName' convenience.
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

{- | Draw the dialog layer.

     If there's no dialog, returns an 'emptyWidget'.
-}
drawDialogLayer :: AppS -> B.Widget AppName
-- Quit Dialog
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"))
-- Help Dialog
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"
                )
-- No Dialog
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]"

    -- For seeing the source code.
    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
" "
                    )

    -- For the REPL.
    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

-- | Draw the info panel.
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
" " -- Can't be an empty widget due to padding?
            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
                }

-- | Draw the trace box in the info panel.
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)

-- | Mark the label if the first arg is True.
markLabel
    :: Bool
    -- ^ Conditional to mark with.
    -> T.Text
    -- ^ Text to use for the label.
    -> T.Text
    -- ^ Addendum unfocused 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
" <#"))

-- -------------------------------------------------------------------------------------------------
-- Brick Main
-- -------------------------------------------------------------------------------------------------

-- | Brick main program.
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)
                    ]
        }

-- | Start the Brick UI
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 ()