module Vgrep.Widget.Results.Internal (
    -- * Results widget state
      Results (..)

    -- * Lenses
    , currentFileName
    , currentLineNumber
    , currentFileResults

    -- * Actions
    -- | In general, actions return @'Just' newResults@ if the buffer has
    -- changed, and @'Nothing'@ otherwise. This way it is easy to recognize
    -- whether or not a 'Vgrep.Event.Redraw' is necessary.
    , feed
    , showPrev, showNext
    , hidePrev, hideNext
    , moveUp, moveDown
    , resize

    -- * Utilities for displaying
    , DisplayLine(..)
    , toLines
    , displayLineNumber
    ) where

import           Control.Applicative
import           Control.Lens.Compat
import           Data.Foldable
import           Data.Function
import           Data.IntMap.Strict  (IntMap)
import qualified Data.IntMap.Strict  as Map
import           Data.List           (groupBy)
import           Data.Maybe
import           Data.Monoid
import           Data.Sequence
    ( Seq
    , ViewL (..)
    , ViewR (..)
    , viewl
    , viewr
    , (<|)
    , (|>)
    )
import qualified Data.Sequence       as S
import           Data.Text           (Text)
import           Prelude             hiding (reverse)

import Vgrep.Ansi    (AnsiFormatted)
import Vgrep.Results


-- | Results widget state
data Results
    = EmptyResults
    -- ^ The results list is empty

    | Results
        !(Seq FileLineReference) -- above screen (reversed)
        !(Seq FileLineReference) -- top of screen (reversed)
        !FileLineReference       -- currently selected
        !(Seq FileLineReference) -- bottom of screen
        !(Seq FileLineReference) -- below screen
    -- ^ The structure of the Results buffer is a double Zipper:
    --
    -- * lines above the current screen
    -- * lines on screen above the current item
    -- * the current item
    -- * lines on screen below the current item
    -- * lines below the current screen

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


-- | Append a line to the 'Results'. The line is appended below the visible
-- screen, so use 'showNext' to make it visible.
feed :: FileLineReference -> Results -> Results
feed :: FileLineReference -> Results -> Results
feed FileLineReference
l = \case
    Results
EmptyResults          -> Seq FileLineReference
-> Seq FileLineReference
-> FileLineReference
-> Seq FileLineReference
-> Seq FileLineReference
-> Results
Results Seq FileLineReference
forall (f :: * -> *) a. Alternative f => f a
empty Seq FileLineReference
forall (f :: * -> *) a. Alternative f => f a
empty FileLineReference
l Seq FileLineReference
forall (f :: * -> *) a. Alternative f => f a
empty Seq FileLineReference
forall (f :: * -> *) a. Alternative f => f a
empty
    Results Seq FileLineReference
as Seq FileLineReference
bs FileLineReference
c Seq FileLineReference
ds Seq FileLineReference
es -> Seq FileLineReference
-> Seq FileLineReference
-> FileLineReference
-> Seq FileLineReference
-> Seq FileLineReference
-> Results
Results Seq FileLineReference
as Seq FileLineReference
bs FileLineReference
c Seq FileLineReference
ds (Seq FileLineReference
es Seq FileLineReference -> FileLineReference -> Seq FileLineReference
forall a. Seq a -> a -> Seq a
|> FileLineReference
l)


-- | Reverse the 'Results'
reverse :: Results -> Results
reverse :: Results -> Results
reverse = \case
    Results Seq FileLineReference
as Seq FileLineReference
bs FileLineReference
c Seq FileLineReference
ds Seq FileLineReference
es -> Seq FileLineReference
-> Seq FileLineReference
-> FileLineReference
-> Seq FileLineReference
-> Seq FileLineReference
-> Results
Results Seq FileLineReference
es Seq FileLineReference
ds FileLineReference
c Seq FileLineReference
bs Seq FileLineReference
as
    Results
EmptyResults          -> Results
EmptyResults

-- | Show one more item at the bottom of the screen if available.
showNext :: Results -> Maybe Results
showNext :: Results -> Maybe Results
showNext = \case
    Results Seq FileLineReference
as Seq FileLineReference
bs FileLineReference
c Seq FileLineReference
ds Seq FileLineReference
es -> do FileLineReference
e :< Seq FileLineReference
es' <- ViewL FileLineReference -> Maybe (ViewL FileLineReference)
forall a. a -> Maybe a
Just (Seq FileLineReference -> ViewL FileLineReference
forall a. Seq a -> ViewL a
viewl Seq FileLineReference
es)
                                Results -> Maybe Results
forall a. a -> Maybe a
Just (Seq FileLineReference
-> Seq FileLineReference
-> FileLineReference
-> Seq FileLineReference
-> Seq FileLineReference
-> Results
Results Seq FileLineReference
as Seq FileLineReference
bs FileLineReference
c (Seq FileLineReference
ds Seq FileLineReference -> FileLineReference -> Seq FileLineReference
forall a. Seq a -> a -> Seq a
|> FileLineReference
e) Seq FileLineReference
es')
    Results
EmptyResults          -> Maybe Results
forall a. Maybe a
Nothing

-- | Show one more item at the top of the screen if available.
showPrev :: Results -> Maybe Results
showPrev :: Results -> Maybe Results
showPrev = (Results -> Results) -> Maybe Results -> Maybe Results
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Results -> Results
reverse (Maybe Results -> Maybe Results)
-> (Results -> Maybe Results) -> Results -> Maybe Results
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Results -> Maybe Results
showNext (Results -> Maybe Results)
-> (Results -> Results) -> Results -> Maybe Results
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Results -> Results
reverse

-- | Remove the last item from the bottom of the screen and prepend it to
-- the invisible items below.
hideNext :: Results -> Maybe Results
hideNext :: Results -> Maybe Results
hideNext = \case
    Results Seq FileLineReference
as Seq FileLineReference
bs FileLineReference
c Seq FileLineReference
ds Seq FileLineReference
es -> do Seq FileLineReference
ds' :> FileLineReference
d <- ViewR FileLineReference -> Maybe (ViewR FileLineReference)
forall a. a -> Maybe a
Just (Seq FileLineReference -> ViewR FileLineReference
forall a. Seq a -> ViewR a
viewr Seq FileLineReference
ds)
                                Results -> Maybe Results
forall a. a -> Maybe a
Just (Seq FileLineReference
-> Seq FileLineReference
-> FileLineReference
-> Seq FileLineReference
-> Seq FileLineReference
-> Results
Results Seq FileLineReference
as Seq FileLineReference
bs FileLineReference
c Seq FileLineReference
ds' (FileLineReference
d FileLineReference -> Seq FileLineReference -> Seq FileLineReference
forall a. a -> Seq a -> Seq a
<| Seq FileLineReference
es))
    Results
EmptyResults          -> Maybe Results
forall a. Maybe a
Nothing

-- | Remove the first item from the top of the screen and append it to the
-- invisible items above.
hidePrev :: Results -> Maybe Results
hidePrev :: Results -> Maybe Results
hidePrev = (Results -> Results) -> Maybe Results -> Maybe Results
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Results -> Results
reverse (Maybe Results -> Maybe Results)
-> (Results -> Maybe Results) -> Results -> Maybe Results
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Results -> Maybe Results
hideNext (Results -> Maybe Results)
-> (Results -> Results) -> Results -> Maybe Results
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Results -> Results
reverse

-- | Move the cursor one item down.
moveDown :: Results -> Maybe Results
moveDown :: Results -> Maybe Results
moveDown = \case
    Results Seq FileLineReference
as Seq FileLineReference
bs FileLineReference
c Seq FileLineReference
ds Seq FileLineReference
es -> do FileLineReference
d :< Seq FileLineReference
ds' <- ViewL FileLineReference -> Maybe (ViewL FileLineReference)
forall a. a -> Maybe a
Just (Seq FileLineReference -> ViewL FileLineReference
forall a. Seq a -> ViewL a
viewl Seq FileLineReference
ds)
                                Results -> Maybe Results
forall a. a -> Maybe a
Just (Seq FileLineReference
-> Seq FileLineReference
-> FileLineReference
-> Seq FileLineReference
-> Seq FileLineReference
-> Results
Results Seq FileLineReference
as (FileLineReference
c FileLineReference -> Seq FileLineReference -> Seq FileLineReference
forall a. a -> Seq a -> Seq a
<| Seq FileLineReference
bs) FileLineReference
d Seq FileLineReference
ds' Seq FileLineReference
es)
    Results
EmptyResults          -> Maybe Results
forall a. Maybe a
Nothing

-- | Move the cursor one item up.
moveUp :: Results -> Maybe Results
moveUp :: Results -> Maybe Results
moveUp = (Results -> Results) -> Maybe Results -> Maybe Results
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Results -> Results
reverse (Maybe Results -> Maybe Results)
-> (Results -> Maybe Results) -> Results -> Maybe Results
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Results -> Maybe Results
moveDown (Results -> Maybe Results)
-> (Results -> Results) -> Results -> Maybe Results
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Results -> Results
reverse

-- | Adjust the number of on-screen items to the given height:
--
-- * If the current list is too long for the new height, take items from
-- the top until the current item is topmost, then from the bottom.
-- * If the current list is too short for the new height, add items below
-- until the buffer is empty, then above.
resize
    :: Int           -- ^ the new height
    -> Results
    -> Maybe Results -- ^ @'Nothing'@ if the height has not changed,
                     -- @'Just' newResults@ otherwise
resize :: Int -> Results -> Maybe Results
resize Int
height Results
buffer
    | Results -> Int
visibleHeight Results
buffer Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
height Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 = Results -> Maybe Results
forall a. a -> Maybe a
Just (Results -> Results
doResize Results
buffer)
    | Results -> Int
visibleHeight Results
buffer Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
height     = Results -> Maybe Results
forall a. a -> Maybe a
Just (Results -> Results
doResize Results
buffer)
    | Bool
otherwise                         = Maybe Results
forall a. Maybe a
Nothing
  where
    doResize :: Results -> Results
doResize Results
buf
        -- FIXME we need some kind of bias
        -- to avoid running into an infinite
        -- loop, but this leaves some nasty
        -- artifacts when scrolling over the
        -- last line. -----------------v
        | Results -> Int
visibleHeight Results
buf Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
height Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
        = Results -> (Results -> Results) -> Maybe Results -> Results
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Results
buf Results -> Results
doResize (Results -> Maybe Results
showNext Results
buf Maybe Results -> Maybe Results -> Maybe Results
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Results -> Maybe Results
showPrev Results
buf)

        | Results -> Int
visibleHeight Results
buf Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
height
        = Results -> (Results -> Results) -> Maybe Results -> Results
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Results
buf Results -> Results
doResize (Results -> Maybe Results
hidePrev Results
buf Maybe Results -> Maybe Results -> Maybe Results
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Results -> Maybe Results
hideNext Results
buf)

        | Bool
otherwise
        = Results
buf

visibleHeight :: Results -> Int
visibleHeight :: Results -> Int
visibleHeight = [DisplayLine] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([DisplayLine] -> Int)
-> (Results -> [DisplayLine]) -> Results -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Results -> [DisplayLine]
toLines


-- | Ad-hoc data structure to render the (visible) 'Results' as list of
-- lines.
data DisplayLine = FileHeader   File
                 | Line         LineReference
                 | SelectedLine LineReference
                 deriving (DisplayLine -> DisplayLine -> Bool
(DisplayLine -> DisplayLine -> Bool)
-> (DisplayLine -> DisplayLine -> Bool) -> Eq DisplayLine
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DisplayLine -> DisplayLine -> Bool
$c/= :: DisplayLine -> DisplayLine -> Bool
== :: DisplayLine -> DisplayLine -> Bool
$c== :: DisplayLine -> DisplayLine -> Bool
Eq)

-- | Converts the visible 'Results' to a list of 'DisplayLine's.  Each item
-- in the returned list corresponds to a line on the screen.
--
-- Each group of 'Line's that points to the same file is prepended with
-- a 'FileHeader'. The item below the cursor becomes a 'SelectedLine'.
toLines :: Results -> [DisplayLine]
toLines :: Results -> [DisplayLine]
toLines Results
EmptyResults          = []
toLines (Results Seq FileLineReference
_ Seq FileLineReference
bs FileLineReference
c Seq FileLineReference
ds Seq FileLineReference
_) = [DisplayLine]
linesBefore [DisplayLine] -> [DisplayLine] -> [DisplayLine]
forall a. Semigroup a => a -> a -> a
<> FileLineReference -> [DisplayLine]
selected FileLineReference
c [DisplayLine] -> [DisplayLine] -> [DisplayLine]
forall a. Semigroup a => a -> a -> a
<> [DisplayLine]
linesAfter

  where
    linesBefore :: [DisplayLine]
linesBefore = case Seq FileLineReference -> ViewL FileLineReference
forall a. Seq a -> ViewL a
viewl Seq FileLineReference
bs of
        FileLineReference
b :< Seq FileLineReference
_     | FileLineReference
b FileLineReference -> FileLineReference -> Bool
`pointsToSameFile` FileLineReference
c -> Seq FileLineReference -> [DisplayLine]
forall (t :: * -> *).
Foldable t =>
t FileLineReference -> [DisplayLine]
go (Seq FileLineReference -> Seq FileLineReference
forall a. Seq a -> Seq a
S.reverse Seq FileLineReference
bs)
        ViewL FileLineReference
_otherwise -> Seq FileLineReference -> [DisplayLine]
forall (t :: * -> *).
Foldable t =>
t FileLineReference -> [DisplayLine]
go (Seq FileLineReference -> Seq FileLineReference
forall a. Seq a -> Seq a
S.reverse Seq FileLineReference
bs) [DisplayLine] -> [DisplayLine] -> [DisplayLine]
forall a. Semigroup a => a -> a -> a
<> FileLineReference -> [DisplayLine]
header FileLineReference
c

    linesAfter :: [DisplayLine]
linesAfter = case Seq FileLineReference -> ViewL FileLineReference
forall a. Seq a -> ViewL a
viewl Seq FileLineReference
ds of
        FileLineReference
d :< Seq FileLineReference
_     | FileLineReference
c FileLineReference -> FileLineReference -> Bool
`pointsToSameFile` FileLineReference
d -> Int -> [DisplayLine] -> [DisplayLine]
forall a. Int -> [a] -> [a]
drop Int
1 (Seq FileLineReference -> [DisplayLine]
forall (t :: * -> *).
Foldable t =>
t FileLineReference -> [DisplayLine]
go Seq FileLineReference
ds)
        ViewL FileLineReference
_otherwise -> Seq FileLineReference -> [DisplayLine]
forall (t :: * -> *).
Foldable t =>
t FileLineReference -> [DisplayLine]
go Seq FileLineReference
ds

    go :: t FileLineReference -> [DisplayLine]
go t FileLineReference
refs = do
        [FileLineReference]
fileResults <- (FileLineReference -> FileLineReference -> Bool)
-> [FileLineReference] -> [[FileLineReference]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy FileLineReference -> FileLineReference -> Bool
pointsToSameFile (t FileLineReference -> [FileLineReference]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t FileLineReference
refs)
        FileLineReference -> [DisplayLine]
header ([FileLineReference] -> FileLineReference
forall a. [a] -> a
head [FileLineReference]
fileResults) [DisplayLine] -> [DisplayLine] -> [DisplayLine]
forall a. Semigroup a => a -> a -> a
<> (FileLineReference -> DisplayLine)
-> [FileLineReference] -> [DisplayLine]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (LineReference -> DisplayLine
Line (LineReference -> DisplayLine)
-> (FileLineReference -> LineReference)
-> FileLineReference
-> DisplayLine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting LineReference FileLineReference LineReference
-> FileLineReference -> LineReference
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting LineReference FileLineReference LineReference
Lens' FileLineReference LineReference
lineReference) [FileLineReference]
fileResults

    header :: FileLineReference -> [DisplayLine]
header   = DisplayLine -> [DisplayLine]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DisplayLine -> [DisplayLine])
-> (FileLineReference -> DisplayLine)
-> FileLineReference
-> [DisplayLine]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. File -> DisplayLine
FileHeader   (File -> DisplayLine)
-> (FileLineReference -> File) -> FileLineReference -> DisplayLine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting File FileLineReference File -> FileLineReference -> File
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting File FileLineReference File
Lens' FileLineReference File
file
    selected :: FileLineReference -> [DisplayLine]
selected = DisplayLine -> [DisplayLine]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DisplayLine -> [DisplayLine])
-> (FileLineReference -> DisplayLine)
-> FileLineReference
-> [DisplayLine]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineReference -> DisplayLine
SelectedLine (LineReference -> DisplayLine)
-> (FileLineReference -> LineReference)
-> FileLineReference
-> DisplayLine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting LineReference FileLineReference LineReference
-> FileLineReference -> LineReference
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting LineReference FileLineReference LineReference
Lens' FileLineReference LineReference
lineReference
    pointsToSameFile :: FileLineReference -> FileLineReference -> Bool
pointsToSameFile = File -> File -> Bool
forall a. Eq a => a -> a -> Bool
(==) (File -> File -> Bool)
-> (FileLineReference -> File)
-> FileLineReference
-> FileLineReference
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Getting File FileLineReference File -> FileLineReference -> File
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting File FileLineReference File
Lens' FileLineReference File
file

-- | The line number of a 'DisplayLine'. 'Nothing' for 'FileHeader's.
displayLineNumber :: DisplayLine -> Maybe Int
displayLineNumber :: DisplayLine -> Maybe Int
displayLineNumber = \case
    FileHeader File
_                     -> Maybe Int
forall a. Maybe a
Nothing
    Line         (LineReference Maybe Int
n AnsiFormatted
_) -> Maybe Int
n
    SelectedLine (LineReference Maybe Int
n AnsiFormatted
_) -> Maybe Int
n


-- | The file name of the currently selected item
currentFileName :: Getter Results (Maybe Text)
currentFileName :: Getting r Results (Maybe Text)
currentFileName =
    (Results -> Maybe Text) -> SimpleGetter Results (Maybe Text)
forall s a. (s -> a) -> SimpleGetter s a
to (Getting (First Text) Results Text -> Results -> Maybe Text
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((Results -> Maybe FileLineReference)
-> SimpleGetter Results (Maybe FileLineReference)
forall s a. (s -> a) -> SimpleGetter s a
to Results -> Maybe FileLineReference
current Getting (First Text) Results (Maybe FileLineReference)
-> ((Text -> Const (First Text) Text)
    -> Maybe FileLineReference
    -> Const (First Text) (Maybe FileLineReference))
-> Getting (First Text) Results Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FileLineReference -> Const (First Text) FileLineReference)
-> Maybe FileLineReference
-> Const (First Text) (Maybe FileLineReference)
forall a a'. Traversal (Maybe a) (Maybe a') a a'
_Just ((FileLineReference -> Const (First Text) FileLineReference)
 -> Maybe FileLineReference
 -> Const (First Text) (Maybe FileLineReference))
-> ((Text -> Const (First Text) Text)
    -> FileLineReference -> Const (First Text) FileLineReference)
-> (Text -> Const (First Text) Text)
-> Maybe FileLineReference
-> Const (First Text) (Maybe FileLineReference)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (File -> Const (First Text) File)
-> FileLineReference -> Const (First Text) FileLineReference
Lens' FileLineReference File
file ((File -> Const (First Text) File)
 -> FileLineReference -> Const (First Text) FileLineReference)
-> ((Text -> Const (First Text) Text)
    -> File -> Const (First Text) File)
-> (Text -> Const (First Text) Text)
-> FileLineReference
-> Const (First Text) FileLineReference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Text) Text)
-> File -> Const (First Text) File
Lens' File Text
fileName))

-- | The line number of the currently selected item
currentLineNumber :: Getter Results (Maybe Int)
currentLineNumber :: Getting r Results (Maybe Int)
currentLineNumber =
    (Results -> Maybe Int) -> SimpleGetter Results (Maybe Int)
forall s a. (s -> a) -> SimpleGetter s a
to (Getting (First Int) Results Int -> Results -> Maybe Int
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((Results -> Maybe FileLineReference)
-> SimpleGetter Results (Maybe FileLineReference)
forall s a. (s -> a) -> SimpleGetter s a
to Results -> Maybe FileLineReference
current Getting (First Int) Results (Maybe FileLineReference)
-> ((Int -> Const (First Int) Int)
    -> Maybe FileLineReference
    -> Const (First Int) (Maybe FileLineReference))
-> Getting (First Int) Results Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FileLineReference -> Const (First Int) FileLineReference)
-> Maybe FileLineReference
-> Const (First Int) (Maybe FileLineReference)
forall a a'. Traversal (Maybe a) (Maybe a') a a'
_Just ((FileLineReference -> Const (First Int) FileLineReference)
 -> Maybe FileLineReference
 -> Const (First Int) (Maybe FileLineReference))
-> ((Int -> Const (First Int) Int)
    -> FileLineReference -> Const (First Int) FileLineReference)
-> (Int -> Const (First Int) Int)
-> Maybe FileLineReference
-> Const (First Int) (Maybe FileLineReference)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LineReference -> Const (First Int) LineReference)
-> FileLineReference -> Const (First Int) FileLineReference
Lens' FileLineReference LineReference
lineReference ((LineReference -> Const (First Int) LineReference)
 -> FileLineReference -> Const (First Int) FileLineReference)
-> ((Int -> Const (First Int) Int)
    -> LineReference -> Const (First Int) LineReference)
-> (Int -> Const (First Int) Int)
-> FileLineReference
-> Const (First Int) FileLineReference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Int -> Const (First Int) (Maybe Int))
-> LineReference -> Const (First Int) LineReference
Lens' LineReference (Maybe Int)
lineNumber ((Maybe Int -> Const (First Int) (Maybe Int))
 -> LineReference -> Const (First Int) LineReference)
-> ((Int -> Const (First Int) Int)
    -> Maybe Int -> Const (First Int) (Maybe Int))
-> (Int -> Const (First Int) Int)
-> LineReference
-> Const (First Int) LineReference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const (First Int) Int)
-> Maybe Int -> Const (First Int) (Maybe Int)
forall a a'. Traversal (Maybe a) (Maybe a') a a'
_Just))

current :: Results -> Maybe FileLineReference
current :: Results -> Maybe FileLineReference
current = \case
    Results Seq FileLineReference
_ Seq FileLineReference
_ FileLineReference
c Seq FileLineReference
_ Seq FileLineReference
_ -> FileLineReference -> Maybe FileLineReference
forall a. a -> Maybe a
Just FileLineReference
c
    Results
EmptyResults      -> Maybe FileLineReference
forall a. Maybe a
Nothing

-- | The line numbers with matches in the file of the currentliy selected
-- item
currentFileResults :: Getter Results (IntMap AnsiFormatted)
currentFileResults :: Getting r Results (IntMap AnsiFormatted)
currentFileResults =
    (Results -> IntMap AnsiFormatted)
-> SimpleGetter Results (IntMap AnsiFormatted)
forall s a. (s -> a) -> SimpleGetter s a
to ([(Int, AnsiFormatted)] -> IntMap AnsiFormatted
forall a. [(Int, a)] -> IntMap a
Map.fromList ([(Int, AnsiFormatted)] -> IntMap AnsiFormatted)
-> (Results -> [(Int, AnsiFormatted)])
-> Results
-> IntMap AnsiFormatted
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Results -> [(Int, AnsiFormatted)]
lineReferencesInCurrentFile)
  where
    lineReferencesInCurrentFile :: Results -> [(Int, AnsiFormatted)]
lineReferencesInCurrentFile = do
        let sameFileAs :: FileLineReference -> FileLineReference -> Bool
sameFileAs = File -> File -> Bool
forall a. Eq a => a -> a -> Bool
(==) (File -> File -> Bool)
-> (FileLineReference -> File)
-> FileLineReference
-> FileLineReference
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Getting File FileLineReference File -> FileLineReference -> File
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting File FileLineReference File
Lens' FileLineReference File
file
        FileLineReference -> Bool
inCurrentFile <- FileLineReference -> FileLineReference -> Bool
sameFileAs (FileLineReference -> FileLineReference -> Bool)
-> (Results -> FileLineReference)
-> Results
-> FileLineReference
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe FileLineReference -> FileLineReference
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe FileLineReference -> FileLineReference)
-> (Results -> Maybe FileLineReference)
-> Results
-> FileLineReference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Results -> Maybe FileLineReference
current
        [LineReference]
results <- (FileLineReference -> LineReference)
-> [FileLineReference] -> [LineReference]
forall a b. (a -> b) -> [a] -> [b]
map (Getting LineReference FileLineReference LineReference
-> FileLineReference -> LineReference
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting LineReference FileLineReference LineReference
Lens' FileLineReference LineReference
lineReference) ([FileLineReference] -> [LineReference])
-> (Results -> [FileLineReference]) -> Results -> [LineReference]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FileLineReference -> Bool)
-> [FileLineReference] -> [FileLineReference]
forall a. (a -> Bool) -> [a] -> [a]
filter FileLineReference -> Bool
inCurrentFile ([FileLineReference] -> [FileLineReference])
-> (Results -> [FileLineReference])
-> Results
-> [FileLineReference]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Results -> [FileLineReference]
bufferToList
        [(Int, AnsiFormatted)] -> Results -> [(Int, AnsiFormatted)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ (Int
ln, AnsiFormatted
txt) | LineReference (Just Int
ln) AnsiFormatted
txt <- [LineReference]
results ]

bufferToList :: Results -> [FileLineReference]
bufferToList :: Results -> [FileLineReference]
bufferToList = \case
    Results
EmptyResults          -> []
    Results Seq FileLineReference
as Seq FileLineReference
bs FileLineReference
c Seq FileLineReference
ds Seq FileLineReference
es -> Seq FileLineReference -> [FileLineReference]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq FileLineReference
as Seq FileLineReference
-> Seq FileLineReference -> Seq FileLineReference
forall a. Semigroup a => a -> a -> a
<> Seq FileLineReference
bs Seq FileLineReference
-> Seq FileLineReference -> Seq FileLineReference
forall a. Semigroup a => a -> a -> a
<> FileLineReference -> Seq FileLineReference
forall (f :: * -> *) a. Applicative f => a -> f a
pure FileLineReference
c Seq FileLineReference
-> Seq FileLineReference -> Seq FileLineReference
forall a. Semigroup a => a -> a -> a
<> Seq FileLineReference
ds Seq FileLineReference
-> Seq FileLineReference -> Seq FileLineReference
forall a. Semigroup a => a -> a -> a
<> Seq FileLineReference
es)