module Vgrep.Widget.Results (
resultsWidget
, ResultsWidget
, Results ()
, feedResult
, resizeToWindow
, prevLine
, nextLine
, pageUp
, pageDown
, currentFileName
, currentLineNumber
, currentFileResults
, module Vgrep.Results
) where
import Control.Applicative
import Control.Lens.Compat
import Control.Monad.State.Extended
import Data.Foldable
import Data.Maybe
import Data.Monoid
import Data.Text (Text)
import qualified Data.Text as T
import Graphics.Vty.Attributes
import Graphics.Vty.Image hiding ((<|>))
import Vgrep.Ansi
import Vgrep.Environment
import Vgrep.Event
import Vgrep.Results
import Vgrep.Type
import Vgrep.Widget.Results.Internal as Internal
import Vgrep.Widget.Type
type ResultsWidget = Widget Results
resultsWidget :: ResultsWidget
resultsWidget =
Widget { initialize = initResults
, draw = renderResultList }
initResults :: Results
initResults = EmptyResults
feedResult :: Monad m => FileLineReference -> VgrepT Results m Redraw
feedResult line = do
modify (feed line)
resizeToWindow
pageUp, pageDown :: Monad m => VgrepT Results m ()
pageUp = do
unlessS (isJust . moveUp) $ do
modify (repeatedly (hideNext >=> showPrev))
void resizeToWindow
modify (repeatedly moveUp)
pageDown = do
unlessS (isJust . moveDown) $ do
modify (repeatedly hidePrev)
void resizeToWindow
modify (repeatedly moveDown)
repeatedly :: (a -> Maybe a) -> a -> a
repeatedly f = go
where
go x | Just x' <- f x = go x'
| otherwise = x
prevLine, nextLine :: Monad m => VgrepT Results m ()
prevLine = maybeModify tryPrevLine >> void resizeToWindow
nextLine = maybeModify tryNextLine >> void resizeToWindow
tryPrevLine, tryNextLine :: Results -> Maybe Results
tryPrevLine buf = moveUp buf <|> (showPrev buf >>= tryPrevLine)
tryNextLine buf = moveDown buf <|> (showNext buf >>= tryNextLine)
maybeModify :: Monad m => (s -> Maybe s) -> VgrepT s m ()
maybeModify f = do
s <- get
case f s of
Just s' -> put s'
Nothing -> pure ()
renderResultList :: Monad m => VgrepT Results m Image
renderResultList = do
void resizeToWindow
visibleLines <- use (to toLines)
width <- view viewportWidth
let render = renderLine width (lineNumberWidth visibleLines)
renderedLines <- traverse render visibleLines
pure (vertCat renderedLines)
where lineNumberWidth
= foldl' max 0
. map (twoExtraSpaces . length . show)
. mapMaybe displayLineNumber
twoExtraSpaces = (+ 2)
renderLine
:: Monad m
=> Int
-> Int
-> DisplayLine
-> VgrepT Results m Image
renderLine width lineNumberWidth displayLine = do
fileHeaderStyle <- view (config . colors . fileHeaders)
lineNumberStyle <- view (config . colors . lineNumbers)
resultLineStyle <- view (config . colors . normal)
selectedStyle <- view (config . colors . selected)
pure $ case displayLine of
FileHeader (File f)
-> renderFileHeader fileHeaderStyle f
Line (LineReference n t)
-> horizCat [ renderLineNumber lineNumberStyle n
, renderLineText resultLineStyle t ]
SelectedLine (LineReference n t)
-> horizCat [ renderLineNumber lineNumberStyle n
, renderLineText selectedStyle t ]
where
padWithSpace w = T.take (fromIntegral w)
. T.justifyLeft (fromIntegral w) ' '
. T.cons ' '
justifyRight w s = T.justifyRight (fromIntegral w) ' ' (s <> " ")
renderFileHeader :: Attr -> Text -> Image
renderFileHeader attr = text' attr . padWithSpace width
renderLineNumber :: Attr -> Maybe Int -> Image
renderLineNumber attr = text' attr
. justifyRight lineNumberWidth
. maybe "" (T.pack . show)
renderLineText :: Attr -> AnsiFormatted -> Image
renderLineText attr txt
= renderAnsi attr
. takeFormatted (width lineNumberWidth)
. padFormatted (width lineNumberWidth) ' '
$ cat [ bare " ", txt, bare (T.replicate width " ") ]
resizeToWindow :: Monad m => VgrepT Results m Redraw
resizeToWindow = do
height <- view viewportHeight
currentBuffer <- get
case Internal.resize height currentBuffer of
Just resizedBuffer -> put resizedBuffer >> pure Redraw
Nothing -> pure Unchanged