{-# LANGUAGE NamedFieldPuns #-}
module Ghcitui.Brick.DrawSourceViewer (drawSourceViewer) where
import qualified Brick as B
import qualified Brick.Widgets.Center as B
import Brick.Widgets.Core ((<+>), (<=>))
import Control.Error (fromMaybe)
import Data.Function ((&))
import Data.Functor ((<&>))
import qualified Data.Text as T
import qualified Data.Vector as Vec
import qualified Graphics.Vty as V
import Lens.Micro ((^.))
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
import qualified Ghcitui.Util as Util
drawSourceViewer :: AppState AppName -> B.Widget AppName
drawSourceViewer :: AppState AppName -> Widget AppName
drawSourceViewer AppState AppName
s
| (SourceWindow AppName Text
srcWindow SourceWindow AppName Text
-> Getting (Vector Text) (SourceWindow AppName Text) (Vector Text)
-> Vector Text
forall s a. s -> Getting a s a -> a
^. Getting (Vector Text) (SourceWindow AppName Text) (Vector Text)
forall name elem1 elem2 (f :: * -> *).
Functor f =>
(Vector elem1 -> f (Vector elem2))
-> SourceWindow name elem1 -> f (SourceWindow name elem2)
SourceWindow.srcElementsL) Vector Text -> Vector Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Vector Text
forall a. Monoid a => a
mempty = AppState AppName -> SourceWindow AppName Text -> Widget AppName
drawSourceViewer' AppState AppName
s SourceWindow AppName Text
srcWindow
| Bool -> Bool
not Bool
currentlyRunning = Widget AppName
notRunningWidget
| Bool
otherwise = Widget AppName
noSourceWidget
where
currentlyRunning :: Bool
currentlyRunning = InterpState () -> Bool
forall a. InterpState a -> Bool
Daemon.isExecuting (AppState AppName -> InterpState ()
forall n. AppState n -> InterpState ()
AppState.interpState AppState AppName
s)
srcWindow :: SourceWindow AppName Text
srcWindow = AppState AppName
s AppState AppName
-> Getting
(SourceWindow AppName Text)
(AppState AppName)
(SourceWindow AppName Text)
-> SourceWindow AppName Text
forall s a. s -> Getting a s a -> a
^. Getting
(SourceWindow AppName Text)
(AppState AppName)
(SourceWindow AppName Text)
forall n (f :: * -> *).
Functor f =>
(SourceWindow n Text -> f (SourceWindow n Text))
-> AppState n -> f (AppState n)
AppState.sourceWindow
notRunningWidget :: Widget AppName
notRunningWidget =
Widget AppName -> Widget AppName
forall n. Widget n -> Widget n
withStyle
( Widget AppName -> Widget AppName
forall n. Widget n -> Widget n
padTop (Widget AppName -> Widget AppName
forall n. Widget n -> Widget n
B.hCenter Widget AppName
splashWidget)
Widget AppName -> Widget AppName -> Widget AppName
forall n. Widget n -> Widget n -> Widget n
<=> Widget AppName -> Widget AppName
forall n. Widget n -> Widget n
padTop
( Widget AppName -> Widget AppName
forall n. Widget n -> Widget n
B.hCenter (Text -> Widget AppName
forall n. Text -> Widget n
B.txt Text
"Nothing executing. Maybe run something?")
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 (Text -> Widget AppName
forall n. Text -> Widget n
B.txt Text
"Press '?' for help.")
)
)
noSourceWidget :: Widget AppName
noSourceWidget =
Widget AppName -> Widget AppName
forall n. Widget n -> Widget n
withStyle (Widget AppName -> Widget AppName
forall n. Widget n -> Widget n
B.hCenter Widget AppName
splashWidget Widget AppName -> Widget AppName -> Widget AppName
forall n. Widget n -> Widget n -> Widget n
<=> Widget AppName -> Widget AppName
forall n. Widget n -> Widget n
padTop (Text -> Widget AppName
forall n. Text -> Widget n
B.txt Text
"Can't display. Source not found."))
splashWidget :: Widget AppName
splashWidget =
Widget AppName -> Widget AppName
forall n. Widget n -> Widget n
withStyle (Text -> Widget AppName
forall n. Text -> Widget n
B.txt (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"No splash file loaded." (AppState AppName -> Maybe Text
forall n. AppState n -> Maybe Text
AppState.splashContents AppState AppName
s)))
padTop :: B.Widget n -> B.Widget n
padTop :: forall n. Widget n -> Widget n
padTop = Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
B.padTop (Int -> Padding
B.Pad Int
3)
withStyle :: B.Widget n -> B.Widget n
withStyle :: forall n. Widget n -> Widget n
withStyle = AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
B.withAttr (String -> AttrName
B.attrName String
"styled")
data GutterInfo = GutterInfo
{ GutterInfo -> Bool
isStoppedHere :: !Bool
, GutterInfo -> Bool
isBreakpoint :: !Bool
, GutterInfo -> Bool
isSelected :: !Bool
, GutterInfo -> Int
gutterLineNumber :: !Int
, GutterInfo -> Int
gutterDigitWidth :: !Int
}
prependGutter :: GutterInfo -> B.Widget n -> B.Widget n
prependGutter :: forall n. GutterInfo -> Widget n -> Widget n
prependGutter GutterInfo
gi Widget n
line = GutterInfo -> Widget n
forall n. GutterInfo -> Widget n
makeGutter GutterInfo
gi Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Widget n
line
makeGutter :: GutterInfo -> B.Widget n
makeGutter :: forall n. GutterInfo -> Widget n
makeGutter GutterInfo{Bool
Int
$sel:isStoppedHere:GutterInfo :: GutterInfo -> Bool
$sel:isBreakpoint:GutterInfo :: GutterInfo -> Bool
$sel:isSelected:GutterInfo :: GutterInfo -> Bool
$sel:gutterLineNumber:GutterInfo :: GutterInfo -> Int
$sel:gutterDigitWidth:GutterInfo :: GutterInfo -> Int
isStoppedHere :: Bool
isBreakpoint :: Bool
isSelected :: Bool
gutterLineNumber :: Int
gutterDigitWidth :: Int
..} =
Widget n
lineNoWidget Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Widget n
forall {n}. Widget n
spaceW Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Widget n
stopColumn Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Widget n
breakColumn Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Widget n
forall {n}. Widget n
spaceW
where
spaceW :: Widget n
spaceW = Text -> Widget n
forall n. Text -> Widget n
B.txt Text
" "
lineNoWidget :: Widget n
lineNoWidget =
let attr :: AttrName
attr = String -> AttrName
B.attrName (if Bool
isSelected then String
"selected-line-numbers" else String
"line-numbers")
in AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
B.withAttr AttrName
attr (Text -> Widget n
forall n. Text -> Widget n
B.txt (Int -> Int -> Text
Util.formatDigits Int
gutterDigitWidth Int
gutterLineNumber))
breakColumn :: Widget n
breakColumn
| Bool
isSelected Bool -> Bool -> Bool
&& Bool
isBreakpoint = 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
"@")
| Bool
isSelected = 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
">")
| Bool
isBreakpoint = AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
B.withAttr (String -> AttrName
B.attrName String
"breakpoint-marker") (Text -> Widget n
forall n. Text -> Widget n
B.txt Text
"*")
| Bool
otherwise = Widget n
forall {n}. Widget n
spaceW
stopColumn :: Widget n
stopColumn
| Bool
isStoppedHere = AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
B.withAttr (String -> AttrName
B.attrName String
"stop-line") (Text -> Widget n
forall n. Text -> Widget n
B.txt Text
"!")
| Bool
otherwise = Widget n
forall {n}. Widget n
spaceW
drawSourceViewer'
:: AppState AppName
-> SourceWindow.SourceWindow AppName T.Text
-> B.Widget AppName
drawSourceViewer' :: AppState AppName -> SourceWindow AppName Text -> Widget AppName
drawSourceViewer' AppState AppName
s SourceWindow AppName Text
sourceWindow = Widget AppName
composedTogether
where
isSelectedLine :: Int -> Bool
isSelectedLine :: Int -> Bool
isSelectedLine Int
lineno = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
lineno Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== SourceWindow AppName Text
sourceWindow SourceWindow AppName Text
-> Getting (Maybe Int) (SourceWindow AppName Text) (Maybe Int)
-> Maybe Int
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Int) (SourceWindow AppName Text) (Maybe Int)
forall name elem (f :: * -> *).
Functor f =>
(Maybe Int -> f (Maybe Int))
-> SourceWindow name elem -> f (SourceWindow name elem)
SourceWindow.srcSelectedLineL
composedTogether :: B.Widget AppName
composedTogether :: Widget AppName
composedTogether = (Int -> Bool -> Text -> Widget AppName)
-> SourceWindow AppName Text -> Widget AppName
forall n e.
Ord n =>
(Int -> Bool -> e -> Widget n) -> SourceWindow n e -> Widget n
SourceWindow.renderSourceWindow Int -> Bool -> Text -> Widget AppName
forall {p}. Int -> p -> Text -> Widget AppName
createWidget SourceWindow AppName Text
sourceWindow
where
createWidget :: Int -> p -> Text -> Widget AppName
createWidget Int
lineno p
_old Text
lineTxt =
Widget AppName -> Widget AppName
styliseLine (Widget AppName -> Widget AppName)
-> Widget AppName -> Widget AppName
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Widget AppName
composedTogetherHelper Int
lineno Text
lineTxt
where
styliseLine :: Widget AppName -> Widget AppName
styliseLine Widget AppName
w =
if Int -> Bool
isSelectedLine Int
lineno
then
(Attr -> Attr) -> Widget AppName -> Widget AppName
forall n. (Attr -> Attr) -> Widget n -> Widget n
B.modifyDefAttr (Attr -> Style -> Attr
`V.withStyle` Style
V.bold) Widget AppName
w
else Widget AppName
w
composedTogetherHelper :: Int -> T.Text -> B.Widget AppName
composedTogetherHelper :: Int -> Text -> Widget AppName
composedTogetherHelper Int
lineno Text
lineTxt = Widget AppName
lineWidgetCached
where
sr :: SourceRange
sr = SourceRange
-> (FileLoc -> SourceRange) -> Maybe FileLoc -> SourceRange
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SourceRange
Loc.unknownSourceRange FileLoc -> SourceRange
forall a. HasSourceRange a => a -> SourceRange
Loc.sourceRange (InterpState () -> Maybe FileLoc
forall a. InterpState a -> Maybe FileLoc
Daemon.pauseLoc (AppState AppName -> InterpState ()
forall n. AppState n -> InterpState ()
AppState.interpState AppState AppName
s))
mLineno :: Maybe (Int, ColumnRange)
mLineno = SourceRange -> Maybe (Int, ColumnRange)
Loc.singleify SourceRange
sr
lineWidget :: Widget AppName
lineWidget = case Maybe (Int, ColumnRange)
mLineno of
Just (Int
singleLine, ColumnRange
_) | Int
lineno Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
singleLine -> Text -> Widget AppName
stoppedLineW Text
lineTxt
Maybe (Int, ColumnRange)
_
| SourceRange -> Int -> Bool
Loc.isLineInside SourceRange
sr Int
lineno -> Widget AppName
stoppedRangeW
Maybe (Int, ColumnRange)
_ -> (\Widget AppName
w -> (Int, Widget AppName) -> Widget AppName
forall n. (Int, Widget n) -> Widget n
prefixLine (Int
lineno, Widget AppName
w)) (Widget AppName -> Widget AppName)
-> (Text -> Widget AppName) -> Text -> Widget AppName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Widget AppName
forall n. Text -> Widget n
B.txt (Text -> Widget AppName) -> Text -> Widget AppName
forall a b. (a -> b) -> a -> b
$ Text
lineTxt
lineWidgetCached :: Widget AppName
lineWidgetCached = AppName -> Widget AppName -> Widget AppName
forall n. Ord n => n -> Widget n -> Widget n
B.cached (Int -> AppName
SourceWindowLine Int
lineno) Widget AppName
lineWidget
stoppedRangeW :: B.Widget AppName
stoppedRangeW :: Widget AppName
stoppedRangeW =
(Int, Widget AppName) -> Widget AppName
forall n. (Int, Widget n) -> Widget n
prefixLine
( Int
lineno
, AttrName -> Widget AppName -> Widget AppName
forall n. AttrName -> Widget n -> Widget n
B.forceAttrAllowStyle (String -> AttrName
B.attrName String
"stop-line") (Text -> Widget AppName
forall n. Text -> Widget n
B.txt Text
lineTxt)
)
prefixLine :: (Int, B.Widget n) -> B.Widget n
prefixLine :: forall n. (Int, Widget n) -> Widget n
prefixLine (Int
lineno', Widget n
w) =
GutterInfo -> Widget n -> Widget n
forall n. GutterInfo -> Widget n -> Widget n
prependGutter
(Int -> GutterInfo
gutterInfoForLine Int
lineno')
Widget n
w
where
gutterInfoForLine :: Int -> GutterInfo
gutterInfoForLine :: Int -> GutterInfo
gutterInfoForLine Int
lineno =
GutterInfo
{ $sel:isStoppedHere:GutterInfo :: Bool
isStoppedHere =
InterpState () -> Maybe FileLoc
forall a. InterpState a -> Maybe FileLoc
Daemon.pauseLoc (AppState AppName -> InterpState ()
forall n. AppState n -> InterpState ()
AppState.interpState AppState AppName
s)
Maybe FileLoc -> (FileLoc -> SourceRange) -> Maybe SourceRange
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> FileLoc -> SourceRange
forall a. HasSourceRange a => a -> SourceRange
Loc.sourceRange
Maybe SourceRange -> (SourceRange -> Bool) -> Maybe Bool
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (SourceRange -> Int -> Bool
`Loc.isLineInside` Int
lineno)
Maybe Bool -> (Maybe Bool -> Bool) -> Bool
forall a b. a -> (a -> b) -> b
& Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False
, $sel:isBreakpoint:GutterInfo :: Bool
isBreakpoint = Int
lineno Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int]
breakpoints
, $sel:gutterLineNumber:GutterInfo :: Int
gutterLineNumber = Int
lineno
, $sel:gutterDigitWidth:GutterInfo :: Int
gutterDigitWidth = Int -> Int
forall a. Integral a => a -> Int
Util.getNumDigits (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ SourceWindow AppName Text -> Int
forall n e. SourceWindow n e -> Int
sourceWindowLength SourceWindow AppName Text
sourceWindow
, $sel:isSelected:GutterInfo :: Bool
isSelected = Int -> Bool
isSelectedLine Int
lineno
}
where
breakpoints :: [Int]
breakpoints :: [Int]
breakpoints =
[Int] -> (String -> [Int]) -> Maybe String -> [Int]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
[Int]
forall a. Monoid a => a
mempty
(\String
f -> String -> InterpState () -> [Int]
forall a. String -> InterpState a -> [Int]
Daemon.getBpInFile String
f (AppState AppName -> InterpState ()
forall n. AppState n -> InterpState ()
AppState.interpState AppState AppName
s))
(AppState AppName -> Maybe String
forall n. AppState n -> Maybe String
AppState.selectedFile AppState AppName
s)
originalLookupLineNo :: Int
originalLookupLineNo :: Int
originalLookupLineNo =
InterpState () -> Maybe FileLoc
forall a. InterpState a -> Maybe FileLoc
Daemon.pauseLoc (AppState AppName -> InterpState ()
forall n. AppState n -> InterpState ()
AppState.interpState AppState AppName
s)
Maybe FileLoc -> (FileLoc -> Maybe Int) -> Maybe Int
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SourceRange -> Maybe Int
Loc.startLine (SourceRange -> Maybe Int)
-> (FileLoc -> SourceRange) -> FileLoc -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileLoc -> SourceRange
forall a. HasSourceRange a => a -> SourceRange
Loc.sourceRange
Maybe Int -> (Maybe Int -> Int) -> Int
forall a b. a -> (a -> b) -> b
& Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0
stoppedLineW :: T.Text -> B.Widget AppName
stoppedLineW :: Text -> Widget AppName
stoppedLineW Text
lineTxt =
let Loc.SourceRange{Maybe Int
startCol :: Maybe Int
$sel:startCol:SourceRange :: SourceRange -> Maybe Int
startCol, Maybe Int
endCol :: Maybe Int
$sel:endCol:SourceRange :: SourceRange -> Maybe Int
endCol} =
SourceRange
-> (FileLoc -> SourceRange) -> Maybe FileLoc -> SourceRange
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
SourceRange
Loc.unknownSourceRange
FileLoc -> SourceRange
forall a. HasSourceRange a => a -> SourceRange
Loc.sourceRange
(InterpState () -> Maybe FileLoc
forall a. InterpState a -> Maybe FileLoc
Daemon.pauseLoc (AppState AppName -> InterpState ()
forall n. AppState n -> InterpState ()
AppState.interpState AppState AppName
s))
lineWidget :: Widget AppName
lineWidget = Text -> ColumnRange -> Widget AppName
makeStoppedLineWidget Text
lineTxt (Maybe Int
startCol, Maybe Int
endCol)
in (Int, Widget AppName) -> Widget AppName
forall n. (Int, Widget n) -> Widget n
prefixLine (Int
originalLookupLineNo, Widget AppName
lineWidget)
sourceWindowLength :: SourceWindow.SourceWindow n e -> Int
sourceWindowLength :: forall n e. SourceWindow n e -> Int
sourceWindowLength = Vector e -> Int
forall a. Vector a -> Int
Vec.length (Vector e -> Int)
-> (SourceWindow n e -> Vector e) -> SourceWindow n e -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceWindow n e -> Vector e
forall name elem. SourceWindow name elem -> Vector elem
SourceWindow.srcElements
makeStoppedLineWidget :: T.Text -> Loc.ColumnRange -> B.Widget AppName
makeStoppedLineWidget :: Text -> ColumnRange -> Widget AppName
makeStoppedLineWidget Text
lineData (Maybe Int
Nothing, Maybe Int
_) =
AttrName -> Widget AppName -> Widget AppName
forall n. AttrName -> Widget n -> Widget n
B.forceAttrAllowStyle (String -> AttrName
B.attrName String
"stop-line") (Text -> Widget AppName
forall n. Text -> Widget n
B.txt Text
lineData)
makeStoppedLineWidget Text
lineData (Just Int
startCol, Maybe Int
Nothing) =
Text -> ColumnRange -> Widget AppName
makeStoppedLineWidget Text
lineData (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
startCol, Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
startCol Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
makeStoppedLineWidget Text
lineData (Just Int
startCol, Just Int
endCol) =
AttrName -> Widget AppName -> Widget AppName
forall n. AttrName -> Widget n -> Widget n
B.forceAttrAllowStyle
(String -> AttrName
B.attrName String
"stop-line")
( Text -> Widget AppName
forall n. Text -> Widget n
B.txt Text
lineDataBefore
Widget AppName -> Widget AppName -> Widget AppName
forall n. Widget n -> Widget n -> Widget n
<+> AttrName -> Widget AppName -> Widget AppName
forall n. AttrName -> Widget n -> Widget n
B.withAttr (String -> AttrName
B.attrName String
"highlight") (Text -> Widget AppName
forall n. Text -> Widget n
B.txt Text
lineDataRange)
Widget AppName -> Widget AppName -> Widget AppName
forall n. Widget n -> Widget n -> Widget n
<+> Text -> Widget AppName
forall n. Text -> Widget n
B.txt Text
lineDataAfter
)
where
(Text
lineDataBefore, Text
partial) = Int -> Text -> (Text, Text)
T.splitAt (Int
startCol Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Text
lineData
(Text
lineDataRange, Text
lineDataAfter) = Int -> Text -> (Text, Text)
T.splitAt (Int
endCol Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
startCol Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Text
partial