{-# LANGUAGE TemplateHaskell #-}
module Vgrep.Widget.Pager.Internal (
    -- * Pager widget state
      Pager (..)

    -- * Lenses
    , position
    -- ** Auto-generated lenses
    , column
    , above
    , visible
    , highlighted
    ) where

import Control.Lens.Compat
import Data.IntMap.Strict  (IntMap)
import Data.Sequence       (Seq)
import Data.Text           (Text)

import Vgrep.Ansi


-- | Keeps track of the lines of text to display, the current scroll
-- positions, and the set of highlighted line numbers.
data Pager = Pager
    { Pager -> Int
_column      :: Int
    -- ^ The current column offset for horizontal scrolling

    , Pager -> IntMap AnsiFormatted
_highlighted :: IntMap AnsiFormatted
    -- ^ Set of line numbers that are highlighted (i.e. they contain matches)

    , Pager -> Seq Text
_above       :: Seq Text
    -- ^ Zipper: Lines above the screen

    , Pager -> Seq Text
_visible     :: Seq Text
    -- ^ Zipper: Lines on screen and below

    } deriving (Pager -> Pager -> Bool
(Pager -> Pager -> Bool) -> (Pager -> Pager -> Bool) -> Eq Pager
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pager -> Pager -> Bool
$c/= :: Pager -> Pager -> Bool
== :: Pager -> Pager -> Bool
$c== :: Pager -> Pager -> Bool
Eq, Int -> Pager -> ShowS
[Pager] -> ShowS
Pager -> String
(Int -> Pager -> ShowS)
-> (Pager -> String) -> ([Pager] -> ShowS) -> Show Pager
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pager] -> ShowS
$cshowList :: [Pager] -> ShowS
show :: Pager -> String
$cshow :: Pager -> String
showsPrec :: Int -> Pager -> ShowS
$cshowsPrec :: Int -> Pager -> ShowS
Show)

makeLenses ''Pager

-- | The number of invisible lines above the screen
position :: Getter Pager Int
position :: Getting r Pager Int
position = (Seq Text -> Const r (Seq Text)) -> Pager -> Const r Pager
Lens' Pager (Seq Text)
above ((Seq Text -> Const r (Seq Text)) -> Pager -> Const r Pager)
-> ((Int -> Const r Int) -> Seq Text -> Const r (Seq Text))
-> Getting r 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