{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
module Vgrep.Widget.Pager (
    -- * Pager widget
      pagerWidget
    , PagerWidget

    -- ** Internal state
    , Pager ()

    -- ** Widget actions
    , moveToLine
    , scroll
    , scrollPage
    , scrollPageFraction
    , hScroll
    , replaceBufferContents
    ) where

import           Control.Applicative     (liftA2)
import           Control.Lens.Compat
import           Data.Foldable
import qualified Data.IntMap.Strict      as Map
import           Data.Sequence           (Seq, (><))
import qualified Data.Sequence           as Seq
import           Data.Text               (Text)
import qualified Data.Text               as T
import           Graphics.Vty.Attributes
import           Graphics.Vty.Image

import Vgrep.Ansi
import Vgrep.Environment
import Vgrep.Event
import Vgrep.Type
import Vgrep.Widget.Pager.Internal
import Vgrep.Widget.Type


type PagerWidget = Widget Pager

-- | Display lines of text with line numbers
--
-- * __Initial state__
--
--     The pager is empty, i. e. no lines of text to display.
--
-- * __Drawing the pager__
--
--     The lines of text are printed, starting at the current scroll
--     position. If not enough lines are available, the scroll position is
--     adjusted until either the screen is filled, or the first line is
--     reached. Highlighted lines are displayed according to the config
--     values 'normalHl' and 'lineNumbersHl' (default: bold).
pagerWidget :: PagerWidget
pagerWidget :: PagerWidget
pagerWidget = Widget :: forall s.
s
-> (forall (m :: * -> *). Monad m => VgrepT s m Image) -> Widget s
Widget
    { initialize :: Pager
initialize = Pager
initPager
    , draw :: forall (m :: * -> *). Monad m => VgrepT Pager m Image
draw       = forall (m :: * -> *). Monad m => VgrepT Pager m Image
renderPager }

initPager :: Pager
initPager :: Pager
initPager = Pager :: Int -> IntMap AnsiFormatted -> Seq Text -> Seq Text -> Pager
Pager
    { _column :: Int
_column      = Int
0
    , _highlighted :: IntMap AnsiFormatted
_highlighted = IntMap AnsiFormatted
forall a. IntMap a
Map.empty
    , _above :: Seq Text
_above       = Seq Text
forall a. Seq a
Seq.empty
    , _visible :: Seq Text
_visible     = Seq Text
forall a. Seq a
Seq.empty }


-- | Replace the currently displayed text.
replaceBufferContents
    :: Monad m
    => Seq Text -- ^ Lines of text to display in the pager (starting with line 1)
    -> Map.IntMap AnsiFormatted -- ^ Line numbers and formatted text for highlighted lines
    -> VgrepT Pager m ()
replaceBufferContents :: Seq Text -> IntMap AnsiFormatted -> VgrepT Pager m ()
replaceBufferContents Seq Text
newContent IntMap AnsiFormatted
newHighlightedLines = Pager -> VgrepT Pager m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put Pager
initPager
    { _visible :: Seq Text
_visible     = Seq Text
newContent
    , _highlighted :: IntMap AnsiFormatted
_highlighted = IntMap AnsiFormatted
newHighlightedLines }

-- | Scroll to the given line number.
moveToLine :: Monad m => Int -> VgrepT Pager m Redraw
moveToLine :: Int -> VgrepT Pager m Redraw
moveToLine Int
n = Getting Int Environment Int -> VgrepT Pager m Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int Environment Int
Lens' Environment Int
viewportHeight VgrepT Pager m Int
-> (Int -> VgrepT Pager m Redraw) -> VgrepT Pager m Redraw
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
height -> do
    Int -> VgrepT Pager m ()
forall (m :: * -> *). Monad m => Int -> VgrepT Pager m ()
setPosition (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
height Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2)
    Redraw -> VgrepT Pager m Redraw
forall (f :: * -> *) a. Applicative f => a -> f a
pure Redraw
Redraw

-- | Scroll up or down one line.
--
-- > scroll (-1)  -- scroll one line up
-- > scroll 1     -- scroll one line down
scroll :: Monad m => Int -> VgrepT Pager m Redraw
scroll :: Int -> VgrepT Pager m Redraw
scroll Int
n = do
    Int
pos <- Getting Int Pager Int -> VgrepT Pager m Int
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Int Pager Int
Getter Pager Int
position
    Int -> VgrepT Pager m ()
forall (m :: * -> *). Monad m => Int -> VgrepT Pager m ()
setPosition (Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)
    Redraw -> VgrepT Pager m Redraw
forall (f :: * -> *) a. Applicative f => a -> f a
pure Redraw
Redraw

setPosition :: Monad m => Int -> VgrepT Pager m ()
setPosition :: Int -> VgrepT Pager m ()
setPosition Int
n = Getting Int Environment Int -> VgrepT Pager m Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int Environment Int
Lens' Environment Int
viewportHeight VgrepT Pager m Int
-> (Int -> VgrepT Pager m ()) -> VgrepT Pager m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
height -> do
    Int
allLines <- (Int -> Int -> Int)
-> VgrepT Pager m Int -> VgrepT Pager m Int -> VgrepT Pager m Int
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) (Getting Int Pager Int -> VgrepT Pager m Int
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((Seq Text -> Const Int (Seq Text)) -> Pager -> Const Int Pager
Lens' Pager (Seq Text)
visible ((Seq Text -> Const Int (Seq Text)) -> Pager -> Const Int Pager)
-> ((Int -> Const Int Int) -> Seq Text -> Const Int (Seq Text))
-> Getting Int Pager Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Seq Text -> Int) -> SimpleGetter (Seq Text) Int
forall s a. (s -> a) -> SimpleGetter s a
to Seq Text -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length)) (Getting Int Pager Int -> VgrepT Pager m Int
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((Seq Text -> Const Int (Seq Text)) -> Pager -> Const Int Pager
Lens' Pager (Seq Text)
above ((Seq Text -> Const Int (Seq Text)) -> Pager -> Const Int Pager)
-> ((Int -> Const Int Int) -> Seq Text -> Const Int (Seq Text))
-> Getting Int Pager Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Seq Text -> Int) -> SimpleGetter (Seq Text) Int
forall s a. (s -> a) -> SimpleGetter s a
to Seq Text -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length))
    let newPosition :: Int
newPosition = if
            | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
allLines Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
height -> Int
0
            | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
allLines Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
height      -> Int
allLines Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
height
            | Bool
otherwise                  -> Int
n
    (Pager -> Pager) -> VgrepT Pager m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Pager -> Pager) -> VgrepT Pager m ())
-> (Pager -> Pager) -> VgrepT Pager m ()
forall a b. (a -> b) -> a -> b
$ \pager :: Pager
pager@Pager{Int
IntMap AnsiFormatted
Seq Text
_visible :: Seq Text
_above :: Seq Text
_highlighted :: IntMap AnsiFormatted
_column :: Int
_visible :: Pager -> Seq Text
_above :: Pager -> Seq Text
_highlighted :: Pager -> IntMap AnsiFormatted
_column :: Pager -> Int
..} ->
        let (Seq Text
newAbove, Seq Text
newVisible) = Int -> Seq Text -> (Seq Text, Seq Text)
forall a. Int -> Seq a -> (Seq a, Seq a)
Seq.splitAt Int
newPosition (Seq Text
_above Seq Text -> Seq Text -> Seq Text
forall a. Seq a -> Seq a -> Seq a
>< Seq Text
_visible)
        in  Pager
pager
            { _above :: Seq Text
_above    = Seq Text
newAbove
            , _visible :: Seq Text
_visible  = Seq Text
newVisible }

-- | Scroll up or down one page. The first line on the current screen will
-- be the last line on the scrolled screen and vice versa.
--
-- > scrollPage (-1)  -- scroll one page up
-- > scrollPage 1     -- scroll one page down
scrollPage :: Monad m => Int -> VgrepT Pager m Redraw
scrollPage :: Int -> VgrepT Pager m Redraw
scrollPage Int
n = Getting Int Environment Int -> VgrepT Pager m Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int Environment Int
Lens' Environment Int
viewportHeight VgrepT Pager m Int
-> (Int -> VgrepT Pager m Redraw) -> VgrepT Pager m Redraw
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
height ->
    Int -> VgrepT Pager m Redraw
forall (m :: * -> *). Monad m => Int -> VgrepT Pager m Redraw
scroll (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
height Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
  -- gracefully leave one ^ line on the screen

-- | Scroll up or down a fraction of a page. For integers,
-- 'scrollPageFraction n == scrollPage n'.
--
-- > scrollPageFraction (-1%2)            -- scroll one half page up
-- > scrollPageFraction (1%2)             -- scroll one half page down
-- > scrollPageFraction (fromRational 1)  -- scroll one page down
scrollPageFraction :: Monad m => Rational -> VgrepT Pager m Redraw
scrollPageFraction :: Rational -> VgrepT Pager m Redraw
scrollPageFraction Rational
a = Getting Int Environment Int -> VgrepT Pager m Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int Environment Int
Lens' Environment Int
viewportHeight VgrepT Pager m Int
-> (Int -> VgrepT Pager m Redraw) -> VgrepT Pager m Redraw
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
height ->
    Int -> VgrepT Pager m Redraw
forall (m :: * -> *). Monad m => Int -> VgrepT Pager m Redraw
scroll (Rational -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Rational
a Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* (Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
1)))
                      -- gracefully leave one ^ line on the screen

-- | Horizontal scrolling. Increment is one 'tabstop'.
--
-- > hScroll (-1)  -- scroll one tabstop left
-- > hScroll 1     -- scroll one tabstop right
hScroll :: Monad m => Int -> VgrepT Pager m Redraw
hScroll :: Int -> VgrepT Pager m Redraw
hScroll Int
n = do
    Int
tabWidth <- Getting Int Environment Int -> VgrepT Pager m Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Config -> Const Int Config)
-> Environment -> Const Int Environment
Lens' Environment Config
config ((Config -> Const Int Config)
 -> Environment -> Const Int Environment)
-> ((Int -> Const Int Int) -> Config -> Const Int Config)
-> Getting Int Environment Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> Config -> Const Int Config
Lens' Config Int
tabstop)
    ASetter Pager Pager Int Int -> (Int -> Int) -> VgrepT Pager m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
modifying ASetter Pager Pager Int Int
Lens' Pager Int
column ((Int -> Int) -> VgrepT Pager m ())
-> (Int -> Int) -> VgrepT Pager m ()
forall a b. (a -> b) -> a -> b
$ \Int
currentColumn ->
        let newColumn :: Int
newColumn = Int
currentColumn Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
tabWidth
        in  if Int
newColumn Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then Int
newColumn else Int
0
    Redraw -> VgrepT Pager m Redraw
forall (f :: * -> *) a. Applicative f => a -> f a
pure Redraw
Redraw


renderPager :: Monad m => VgrepT Pager m Image
renderPager :: VgrepT Pager m Image
renderPager = do
    Attr
textColor         <- Getting Attr Environment Attr -> VgrepT Pager m Attr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Config -> Const Attr Config)
-> Environment -> Const Attr Environment
Lens' Environment Config
config ((Config -> Const Attr Config)
 -> Environment -> Const Attr Environment)
-> ((Attr -> Const Attr Attr) -> Config -> Const Attr Config)
-> Getting Attr Environment Attr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Colors -> Const Attr Colors) -> Config -> Const Attr Config
Lens' Config Colors
colors ((Colors -> Const Attr Colors) -> Config -> Const Attr Config)
-> ((Attr -> Const Attr Attr) -> Colors -> Const Attr Colors)
-> (Attr -> Const Attr Attr)
-> Config
-> Const Attr Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Attr -> Const Attr Attr) -> Colors -> Const Attr Colors
Lens' Colors Attr
normal)
    Attr
textColorHl       <- Getting Attr Environment Attr -> VgrepT Pager m Attr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Config -> Const Attr Config)
-> Environment -> Const Attr Environment
Lens' Environment Config
config ((Config -> Const Attr Config)
 -> Environment -> Const Attr Environment)
-> ((Attr -> Const Attr Attr) -> Config -> Const Attr Config)
-> Getting Attr Environment Attr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Colors -> Const Attr Colors) -> Config -> Const Attr Config
Lens' Config Colors
colors ((Colors -> Const Attr Colors) -> Config -> Const Attr Config)
-> ((Attr -> Const Attr Attr) -> Colors -> Const Attr Colors)
-> (Attr -> Const Attr Attr)
-> Config
-> Const Attr Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Attr -> Const Attr Attr) -> Colors -> Const Attr Colors
Lens' Colors Attr
normalHl)
    Attr
lineNumberColor   <- Getting Attr Environment Attr -> VgrepT Pager m Attr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Config -> Const Attr Config)
-> Environment -> Const Attr Environment
Lens' Environment Config
config ((Config -> Const Attr Config)
 -> Environment -> Const Attr Environment)
-> ((Attr -> Const Attr Attr) -> Config -> Const Attr Config)
-> Getting Attr Environment Attr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Colors -> Const Attr Colors) -> Config -> Const Attr Config
Lens' Config Colors
colors ((Colors -> Const Attr Colors) -> Config -> Const Attr Config)
-> ((Attr -> Const Attr Attr) -> Colors -> Const Attr Colors)
-> (Attr -> Const Attr Attr)
-> Config
-> Const Attr Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Attr -> Const Attr Attr) -> Colors -> Const Attr Colors
Lens' Colors Attr
lineNumbers)
    Attr
lineNumberColorHl <- Getting Attr Environment Attr -> VgrepT Pager m Attr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Config -> Const Attr Config)
-> Environment -> Const Attr Environment
Lens' Environment Config
config ((Config -> Const Attr Config)
 -> Environment -> Const Attr Environment)
-> ((Attr -> Const Attr Attr) -> Config -> Const Attr Config)
-> Getting Attr Environment Attr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Colors -> Const Attr Colors) -> Config -> Const Attr Config
Lens' Config Colors
colors ((Colors -> Const Attr Colors) -> Config -> Const Attr Config)
-> ((Attr -> Const Attr Attr) -> Colors -> Const Attr Colors)
-> (Attr -> Const Attr Attr)
-> Config
-> Const Attr Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Attr -> Const Attr Attr) -> Colors -> Const Attr Colors
Lens' Colors Attr
lineNumbersHl)
    Int
width             <- Getting Int Environment Int -> VgrepT Pager m Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int Environment Int
Lens' Environment Int
viewportWidth
    Int
height            <- Getting Int Environment Int -> VgrepT Pager m Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int Environment Int
Lens' Environment Int
viewportHeight
    Int
startPosition     <- Getting Int Pager Int -> VgrepT Pager m Int
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Int Pager Int
Getter Pager Int
position
    Int
startColumn       <- Getting Int Pager Int -> VgrepT Pager m Int
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting Int Pager Int
Lens' Pager Int
column Getting Int Pager Int
-> ((Int -> Const Int Int) -> Int -> Const Int Int)
-> Getting Int Pager Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int) -> SimpleGetter Int Int
forall s a. (s -> a) -> SimpleGetter s a
to Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
    [Text]
visibleLines      <- Getting [Text] Pager [Text] -> VgrepT Pager m [Text]
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((Seq Text -> Const [Text] (Seq Text))
-> Pager -> Const [Text] Pager
Lens' Pager (Seq Text)
visible ((Seq Text -> Const [Text] (Seq Text))
 -> Pager -> Const [Text] Pager)
-> (([Text] -> Const [Text] [Text])
    -> Seq Text -> Const [Text] (Seq Text))
-> Getting [Text] Pager [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Seq Text -> Seq Text) -> SimpleGetter (Seq Text) (Seq Text)
forall s a. (s -> a) -> SimpleGetter s a
to (Int -> Seq Text -> Seq Text
forall a. Int -> Seq a -> Seq a
Seq.take Int
height) Getting [Text] (Seq Text) (Seq Text)
-> (([Text] -> Const [Text] [Text])
    -> Seq Text -> Const [Text] (Seq Text))
-> ([Text] -> Const [Text] [Text])
-> Seq Text
-> Const [Text] (Seq Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Seq Text -> [Text]) -> SimpleGetter (Seq Text) [Text]
forall s a. (s -> a) -> SimpleGetter s a
to Seq Text -> [Text]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList)
    IntMap AnsiFormatted
highlightedLines  <- Getting (IntMap AnsiFormatted) Pager (IntMap AnsiFormatted)
-> VgrepT Pager m (IntMap AnsiFormatted)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (IntMap AnsiFormatted) Pager (IntMap AnsiFormatted)
Lens' Pager (IntMap AnsiFormatted)
highlighted

    let (Image
renderedLineNumbers, Image
renderedTextLines)
            = ASetter ([Image], [Image]) (Image, Image) [Image] Image
-> ([Image] -> Image) -> ([Image], [Image]) -> (Image, Image)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter ([Image], [Image]) (Image, Image) [Image] Image
forall a b. Traversal (a, a) (b, b) a b
both [Image] -> Image
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
            (([Image], [Image]) -> (Image, Image))
-> ([(Image, Image)] -> ([Image], [Image]))
-> [(Image, Image)]
-> (Image, Image)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Image, Image)] -> ([Image], [Image])
forall a b. [(a, b)] -> ([a], [b])
unzip
            ([(Image, Image)] -> (Image, Image))
-> [(Image, Image)] -> (Image, Image)
forall a b. (a -> b) -> a -> b
$ (Int -> Text -> (Image, Image))
-> [Int] -> [Text] -> [(Image, Image)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Text -> (Image, Image)
renderLine [Int
startPositionInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1..] [Text]
visibleLines
          where
            renderLine :: Int -> Text -> (Image, Image)
            renderLine :: Int -> Text -> (Image, Image)
renderLine Int
num Text
txt = case Int -> IntMap AnsiFormatted -> Maybe AnsiFormatted
forall a. Int -> IntMap a -> Maybe a
Map.lookup Int
num IntMap AnsiFormatted
highlightedLines of
                Just AnsiFormatted
formatted -> ( Attr -> Int -> Image
renderLineNumber Attr
lineNumberColorHl Int
num
                                  , Attr -> AnsiFormatted -> Image
renderFormatted Attr
textColorHl AnsiFormatted
formatted )
                Maybe AnsiFormatted
Nothing        -> ( Attr -> Int -> Image
renderLineNumber Attr
lineNumberColor Int
num
                                  , Attr -> Text -> Image
renderLineText Attr
textColor Text
txt )

            renderLineNumber :: Attr -> Int -> Image
            renderLineNumber :: Attr -> Int -> Image
renderLineNumber Attr
attr
                = Attr -> Text -> Image
text' Attr
attr
                (Text -> Image) -> (Int -> Text) -> Int -> Image
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Char -> Text
`T.snoc` Char
' ')
                (Text -> Text) -> (Int -> Text) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text -> Text
T.cons Char
' '
                (Text -> Text) -> (Int -> Text) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
                (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show

            renderLineText :: Attr -> Text -> Image
            renderLineText :: Attr -> Text -> Image
renderLineText   Attr
attr
                = Attr -> Text -> Image
text' Attr
attr
                (Text -> Image) -> (Text -> Text) -> Text -> Image
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char -> Text -> Text
T.justifyLeft Int
width Char
' '
                (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
T.take Int
width
                (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text -> Text
T.cons Char
' '
                (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
T.drop Int
startColumn

            renderFormatted :: Attr -> AnsiFormatted -> Image
            renderFormatted :: Attr -> AnsiFormatted -> Image
renderFormatted  Attr
attr
                = Attr -> AnsiFormatted -> Image
renderAnsi Attr
attr
                (AnsiFormatted -> Image)
-> (AnsiFormatted -> AnsiFormatted) -> AnsiFormatted -> Image
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char -> AnsiFormatted -> AnsiFormatted
forall a. Int -> Char -> Formatted a -> Formatted a
padFormatted Int
width Char
' '
                (AnsiFormatted -> AnsiFormatted)
-> (AnsiFormatted -> AnsiFormatted)
-> AnsiFormatted
-> AnsiFormatted
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> AnsiFormatted -> AnsiFormatted
forall a. Int -> Formatted a -> Formatted a
takeFormatted Int
width
                (AnsiFormatted -> AnsiFormatted)
-> (AnsiFormatted -> AnsiFormatted)
-> AnsiFormatted
-> AnsiFormatted
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> AnsiFormatted
forall attr. Text -> Formatted attr
bare Text
" " AnsiFormatted -> AnsiFormatted -> AnsiFormatted
forall a. Semigroup a => a -> a -> a
<>)
                (AnsiFormatted -> AnsiFormatted)
-> (AnsiFormatted -> AnsiFormatted)
-> AnsiFormatted
-> AnsiFormatted
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> AnsiFormatted -> AnsiFormatted
forall a. Int -> Formatted a -> Formatted a
dropFormatted Int
startColumn


    Image -> VgrepT Pager m Image
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Image -> Image
resizeWidth Int
width (Image
renderedLineNumbers Image -> Image -> Image
<|> Image
renderedTextLines))