-- |

module Brick.Widgets.Search where

import Text.Regex.TDFA
import qualified Data.Text as T
import Hum.Attributes
import Brick.Types
import Brick.Widgets.Core
import qualified Data.Array as A

searchW :: Int -> Text -> Text -> Widget n
searchW :: Int -> Text -> Text -> Widget n
searchW Int
highlight Text
term Text
contents =
  let splits :: [[Text]]
splits = Text -> Text -> [Text]
T.splitOn Text
term (Text -> [Text]) -> [Text] -> [[Text]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [Text]
forall t. IsText t "lines" => t -> [t]
lines Text
contents
      numMatches :: Int
numMatches = [Int] -> Int
forall a (f :: * -> *). (Foldable f, Num a) => f a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (\[Text]
ls -> Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 ([Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
ls Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) ([Text] -> Int) -> [[Text]] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Text]]
splits
      mkLine :: [Text] -> State Int (Widget n)
      mkLine :: [Text] -> State Int (Widget n)
mkLine [] = Widget n -> State Int (Widget n)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Widget n
forall n. Widget n
emptyWidget
      mkLine [Text
""] = Widget n -> State Int (Widget n)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Widget n -> State Int (Widget n))
-> Widget n -> State Int (Widget n)
forall a b. (a -> b) -> a -> b
$ Text -> Widget n
forall n. Text -> Widget n
txt Text
" "
      mkLine [Text
t] = Widget n -> State Int (Widget n)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Widget n -> State Int (Widget n))
-> Widget n -> State Int (Widget n)
forall a b. (a -> b) -> a -> b
$ Text -> Widget n
forall n. Text -> Widget n
txt Text
t
      mkLine (Text
t:[Text]
ts) = do
        Int
num <- StateT Int Identity Int
forall s (m :: * -> *). MonadState s m => m s
get
        let hl :: Bool
hl = (Int
num Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
highlight) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
numMatches Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
        (Int -> Int) -> StateT Int Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
        let (Widget n
rest,Int
numFinal) = State Int (Widget n) -> Int -> (Widget n, Int)
forall s a. State s a -> s -> (a, s)
runState ([Text] -> State Int (Widget n)
forall n. [Text] -> State Int (Widget n)
mkLine [Text]
ts) (Int
numInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
        Int -> StateT Int Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put Int
numFinal
        Widget n -> State Int (Widget n)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Widget n -> State Int (Widget n))
-> Widget n -> State Int (Widget n)
forall a b. (a -> b) -> a -> b
$ Text -> Widget n
forall n. Text -> Widget n
txt Text
t
          Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> ((if Bool
hl then
                  Widget n -> Widget n
forall n. Widget n -> Widget n
visible (Widget n -> Widget n)
-> (Widget n -> Widget n) -> Widget n -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
searchFocusedAttr
                else AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
searchAttr) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Text -> Widget n
forall n. Text -> Widget n
txt Text
term)
          Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Widget n
forall n. Widget n
rest
      mkWidget :: [[Text]] -> State Int (Widget n)
      mkWidget :: [[Text]] -> State Int (Widget n)
mkWidget [] = Widget n -> State Int (Widget n)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Widget n
forall n. Widget n
emptyWidget
      mkWidget [[Text]
t] = StateT Int Identity (State Int (Widget n)) -> State Int (Widget n)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (StateT Int Identity (State Int (Widget n))
 -> State Int (Widget n))
-> (State Int (Widget n)
    -> StateT Int Identity (State Int (Widget n)))
-> State Int (Widget n)
-> State Int (Widget n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State Int (Widget n) -> StateT Int Identity (State Int (Widget n))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (State Int (Widget n) -> State Int (Widget n))
-> State Int (Widget n) -> State Int (Widget n)
forall a b. (a -> b) -> a -> b
$ [Text] -> State Int (Widget n)
forall n. [Text] -> State Int (Widget n)
mkLine [Text]
t
      mkWidget ([Text]
t:[[Text]]
ts) = do
        Int
num <- StateT Int Identity Int
forall s (m :: * -> *). MonadState s m => m s
get
        let (Widget n
line,Int
numLine) = State Int (Widget n) -> Int -> (Widget n, Int)
forall s a. State s a -> s -> (a, s)
runState ([Text] -> State Int (Widget n)
forall n. [Text] -> State Int (Widget n)
mkLine [Text]
t) Int
num
        let (Widget n
rest,Int
numFinal) = State Int (Widget n) -> Int -> (Widget n, Int)
forall s a. State s a -> s -> (a, s)
runState ([[Text]] -> State Int (Widget n)
forall n. [[Text]] -> State Int (Widget n)
mkWidget [[Text]]
ts) Int
numLine
        Int -> StateT Int Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put Int
numFinal
        Widget n -> State Int (Widget n)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Widget n -> State Int (Widget n))
-> Widget n -> State Int (Widget n)
forall a b. (a -> b) -> a -> b
$ Widget n
forall n. Widget n
line Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<=> Widget n
forall n. Widget n
rest
      in State Int (Widget n) -> Int -> Widget n
forall s a. State s a -> s -> a
evalState ([[Text]] -> State Int (Widget n)
forall n. [[Text]] -> State Int (Widget n)
mkWidget [[Text]]
splits) Int
0

splitRegex :: Regex -> Text -> [[(Text, Text)]]
splitRegex :: Regex -> Text -> [[(Text, Text)]]
splitRegex Regex
rg Text
source = [(Text, Text)] -> Regex -> Text -> [(Text, Text)]
go [] Regex
rg (Text -> [(Text, Text)]) -> [Text] -> [[(Text, Text)]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [Text]
forall t. IsText t "lines" => t -> [t]
lines Text
source
 where
  go :: [(Text, Text)] -> Regex -> Text -> [(Text, Text)]
  go :: [(Text, Text)] -> Regex -> Text -> [(Text, Text)]
go [(Text, Text)]
prev Regex
rg' Text
rest =
    let matches :: Maybe (Text, MatchText Text, Text)
matches = Regex -> Text -> Maybe (Text, MatchText Text, Text)
forall regex source.
RegexLike regex source =>
regex -> source -> Maybe (source, MatchText source, source)
matchOnceText Regex
rg' Text
rest
    in  case Maybe (Text, MatchText Text, Text)
matches of
          Maybe (Text, MatchText Text, Text)
Nothing              -> [(Text, Text)]
prev [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ [(Text
rest, Text
"")]
          Just (Text
pre, MatchText Text
mt, Text
post) -> [(Text, Text)] -> Regex -> Text -> [(Text, Text)]
go
            ([(Text, Text)]
prev [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ [(Text
pre, Text
-> ((Text, (Int, Int)) -> Text) -> Maybe (Text, (Int, Int)) -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (Text, (Int, Int)) -> Text
forall a b. (a, b) -> a
fst (Maybe (Text, (Int, Int)) -> Text)
-> Maybe (Text, (Int, Int)) -> Text
forall a b. (a -> b) -> a -> b
$ (NonEmpty (Text, (Int, Int)) -> (Text, (Int, Int)))
-> [(Text, (Int, Int))] -> Maybe (Text, (Int, Int))
forall a b. (NonEmpty a -> b) -> [a] -> Maybe b
viaNonEmpty NonEmpty (Text, (Int, Int)) -> (Text, (Int, Int))
forall (f :: * -> *) a. IsNonEmpty f a a "head" => f a -> a
head (MatchText Text -> [(Text, (Int, Int))]
forall i e. Array i e -> [e]
A.elems MatchText Text
mt))])
            Regex
rg
            Text
post

regexW :: Int -> Regex -> Text -> Widget n
regexW :: Int -> Regex -> Text -> Widget n
regexW Int
highlight Regex
term Text
contents =
  let splits :: [[(Text, Text)]]
splits = Regex -> Text -> [[(Text, Text)]]
splitRegex Regex
term Text
contents
      numMatches :: Int
numMatches = [Int] -> Int
forall a (f :: * -> *). (Foldable f, Num a) => f a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (\[(Text, Text)]
ls -> Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 ([(Text, Text)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, Text)]
ls Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) ([(Text, Text)] -> Int) -> [[(Text, Text)]] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[(Text, Text)]]
splits
      mkLine :: [(Text,Text)] -> State Int (Widget n)
      mkLine :: [(Text, Text)] -> State Int (Widget n)
mkLine [] = Widget n -> State Int (Widget n)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Widget n
forall n. Widget n
emptyWidget
      mkLine [(Text
"",Text
_)] = Widget n -> State Int (Widget n)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Widget n -> State Int (Widget n))
-> Widget n -> State Int (Widget n)
forall a b. (a -> b) -> a -> b
$ Text -> Widget n
forall n. Text -> Widget n
txt Text
" "
      mkLine [(Text
tx,Text
_)] = Widget n -> State Int (Widget n)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Widget n -> State Int (Widget n))
-> Widget n -> State Int (Widget n)
forall a b. (a -> b) -> a -> b
$ Text -> Widget n
forall n. Text -> Widget n
txt Text
tx
      mkLine ((Text
tx,Text
mtch):[(Text, Text)]
ts) = do
        Int
num <- StateT Int Identity Int
forall s (m :: * -> *). MonadState s m => m s
get
        let hl :: Bool
hl = (Int
num Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
highlight) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
numMatches Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
        (Int -> Int) -> StateT Int Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
        let (Widget n
rest,Int
numFinal) = State Int (Widget n) -> Int -> (Widget n, Int)
forall s a. State s a -> s -> (a, s)
runState ([(Text, Text)] -> State Int (Widget n)
forall n. [(Text, Text)] -> State Int (Widget n)
mkLine [(Text, Text)]
ts) (Int
numInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
        Int -> StateT Int Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put Int
numFinal
        Widget n -> State Int (Widget n)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Widget n -> State Int (Widget n))
-> Widget n -> State Int (Widget n)
forall a b. (a -> b) -> a -> b
$ Text -> Widget n
forall n. Text -> Widget n
txt Text
tx
          Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> ((if Bool
hl then
                  Widget n -> Widget n
forall n. Widget n -> Widget n
visible (Widget n -> Widget n)
-> (Widget n -> Widget n) -> Widget n -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
searchFocusedAttr
                else AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
searchAttr) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Text -> Widget n
forall n. Text -> Widget n
txt Text
mtch)
          Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Widget n
forall n. Widget n
rest
      mkWidget :: [[(Text,Text)]] -> State Int (Widget n)
      mkWidget :: [[(Text, Text)]] -> State Int (Widget n)
mkWidget [] = Widget n -> State Int (Widget n)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Widget n
forall n. Widget n
emptyWidget
      mkWidget [[(Text, Text)]
t] = StateT Int Identity (State Int (Widget n)) -> State Int (Widget n)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (StateT Int Identity (State Int (Widget n))
 -> State Int (Widget n))
-> (State Int (Widget n)
    -> StateT Int Identity (State Int (Widget n)))
-> State Int (Widget n)
-> State Int (Widget n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State Int (Widget n) -> StateT Int Identity (State Int (Widget n))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (State Int (Widget n) -> State Int (Widget n))
-> State Int (Widget n) -> State Int (Widget n)
forall a b. (a -> b) -> a -> b
$ [(Text, Text)] -> State Int (Widget n)
forall n. [(Text, Text)] -> State Int (Widget n)
mkLine [(Text, Text)]
t
      mkWidget ([(Text, Text)]
t:[[(Text, Text)]]
ts) = do
        Int
num <- StateT Int Identity Int
forall s (m :: * -> *). MonadState s m => m s
get
        let (Widget n
line,Int
numLine) = State Int (Widget n) -> Int -> (Widget n, Int)
forall s a. State s a -> s -> (a, s)
runState ([(Text, Text)] -> State Int (Widget n)
forall n. [(Text, Text)] -> State Int (Widget n)
mkLine [(Text, Text)]
t) Int
num
        let (Widget n
rest,Int
numFinal) = State Int (Widget n) -> Int -> (Widget n, Int)
forall s a. State s a -> s -> (a, s)
runState ([[(Text, Text)]] -> State Int (Widget n)
forall n. [[(Text, Text)]] -> State Int (Widget n)
mkWidget [[(Text, Text)]]
ts) Int
numLine
        Int -> StateT Int Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put Int
numFinal
        Widget n -> State Int (Widget n)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Widget n -> State Int (Widget n))
-> Widget n -> State Int (Widget n)
forall a b. (a -> b) -> a -> b
$ Widget n
forall n. Widget n
line Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<=> Widget n
forall n. Widget n
rest
      in State Int (Widget n) -> Int -> Widget n
forall s a. State s a -> s -> a
evalState ([[(Text, Text)]] -> State Int (Widget n)
forall n. [[(Text, Text)]] -> State Int (Widget n)
mkWidget [[(Text, Text)]]
splits) Int
0