{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

module Ghcitui.Brick.SourceWindow
    ( SourceWindow (srcElements)

      -- * Creation
    , mkSourcWindow

      -- * Rendering
    , renderSourceWindow

      -- * Event Handling
    , ScrollDir (..)
    , scrollTo
    , srcWindowScrollPage
    , srcWindowMoveSelectionBy
    , srcWindowReplace
    , setSelectionTo
    , updateVerticalSpace

      -- * Lenses
    , srcElementsL
    , srcNameL
    , srcSelectedLineL
    , srcWindowStartL
    , srcWindowVerticalSpaceL

      -- * Misc
    , srcWindowLength
    ) where

import qualified Brick as B
import Control.Error (fromMaybe)
import qualified Data.Text as T
import qualified Data.Vector as Vec
import Lens.Micro ((^.))
import qualified Lens.Micro as Lens
import Lens.Micro.TH (makeLensesFor)

import qualified Ghcitui.Util as Util

-- | Hold data regarding a code source viewing window.
data SourceWindow name elem = SourceWindow
    { forall name elem. SourceWindow name elem -> Vector elem
srcElements :: !(Vec.Vector elem)
    -- ^ The actual entries for each source window.
    , forall name elem. SourceWindow name elem -> Int
srcWindowStart :: !Int
    -- ^ The starting position of the window, as a line number (1-indexed).
    -- No lines before this line number is rendered.
    , forall name elem. SourceWindow name elem -> Maybe Int
srcWindowVerticalSpace :: !(Maybe Int)
    -- ^ The maximum amount of visible lines at any point in time.
    , forall name elem. SourceWindow name elem -> name
srcName :: !name
    -- ^ The name of the window.
    , forall name elem. SourceWindow name elem -> Maybe Int
srcSelectedLine :: !(Maybe Int)
    -- ^ The currently selected line in the window.
    }
    deriving (Int -> SourceWindow name elem -> ShowS
[SourceWindow name elem] -> ShowS
SourceWindow name elem -> String
(Int -> SourceWindow name elem -> ShowS)
-> (SourceWindow name elem -> String)
-> ([SourceWindow name elem] -> ShowS)
-> Show (SourceWindow name elem)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall name elem.
(Show elem, Show name) =>
Int -> SourceWindow name elem -> ShowS
forall name elem.
(Show elem, Show name) =>
[SourceWindow name elem] -> ShowS
forall name elem.
(Show elem, Show name) =>
SourceWindow name elem -> String
$cshowsPrec :: forall name elem.
(Show elem, Show name) =>
Int -> SourceWindow name elem -> ShowS
showsPrec :: Int -> SourceWindow name elem -> ShowS
$cshow :: forall name elem.
(Show elem, Show name) =>
SourceWindow name elem -> String
show :: SourceWindow name elem -> String
$cshowList :: forall name elem.
(Show elem, Show name) =>
[SourceWindow name elem] -> ShowS
showList :: [SourceWindow name elem] -> ShowS
Show)

makeLensesFor
    [ ("srcElements", "srcElementsL")
    , ("srcWindowStart", "srcWindowStartL")
    , ("srcWindowVerticalSpace", "srcWindowVerticalSpaceL")
    , ("srcName", "srcNameL")
    , ("srcSelectedLine", "srcSelectedLineL")
    ]
    ''SourceWindow

-- | The difference between the last rendered line and the first rendered line.
srcWindowLineDiffCount :: SourceWindow name elem -> Maybe Int
srcWindowLineDiffCount :: forall name elem. SourceWindow name elem -> Maybe Int
srcWindowLineDiffCount SourceWindow{$sel:srcWindowVerticalSpace:SourceWindow :: forall name elem. SourceWindow name elem -> Maybe Int
srcWindowVerticalSpace = Just Int
sWVS} = Int -> Maybe Int
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int
sWVS Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
srcWindowLineDiffCount SourceWindow name elem
_ = Maybe Int
forall a. Maybe a
Nothing

-- | The line number of the last viewable line in the window.
getLastRenderedLine :: SourceWindow name elem -> Maybe Int
getLastRenderedLine :: forall name elem. SourceWindow name elem -> Maybe Int
getLastRenderedLine srcW :: SourceWindow name elem
srcW@SourceWindow{Int
$sel:srcWindowStart:SourceWindow :: forall name elem. SourceWindow name elem -> Int
srcWindowStart :: Int
srcWindowStart} = do
    Int
diffCount <- SourceWindow name elem -> Maybe Int
forall name elem. SourceWindow name elem -> Maybe Int
srcWindowLineDiffCount SourceWindow name elem
srcW
    Int -> Maybe Int
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int
diffCount Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
srcWindowStart

-- | Render a 'SourceWindow' into a Brick 'B.Widget'.
renderSourceWindow
    :: (Ord n)
    => (Int -> Bool -> e -> B.Widget n)
    -- ^ Render function.
    -> SourceWindow n e
    -- ^ 'SourceWindow' to render.
    -> B.Widget n
    -- ^ The newly created widget.
renderSourceWindow :: forall n e.
Ord n =>
(Int -> Bool -> e -> Widget n) -> SourceWindow n e -> Widget n
renderSourceWindow Int -> Bool -> e -> Widget n
func SourceWindow n e
srcW = n -> Widget n -> Widget n
forall n. Ord n => n -> Widget n -> Widget n
B.reportExtent (SourceWindow n e -> n
forall name elem. SourceWindow name elem -> name
srcName SourceWindow n e
srcW) (Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
B.Widget Size
B.Greedy Size
B.Greedy RenderM n (Result n)
renderM)
  where
    renderM :: RenderM n (Result n)
renderM = do
        Context n
c <- RenderM n (Context n)
forall n. RenderM n (Context n)
B.getContext
        let availableHeight :: Int
availableHeight = Context n
c Context n -> Getting Int (Context n) Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int (Context n) Int
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> Context n -> f (Context n)
B.availHeightL Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
        let renderHeight :: Int
renderHeight = (Int, Int) -> Int -> Int
forall a. Ord a => (a, a) -> a -> a
Util.clamp (Int
1, Int
remainingElements) Int
availableHeight
        let slicedElems :: Vector e
slicedElems = Int -> Int -> Vector e -> Vector e
forall a. Int -> Int -> Vector a -> Vector a
Vec.slice Int
startZeroIdx Int
renderHeight Vector e
elems
        let drawnElems :: [Widget n]
drawnElems =
                [ Int -> Bool -> e -> Widget n
func Int
idx (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
idx Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== SourceWindow n e -> Maybe Int
forall name elem. SourceWindow name elem -> Maybe Int
srcSelectedLine SourceWindow n e
srcW) e
e
                | (Int
idx, e
e) <- [Int] -> [e] -> [(Int, e)]
forall a b. [a] -> [b] -> [(a, b)]
zip [SourceWindow n e -> Int
forall name elem. SourceWindow name elem -> Int
srcWindowStart SourceWindow n e
srcW ..] ([e] -> [(Int, e)]) -> (Vector e -> [e]) -> Vector e -> [(Int, e)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector e -> [e]
forall a. Vector a -> [a]
Vec.toList (Vector e -> [(Int, e)]) -> Vector e -> [(Int, e)]
forall a b. (a -> b) -> a -> b
$ Vector e
slicedElems
                ]
        let trailingSpaces :: Int
trailingSpaces = Int
availableHeight Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Widget n] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Widget n]
drawnElems
        -- This is a fairly weird list comprehension, since it either has only one element
        -- or none. But it works, and is for some reason recommended by hlint. Ugh.
        let trailingSpaceWidgets :: [Widget n]
trailingSpaceWidgets = [Text -> Widget n
forall n. Text -> Widget n
B.txt (Int -> Text -> Text
T.replicate Int
trailingSpaces Text
"\n") | Int
trailingSpaces Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0]
        Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
B.render
            (Widget n -> RenderM n (Result n))
-> ([Widget n] -> Widget n) -> [Widget n] -> RenderM n (Result n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
B.vBox
            ([Widget n] -> RenderM n (Result n))
-> [Widget n] -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ [Widget n]
drawnElems [Widget n] -> [Widget n] -> [Widget n]
forall a. Semigroup a => a -> a -> a
<> [Widget n]
trailingSpaceWidgets
    startZeroIdx :: Int
startZeroIdx = (Int, Int) -> Int -> Int
forall a. Ord a => (a, a) -> a -> a
Util.clamp (Int
0, SourceWindow n e -> Int
forall name elem. SourceWindow name elem -> Int
srcWindowLength SourceWindow n e
srcW Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ SourceWindow n e -> Int
forall name elem. SourceWindow name elem -> Int
srcWindowStart SourceWindow n e
srcW Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    remainingElements :: Int
remainingElements = SourceWindow n e -> Int
forall name elem. SourceWindow name elem -> Int
srcWindowLength SourceWindow n e
srcW Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
startZeroIdx
    elems :: Vector e
elems = SourceWindow n e -> Vector e
forall name elem. SourceWindow name elem -> Vector elem
srcElements SourceWindow n e
srcW

{- | Return the length of the full contents of the source code stored in the window.

     Note, does NOT return the current length/height/size of the rendered widget.
-}
srcWindowLength :: SourceWindow n e -> Int
srcWindowLength :: forall name elem. SourceWindow name elem -> Int
srcWindowLength = 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
srcElements

{- | Set the source window end line inside of the given 'EventM' Monad.
     This is primarily for internal consistency, and is cheap. It should be called any time
     the srcWindowStart changes.
-}
updateVerticalSpace :: (Ord n) => SourceWindow n e -> B.EventM n m (SourceWindow n e)
updateVerticalSpace :: forall n e m.
Ord n =>
SourceWindow n e -> EventM n m (SourceWindow n e)
updateVerticalSpace srcW :: SourceWindow n e
srcW@SourceWindow{n
$sel:srcName:SourceWindow :: forall name elem. SourceWindow name elem -> name
srcName :: n
srcName {- , srcContainerName -}} = do
    Maybe (Extent n)
mSrcNameExtent <- n -> EventM n m (Maybe (Extent n))
forall n s. Eq n => n -> EventM n s (Maybe (Extent n))
B.lookupExtent n
srcName
    let mSpace :: Maybe Int
mSpace = case Maybe (Extent n)
mSrcNameExtent of
            Just Extent n
extent ->
                Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> (Extent n -> Int) -> Extent n -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> Int
forall a b. (a, b) -> b
snd ((Int, Int) -> Int) -> (Extent n -> (Int, Int)) -> Extent n -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Extent n -> (Int, Int)
forall n. Extent n -> (Int, Int)
B.extentSize (Extent n -> Maybe Int) -> Extent n -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Extent n
extent
            Maybe (Extent n)
_ -> Maybe Int
forall a. Maybe a
Nothing
    SourceWindow n e -> EventM n m (SourceWindow n e)
forall a. a -> EventM n m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ASetter
  (SourceWindow n e) (SourceWindow n e) (Maybe Int) (Maybe Int)
-> Maybe Int -> SourceWindow n e -> SourceWindow n e
forall s t a b. ASetter s t a b -> b -> s -> t
Lens.set ASetter
  (SourceWindow n e) (SourceWindow n e) (Maybe Int) (Maybe Int)
forall name elem (f :: * -> *).
Functor f =>
(Maybe Int -> f (Maybe Int))
-> SourceWindow name elem -> f (SourceWindow name elem)
srcWindowVerticalSpaceL Maybe Int
mSpace SourceWindow n e
srcW)

-- | Scroll to a given position, and move the source line along the way if needed.
scrollTo :: Int -> SourceWindow n e -> SourceWindow n e
scrollTo :: forall n e. Int -> SourceWindow n e -> SourceWindow n e
scrollTo Int
pos srcW :: SourceWindow n e
srcW@SourceWindow{$sel:srcWindowVerticalSpace:SourceWindow :: forall name elem. SourceWindow name elem -> Maybe Int
srcWindowVerticalSpace = Just Int
vSpace} =
    SourceWindow n e
srcW{srcWindowStart = clampedPos, srcSelectedLine = newSelection}
  where
    -- Clamp between start line and one window away from the end.
    clampedPos :: Int
clampedPos = (Int, Int) -> Int -> Int
forall a. Ord a => (a, a) -> a -> a
Util.clamp (Int
1, SourceWindow n e -> Int
forall name elem. SourceWindow name elem -> Int
srcWindowLength SourceWindow n e
srcW Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
vSpace) Int
pos

    newSelection :: Maybe Int
newSelection
        | -- Choose the starting line if we're trying to go past the beginning.
          Bool
isScrollingPastStart =
            Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1
        | -- Choose the last line if we're trying to go past the end.
          Bool
isScrollingPastEnd =
            Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ SourceWindow n e -> Int
forall name elem. SourceWindow name elem -> Int
srcWindowLength SourceWindow n e
srcW
        | Bool
otherwise = Maybe Int
newClampedSelectedLine
    isScrollingPastStart :: Bool
isScrollingPastStart = Int
pos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1
    isScrollingPastEnd :: Bool
isScrollingPastEnd = Int
pos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= SourceWindow n e -> Int
forall name elem. SourceWindow name elem -> Int
srcWindowLength SourceWindow n e
srcW -- Using >= because of a hack.
    newClampedSelectedLine :: Maybe Int
    newClampedSelectedLine :: Maybe Int
newClampedSelectedLine = do
        Int
ssl <- SourceWindow n e -> Maybe Int
forall name elem. SourceWindow name elem -> Maybe Int
srcSelectedLine SourceWindow n e
srcW
        Int
diffCount <- SourceWindow n e -> Maybe Int
forall name elem. SourceWindow name elem -> Maybe Int
srcWindowLineDiffCount SourceWindow n e
srcW
        Int -> Maybe Int
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> Int -> Int
forall a. Ord a => (a, a) -> a -> a
Util.clamp (Int
clampedPos, Int
clampedPos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
diffCount) Int
ssl
scrollTo Int
_ SourceWindow n e
srcW = SourceWindow n e
srcW

-- | Direction to scroll by.
data ScrollDir = Up | Down deriving (ScrollDir -> ScrollDir -> Bool
(ScrollDir -> ScrollDir -> Bool)
-> (ScrollDir -> ScrollDir -> Bool) -> Eq ScrollDir
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScrollDir -> ScrollDir -> Bool
== :: ScrollDir -> ScrollDir -> Bool
$c/= :: ScrollDir -> ScrollDir -> Bool
/= :: ScrollDir -> ScrollDir -> Bool
Eq, Int -> ScrollDir -> ShowS
[ScrollDir] -> ShowS
ScrollDir -> String
(Int -> ScrollDir -> ShowS)
-> (ScrollDir -> String)
-> ([ScrollDir] -> ShowS)
-> Show ScrollDir
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScrollDir -> ShowS
showsPrec :: Int -> ScrollDir -> ShowS
$cshow :: ScrollDir -> String
show :: ScrollDir -> String
$cshowList :: [ScrollDir] -> ShowS
showList :: [ScrollDir] -> ShowS
Show)

-- | Scroll by a full page in a direction.
srcWindowScrollPage :: (Ord n) => ScrollDir -> SourceWindow n e -> B.EventM n m (SourceWindow n e)
srcWindowScrollPage :: forall n e m.
Ord n =>
ScrollDir -> SourceWindow n e -> EventM n m (SourceWindow n e)
srcWindowScrollPage ScrollDir
dir SourceWindow n e
srcW = ScrollDir -> SourceWindow n e -> SourceWindow n e
forall n e. ScrollDir -> SourceWindow n e -> SourceWindow n e
srcWindowScrollPage' ScrollDir
dir (SourceWindow n e -> SourceWindow n e)
-> EventM n m (SourceWindow n e) -> EventM n m (SourceWindow n e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SourceWindow n e -> EventM n m (SourceWindow n e)
forall n e m.
Ord n =>
SourceWindow n e -> EventM n m (SourceWindow n e)
updateVerticalSpace SourceWindow n e
srcW

srcWindowScrollPage' :: ScrollDir -> SourceWindow n e -> SourceWindow n e
srcWindowScrollPage' :: forall n e. ScrollDir -> SourceWindow n e -> SourceWindow n e
srcWindowScrollPage' ScrollDir
dir srcW :: SourceWindow n e
srcW@SourceWindow{Int
$sel:srcWindowStart:SourceWindow :: forall name elem. SourceWindow name elem -> Int
srcWindowStart :: Int
srcWindowStart} =
    case ScrollDir
dir of
        ScrollDir
Up -> Int -> SourceWindow n e -> SourceWindow n e
forall n e. Int -> SourceWindow n e -> SourceWindow n e
scrollTo Int
onePageUpPos SourceWindow n e
srcW
        ScrollDir
Down -> Int -> SourceWindow n e -> SourceWindow n e
forall n e. Int -> SourceWindow n e -> SourceWindow n e
scrollTo (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
srcWindowStart (SourceWindow n e -> Maybe Int
forall name elem. SourceWindow name elem -> Maybe Int
getLastRenderedLine SourceWindow n e
srcW)) SourceWindow n e
srcW
  where
    onePageUpPos :: Int
onePageUpPos = Int
srcWindowStart Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
vSpace Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 -- Plus one to preserve the top line.
    vSpace :: Int
vSpace = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (SourceWindow n e -> Maybe Int
forall name elem. SourceWindow name elem -> Maybe Int
srcWindowVerticalSpace SourceWindow n e
srcW)

-- | Set the selection to a given position, and scroll the window accordingly.
setSelectionTo
    :: (Ord n)
    => Int
    -- ^ Line number to set the selection to (1-indexed)
    -> SourceWindow n e
    -- ^ Source window to update.
    -> B.EventM n m (SourceWindow n e)
setSelectionTo :: forall n e m.
Ord n =>
Int -> SourceWindow n e -> EventM n m (SourceWindow n e)
setSelectionTo Int
pos SourceWindow n e
srcW = do
    SourceWindow n e
srcW' <- SourceWindow n e -> EventM n m (SourceWindow n e)
forall n e m.
Ord n =>
SourceWindow n e -> EventM n m (SourceWindow n e)
updateVerticalSpace SourceWindow n e
srcW
    case (SourceWindow n e -> Maybe Int
forall name elem. SourceWindow name elem -> Maybe Int
getLastRenderedLine SourceWindow n e
srcW', SourceWindow n e -> Maybe Int
forall name elem. SourceWindow name elem -> Maybe Int
srcSelectedLine SourceWindow n e
srcW') of
        (Just Int
end, Just Int
oldSelectedLine) -> do
            let delta :: Int
delta = Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
oldSelectedLine
            if Int
pos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< SourceWindow n e -> Int
forall name elem. SourceWindow name elem -> Int
srcWindowStart SourceWindow n e
srcW' Bool -> Bool -> Bool
|| Int
pos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
end
                then Int -> SourceWindow n e -> EventM n m (SourceWindow n e)
forall n e m.
Ord n =>
Int -> SourceWindow n e -> EventM n m (SourceWindow n e)
srcWindowMoveSelectionBy Int
delta SourceWindow n e
srcW
                else do
                    SourceWindow n e -> EventM n m (SourceWindow n e)
forall a. a -> EventM n m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SourceWindow n e -> EventM n m (SourceWindow n e))
-> SourceWindow n e -> EventM n m (SourceWindow n e)
forall a b. (a -> b) -> a -> b
$ SourceWindow n e
srcW{srcSelectedLine = Just pos}
        (Maybe Int, Maybe Int)
_ -> Int -> SourceWindow n e -> EventM n m (SourceWindow n e)
forall name elem m.
Int
-> SourceWindow name elem -> EventM name m (SourceWindow name elem)
setSelectionToFallback Int
pos SourceWindow n e
srcW'

-- | Fallback function for setting the source window selection line, when we can't set it properly.
setSelectionToFallback :: Int -> SourceWindow name elem -> B.EventM name m (SourceWindow name elem)
setSelectionToFallback :: forall name elem m.
Int
-> SourceWindow name elem -> EventM name m (SourceWindow name elem)
setSelectionToFallback Int
pos SourceWindow name elem
srcW = SourceWindow name elem -> EventM name m (SourceWindow name elem)
forall a. a -> EventM name m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SourceWindow name elem -> EventM name m (SourceWindow name elem))
-> SourceWindow name elem -> EventM name m (SourceWindow name elem)
forall a b. (a -> b) -> a -> b
$ SourceWindow name elem
srcW{srcSelectedLine = Just pos, srcWindowStart = pos}

-- | Move the selected line by a given amount.
srcWindowMoveSelectionBy
    :: (Ord n)
    => Int
    -- ^ Delta to move the selected line.
    -> SourceWindow n e
    -- ^ Source window to update.
    -> B.EventM n m (SourceWindow n e)
srcWindowMoveSelectionBy :: forall n e m.
Ord n =>
Int -> SourceWindow n e -> EventM n m (SourceWindow n e)
srcWindowMoveSelectionBy Int
amnt SourceWindow n e
sw = do
    SourceWindow n e
srcW <- SourceWindow n e -> EventM n m (SourceWindow n e)
forall n e m.
Ord n =>
SourceWindow n e -> EventM n m (SourceWindow n e)
updateVerticalSpace SourceWindow n e
sw
    case (SourceWindow n e -> Maybe Int
forall name elem. SourceWindow name elem -> Maybe Int
getLastRenderedLine SourceWindow n e
srcW, SourceWindow n e -> Maybe Int
forall name elem. SourceWindow name elem -> Maybe Int
srcWindowLineDiffCount SourceWindow n e
srcW, SourceWindow n e -> Maybe Int
forall name elem. SourceWindow name elem -> Maybe Int
srcSelectedLine SourceWindow n e
srcW) of
        (Just Int
end, Just Int
renderHeight, Just Int
oldSLine)
            | Int
newSLine Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< SourceWindow n e -> Int
forall name elem. SourceWindow name elem -> Int
srcWindowStart SourceWindow n e
srcW ->
                SourceWindow n e -> EventM n m (SourceWindow n e)
forall a. a -> EventM n m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SourceWindow n e -> EventM n m (SourceWindow n e))
-> SourceWindow n e -> EventM n m (SourceWindow n e)
forall a b. (a -> b) -> a -> b
$ Int -> SourceWindow n e -> SourceWindow n e
forall n e. Int -> SourceWindow n e -> SourceWindow n e
scrollTo Int
newSLine SourceWindow n e
srcW{srcSelectedLine = Just newSLine}
            | Int
newSLine Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
end ->
                SourceWindow n e -> EventM n m (SourceWindow n e)
forall a. a -> EventM n m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SourceWindow n e -> EventM n m (SourceWindow n e))
-> SourceWindow n e -> EventM n m (SourceWindow n e)
forall a b. (a -> b) -> a -> b
$ Int -> SourceWindow n e -> SourceWindow n e
forall n e. Int -> SourceWindow n e -> SourceWindow n e
scrollTo (Int
newSLine Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
renderHeight) SourceWindow n e
srcW{srcSelectedLine = Just newSLine}
            | Bool
otherwise -> SourceWindow n e -> EventM n m (SourceWindow n e)
forall a. a -> EventM n m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SourceWindow n e -> EventM n m (SourceWindow n e))
-> SourceWindow n e -> EventM n m (SourceWindow n e)
forall a b. (a -> b) -> a -> b
$ SourceWindow n e
srcW{srcSelectedLine = Just newSLine}
          where
            newSLine :: Int
newSLine = (Int, Int) -> Int -> Int
forall a. Ord a => (a, a) -> a -> a
Util.clamp (Int
1, Vector e -> Int
forall a. Vector a -> Int
Vec.length (SourceWindow n e -> Vector e
forall name elem. SourceWindow name elem -> Vector elem
srcElements SourceWindow n e
srcW)) (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
oldSLine Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
amnt
        (Maybe Int, Maybe Int, Maybe Int)
_ -> SourceWindow n e -> EventM n m (SourceWindow n e)
forall a. a -> EventM n m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SourceWindow n e
srcW

{- | Replace the contents of a given source window, and reset the pseudo-viewport's position
     to the top.
-}
srcWindowReplace :: (Foldable f) => f e -> SourceWindow n e -> SourceWindow n e
srcWindowReplace :: forall (f :: * -> *) e n.
Foldable f =>
f e -> SourceWindow n e -> SourceWindow n e
srcWindowReplace f e
foldable SourceWindow n e
srcW =
    SourceWindow n e
srcW{srcSelectedLine = Just 1, srcWindowStart = 1, srcElements = elems}
  where
    elems :: Vector e
elems = [e] -> Vector e
forall a. [a] -> Vector a
Vec.fromList ([e] -> Vector e) -> (f e -> [e]) -> f e -> Vector e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e -> [e] -> [e]) -> [e] -> f e -> [e]
forall a b. (a -> b -> b) -> b -> f a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (:) [] (f e -> Vector e) -> f e -> Vector e
forall a b. (a -> b) -> a -> b
$ f e
foldable

-- | Create a new source window from some text.
mkSourcWindow
    :: n
    -- ^ Name for the source window.
    -> T.Text
    -- ^ Text contents of the source window (to be split up).
    -> SourceWindow n T.Text
mkSourcWindow :: forall n. n -> Text -> SourceWindow n Text
mkSourcWindow n
sourceWindowName Text
text =
    SourceWindow
        { $sel:srcElements:SourceWindow :: Vector Text
srcElements = Vector Text
lineVec
        , $sel:srcWindowStart:SourceWindow :: Int
srcWindowStart = Int
1
        , $sel:srcSelectedLine:SourceWindow :: Maybe Int
srcSelectedLine = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1
        , $sel:srcName:SourceWindow :: n
srcName = n
sourceWindowName
        , $sel:srcWindowVerticalSpace:SourceWindow :: Maybe Int
srcWindowVerticalSpace = Maybe Int
forall a. Maybe a
Nothing
        }
  where
    lineVec :: Vector Text
lineVec = [Text] -> Vector Text
forall a. [a] -> Vector a
Vec.fromList (Text -> [Text]
T.lines Text
text)