module Unison.Util.Find
  ( fuzzyFinder,
    simpleFuzzyFinder,
    simpleFuzzyScore,
    fuzzyFindInBranch,
    fuzzyFindMatchArray,
    prefixFindInBranch,
  )
where

import Data.List qualified as List
import Data.Text qualified as Text
-- http://www.serpentine.com/blog/2007/02/27/a-haskell-regular-expression-tutorial/
-- https://www.stackage.org/haddock/lts-13.9/regex-base-0.93.2/Text-Regex-Base-Context.html -- re-exported by TDFA
-- https://www.stackage.org/haddock/lts-13.9/regex-tdfa-1.2.3.1/Text-Regex-TDFA.html
import Text.Regex.TDFA qualified as RE
import Unison.HashQualified qualified as HQ
import Unison.HashQualifiedPrime qualified as HQ'
import Unison.Name (Name)
import Unison.Name qualified as Name
import Unison.Names (Names)
import Unison.Names qualified as Names
import Unison.Prelude
import Unison.Reference qualified as Reference
import Unison.Referent qualified as Referent
import Unison.Server.SearchResult (SearchResult)
import Unison.Server.SearchResult qualified as SR
import Unison.ShortHash qualified as SH
import Unison.Syntax.Name qualified as Name (toText)
import Unison.Syntax.NamePrinter (prettyHashQualified)
import Unison.Util.Monoid (intercalateMap)
import Unison.Util.Pretty qualified as P
import Unison.Util.Relation qualified as R

fuzzyFinder ::
  forall a.
  String ->
  [a] ->
  (a -> String) ->
  [(a, P.Pretty P.ColorText)]
fuzzyFinder :: forall a. String -> [a] -> (a -> String) -> [(a, Pretty ColorText)]
fuzzyFinder String
query [a]
items a -> String
render =
  [(MatchArray, (a, Pretty ColorText))] -> [(a, Pretty ColorText)]
forall {b}. [(MatchArray, b)] -> [b]
sortAndCleanup ([(MatchArray, (a, Pretty ColorText))] -> [(a, Pretty ColorText)])
-> [(MatchArray, (a, Pretty ColorText))] -> [(a, Pretty ColorText)]
forall a b. (a -> b) -> a -> b
$ String
-> [a] -> (a -> String) -> [(MatchArray, (a, Pretty ColorText))]
forall a.
String
-> [a] -> (a -> String) -> [(MatchArray, (a, Pretty ColorText))]
fuzzyFindMatchArray String
query [a]
items a -> String
render
  where
    sortAndCleanup :: [(MatchArray, b)] -> [b]
sortAndCleanup = ((MatchArray, b) -> b) -> [(MatchArray, b)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
List.map (MatchArray, b) -> b
forall a b. (a, b) -> b
snd ([(MatchArray, b)] -> [b])
-> ([(MatchArray, b)] -> [(MatchArray, b)])
-> [(MatchArray, b)]
-> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((MatchArray, b) -> MatchArray)
-> [(MatchArray, b)] -> [(MatchArray, b)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn (MatchArray, b) -> MatchArray
forall a b. (a, b) -> a
fst

simpleFuzzyFinder ::
  forall a.
  Text ->
  [a] ->
  (a -> Text) ->
  [(a, P.Pretty P.ColorText)]
simpleFuzzyFinder :: forall a. Text -> [a] -> (a -> Text) -> [(a, Pretty ColorText)]
simpleFuzzyFinder Text
query [a]
items a -> Text
render =
  [((a, Pretty ColorText), Int)] -> [(a, Pretty ColorText)]
forall {b}. [(b, Int)] -> [b]
sortAndCleanup do
    a
a <- [a]
items
    let s :: Text
s = a -> Text
render a
a
    Int
score <- Maybe Int -> [Int]
forall a. Maybe a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Text -> Text -> Maybe Int
simpleFuzzyScore Text
query Text
s)
    ((a, Pretty ColorText), Int) -> [((a, Pretty ColorText), Int)]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((a
a, String -> Pretty ColorText
hi (Text -> String
Text.unpack Text
s)), Int
score)
  where
    hi :: String -> Pretty ColorText
hi = Text -> String -> Pretty ColorText
highlightSimple Text
query
    sortAndCleanup :: [(b, Int)] -> [b]
sortAndCleanup = ((b, Int) -> b) -> [(b, Int)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
List.map (b, Int) -> b
forall a b. (a, b) -> a
fst ([(b, Int)] -> [b])
-> ([(b, Int)] -> [(b, Int)]) -> [(b, Int)] -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((b, Int) -> Int) -> [(b, Int)] -> [(b, Int)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn (b, Int) -> Int
forall a b. (a, b) -> b
snd

-- highlights `query` if it is a prefix of `s`, or if it
-- appears in the final segement of s (after the final `.`)
highlightSimple :: Text -> String -> P.Pretty P.ColorText
highlightSimple :: Text -> String -> Pretty ColorText
highlightSimple Text
query
  | Text -> Bool
Text.null Text
query = String -> Pretty ColorText
forall s. IsString s => String -> Pretty s
P.string
  | Bool
otherwise = String -> Pretty ColorText
go
  where
    go :: String -> Pretty ColorText
go [] = Pretty ColorText
forall a. Monoid a => a
mempty
    go s :: String
s@(Char
h : String
t)
      | Text
query Text -> Text -> Bool
`Text.isPrefixOf` (String -> Text
Text.pack String
s) = Pretty ColorText
hiQuery Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> String -> Pretty ColorText
go (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
len String
s)
      | Bool
otherwise = String -> Pretty ColorText
forall s. IsString s => String -> Pretty s
P.string [Char
h] Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> String -> Pretty ColorText
go String
t
    len :: Int
len = Text -> Int
Text.length Text
query
    hiQuery :: Pretty ColorText
hiQuery = Pretty ColorText -> Pretty ColorText
P.hiBlack (Text -> Pretty ColorText
forall s. IsString s => Text -> Pretty s
P.text Text
query)

simpleFuzzyScore :: Text -> Text -> Maybe Int
simpleFuzzyScore :: Text -> Text -> Maybe Int
simpleFuzzyScore Text
query Text
s
  | Text
query Text -> Text -> Bool
`Text.isPrefixOf` Text
s = Int -> Maybe Int
forall a. a -> Maybe a
Just (Text -> Int -> Int
forall {a}. Num a => Text -> a -> a
bonus Text
s Int
2)
  | Text
query Text -> Text -> Bool
`Text.isSuffixOf` Text
s = Int -> Maybe Int
forall a. a -> Maybe a
Just (Text -> Int -> Int
forall {a}. Num a => Text -> a -> a
bonus Text
s Int
1)
  | Text
query Text -> Text -> Bool
`Text.isInfixOf` Text
s = Int -> Maybe Int
forall a. a -> Maybe a
Just (Text -> Int -> Int
forall {a}. Num a => Text -> a -> a
bonus Text
s Int
3)
  | Text
lowerquery Text -> Text -> Bool
`Text.isInfixOf` Text
lowers = Int -> Maybe Int
forall a. a -> Maybe a
Just (Text -> Int -> Int
forall {a}. Num a => Text -> a -> a
bonus Text
s Int
4)
  | Bool
otherwise = Maybe Int
forall a. Maybe a
Nothing
  where
    -- prefer relative names
    bonus :: Text -> a -> a
bonus Text
s a
n = if Int -> Text -> Text
Text.take Int
1 Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"." then a
n a -> a -> a
forall a. Num a => a -> a -> a
* a
10 else a
n
    lowerquery :: Text
lowerquery = Text -> Text
Text.toLower Text
query
    lowers :: Text
lowers = Text -> Text
Text.toLower Text
s

-- This logic was split out of fuzzyFinder because the `RE.MatchArray` has an
-- `Ord` instance that helps us sort the fuzzy matches in a nice way. (see
-- comment below.)  `Editor.fuzzyNameDistance` uses this `Ord` instance.
fuzzyFindMatchArray ::
  forall a.
  String ->
  [a] ->
  (a -> String) ->
  [(RE.MatchArray, (a, P.Pretty P.ColorText))]
fuzzyFindMatchArray :: forall a.
String
-> [a] -> (a -> String) -> [(MatchArray, (a, Pretty ColorText))]
fuzzyFindMatchArray String
query [a]
items a -> String
render =
  [a] -> [(MatchArray, (a, Pretty ColorText))]
scoreAndHighlight ([a] -> [(MatchArray, (a, Pretty ColorText))])
-> [a] -> [(MatchArray, (a, Pretty ColorText))]
forall a b. (a -> b) -> a -> b
$ [a]
items
  where
    scoreAndHighlight :: [a] -> [(MatchArray, (a, Pretty ColorText))]
scoreAndHighlight = [Maybe (MatchArray, (a, Pretty ColorText))]
-> [(MatchArray, (a, Pretty ColorText))]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (MatchArray, (a, Pretty ColorText))]
 -> [(MatchArray, (a, Pretty ColorText))])
-> ([a] -> [Maybe (MatchArray, (a, Pretty ColorText))])
-> [a]
-> [(MatchArray, (a, Pretty ColorText))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Maybe (MatchArray, (a, Pretty ColorText)))
-> [a] -> [Maybe (MatchArray, (a, Pretty ColorText))]
forall a b. (a -> b) -> [a] -> [b]
List.map a -> Maybe (MatchArray, (a, Pretty ColorText))
go
    go :: a -> Maybe (RE.MatchArray, (a, P.Pretty P.ColorText))
    go :: a -> Maybe (MatchArray, (a, Pretty ColorText))
go a
a =
      let string :: String
string = a -> String
render a
a
          text :: Text
text = String -> Text
Text.pack String
string
          matches :: Maybe MatchArray
matches = Regex -> String -> Maybe MatchArray
forall regex source.
RegexLike regex source =>
regex -> source -> Maybe MatchArray
RE.matchOnce Regex
regex String
string
          addContext :: MatchArray -> (MatchArray, (a, Pretty ColorText))
addContext MatchArray
matches =
            let highlighted :: Pretty ColorText
highlighted = (Pretty ColorText -> Pretty ColorText)
-> Text -> [(Int, Int)] -> Pretty ColorText
highlight Pretty ColorText -> Pretty ColorText
P.bold Text
text ([(Int, Int)] -> Pretty ColorText)
-> (MatchArray -> [(Int, Int)]) -> MatchArray -> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Int, Int)] -> [(Int, Int)]
forall a. HasCallStack => [a] -> [a]
tail ([(Int, Int)] -> [(Int, Int)])
-> (MatchArray -> [(Int, Int)]) -> MatchArray -> [(Int, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchArray -> [(Int, Int)]
forall a. Array Int a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (MatchArray -> Pretty ColorText) -> MatchArray -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ MatchArray
matches
             in (MatchArray
matches, (a
a, Pretty ColorText
highlighted))
       in MatchArray -> (MatchArray, (a, Pretty ColorText))
addContext (MatchArray -> (MatchArray, (a, Pretty ColorText)))
-> Maybe MatchArray -> Maybe (MatchArray, (a, Pretty ColorText))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe MatchArray
matches
    -- regex "Foo" = "(\\F).*(\\o).*(\\o)"
    regex :: RE.Regex
    regex :: Regex
regex =
      let s :: String
s =
            if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
query
              then String
".*"
              else String -> (Char -> String) -> String -> String
forall (t :: * -> *) a b.
(Foldable t, Monoid a) =>
a -> (b -> a) -> t b -> a
intercalateMap String
".*" Char -> String
esc String
query
            where
              esc :: Char -> String
esc Char
c = String
"(\\" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [Char
c] String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
")"
       in CompOption -> ExecOption -> String -> Regex
forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
compOpt -> execOpt -> source -> regex
RE.makeRegexOpts
            CompOption
forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
compOpt
RE.defaultCompOpt
              { RE.caseSensitive = False,
                -- newSyntax = False,  otherwise "\<" and "\>"
                -- matches word boundaries instead of literal < and >
                RE.newSyntax = False
              }
            ExecOption
forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
execOpt
RE.defaultExecOpt
            String
s

-- Sort on:
-- a. length of match group to find the most compact match
-- b. start position of the match group to find the earliest match
-- c. the item itself for alphabetical ranking
-- Ord MatchArray already provides a. and b.  todo: c.

prefixFindInBranch ::
  Names -> HQ'.HashQualified Name -> [(SearchResult, P.Pretty P.ColorText)]
prefixFindInBranch :: Names -> HashQualified Name -> [(SearchResult, Pretty ColorText)]
prefixFindInBranch Names
b HashQualified Name
hq =
  (SearchResult -> (SearchResult, Pretty ColorText))
-> [SearchResult] -> [(SearchResult, Pretty ColorText)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SearchResult -> (SearchResult, Pretty ColorText)
getName ([SearchResult] -> [(SearchResult, Pretty ColorText)])
-> [SearchResult] -> [(SearchResult, Pretty ColorText)]
forall a b. (a -> b) -> a -> b
$
    -- query string includes a name component, so do a prefix find on that
    (SearchResult -> Bool) -> [SearchResult] -> [SearchResult]
forall a. (a -> Bool) -> [a] -> [a]
filter (Name -> SearchResult -> Bool
filterName (HashQualified Name -> Name
forall n. HashQualified n -> n
HQ'.toName HashQualified Name
hq)) (Names -> HashQualified Name -> [SearchResult]
candidates Names
b HashQualified Name
hq)
  where
    filterName :: Name -> SearchResult -> Bool
    filterName :: Name -> SearchResult -> Bool
filterName Name
n1 SearchResult
sr =
      Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False do
        Name
n2 <- HashQualified Name -> Maybe Name
forall n. HashQualified n -> Maybe n
HQ.toName (SearchResult -> HashQualified Name
SR.name SearchResult
sr)
        Bool -> Maybe Bool
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name
n1 Name -> Name -> Bool
`Name.isPrefixOf` Name
n2)

-- only search before the # before the # and after the # after the #
fuzzyFindInBranch ::
  (HasCallStack) =>
  Names ->
  HQ'.HashQualified Name ->
  [(SearchResult, P.Pretty P.ColorText)]
fuzzyFindInBranch :: HasCallStack =>
Names -> HashQualified Name -> [(SearchResult, Pretty ColorText)]
fuzzyFindInBranch Names
b HashQualified Name
hq =
  Text
-> [SearchResult]
-> (SearchResult -> Text)
-> [(SearchResult, Pretty ColorText)]
forall a. Text -> [a] -> (a -> Text) -> [(a, Pretty ColorText)]
simpleFuzzyFinder
    (Name -> Text
Name.toText (HashQualified Name -> Name
forall n. HashQualified n -> n
HQ'.toName HashQualified Name
hq))
    (Names -> HashQualified Name -> [SearchResult]
candidates Names
b HashQualified Name
hq)
    ( \SearchResult
sr ->
        case HashQualified Name -> Maybe Name
forall n. HashQualified n -> Maybe n
HQ.toName (SearchResult -> HashQualified Name
SR.name SearchResult
sr) of
          -- see invariant on `candidates` below.
          Maybe Name
Nothing -> String -> Text
forall a. HasCallStack => String -> a
error String
"search result without name"
          Just Name
name -> Name -> Text
Name.toText Name
name
    )

getName :: SearchResult -> (SearchResult, P.Pretty P.ColorText)
getName :: SearchResult -> (SearchResult, Pretty ColorText)
getName SearchResult
sr = (SearchResult
sr, Pretty (SyntaxText' Reference) -> Pretty ColorText
forall r. Pretty (SyntaxText' r) -> Pretty ColorText
P.syntaxToColor (Pretty (SyntaxText' Reference) -> Pretty ColorText)
-> Pretty (SyntaxText' Reference) -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ HashQualified Name -> Pretty (SyntaxText' Reference)
prettyHashQualified (SearchResult -> HashQualified Name
SR.name SearchResult
sr))

-- Invariant: all `SearchResult` in the output will have names, even though the type allows them to have only hashes
candidates :: Names.Names -> HQ'.HashQualified Name -> [SearchResult]
candidates :: Names -> HashQualified Name -> [SearchResult]
candidates Names
b HashQualified Name
hq = [SearchResult]
typeCandidates [SearchResult] -> [SearchResult] -> [SearchResult]
forall a. Semigroup a => a -> a -> a
<> [SearchResult]
termCandidates
  where
    -- filter branch by hash
    typeCandidates :: [SearchResult]
typeCandidates =
      ((Name, Reference) -> SearchResult)
-> [(Name, Reference)] -> [SearchResult]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Name, Reference) -> SearchResult
typeResult ([(Name, Reference)] -> [SearchResult])
-> (Names -> [(Name, Reference)]) -> Names -> [SearchResult]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Name, Reference)] -> [(Name, Reference)]
filterTypes ([(Name, Reference)] -> [(Name, Reference)])
-> (Names -> [(Name, Reference)]) -> Names -> [(Name, Reference)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation Name Reference -> [(Name, Reference)]
forall a b. Relation a b -> [(a, b)]
R.toList (Relation Name Reference -> [(Name, Reference)])
-> (Names -> Relation Name Reference)
-> Names
-> [(Name, Reference)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Names -> Relation Name Reference
Names.types (Names -> [SearchResult]) -> Names -> [SearchResult]
forall a b. (a -> b) -> a -> b
$ Names
b
    termCandidates :: [SearchResult]
termCandidates =
      ((Name, Referent) -> SearchResult)
-> [(Name, Referent)] -> [SearchResult]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Name, Referent) -> SearchResult
termResult ([(Name, Referent)] -> [SearchResult])
-> (Names -> [(Name, Referent)]) -> Names -> [SearchResult]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Name, Referent)] -> [(Name, Referent)]
filterTerms ([(Name, Referent)] -> [(Name, Referent)])
-> (Names -> [(Name, Referent)]) -> Names -> [(Name, Referent)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation Name Referent -> [(Name, Referent)]
forall a b. Relation a b -> [(a, b)]
R.toList (Relation Name Referent -> [(Name, Referent)])
-> (Names -> Relation Name Referent) -> Names -> [(Name, Referent)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Names -> Relation Name Referent
Names.terms (Names -> [SearchResult]) -> Names -> [SearchResult]
forall a b. (a -> b) -> a -> b
$ Names
b
    filterTerms :: [(Name, Referent)] -> [(Name, Referent)]
filterTerms = case HashQualified Name -> Maybe ShortHash
forall n. HashQualified n -> Maybe ShortHash
HQ'.toHash HashQualified Name
hq of
      Just ShortHash
sh -> ((Name, Referent) -> Bool)
-> [(Name, Referent)] -> [(Name, Referent)]
forall a. (a -> Bool) -> [a] -> [a]
List.filter (((Name, Referent) -> Bool)
 -> [(Name, Referent)] -> [(Name, Referent)])
-> ((Name, Referent) -> Bool)
-> [(Name, Referent)]
-> [(Name, Referent)]
forall a b. (a -> b) -> a -> b
$ ShortHash -> ShortHash -> Bool
SH.isPrefixOf ShortHash
sh (ShortHash -> Bool)
-> ((Name, Referent) -> ShortHash) -> (Name, Referent) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Referent -> ShortHash
Referent.toShortHash (Referent -> ShortHash)
-> ((Name, Referent) -> Referent) -> (Name, Referent) -> ShortHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, Referent) -> Referent
forall a b. (a, b) -> b
snd
      Maybe ShortHash
Nothing -> [(Name, Referent)] -> [(Name, Referent)]
forall a. a -> a
id
    filterTypes :: [(Name, Reference)] -> [(Name, Reference)]
filterTypes = case HashQualified Name -> Maybe ShortHash
forall n. HashQualified n -> Maybe ShortHash
HQ'.toHash HashQualified Name
hq of
      Just ShortHash
sh -> ((Name, Reference) -> Bool)
-> [(Name, Reference)] -> [(Name, Reference)]
forall a. (a -> Bool) -> [a] -> [a]
List.filter (((Name, Reference) -> Bool)
 -> [(Name, Reference)] -> [(Name, Reference)])
-> ((Name, Reference) -> Bool)
-> [(Name, Reference)]
-> [(Name, Reference)]
forall a b. (a -> b) -> a -> b
$ ShortHash -> ShortHash -> Bool
SH.isPrefixOf ShortHash
sh (ShortHash -> Bool)
-> ((Name, Reference) -> ShortHash) -> (Name, Reference) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> ShortHash
Reference.toShortHash (Reference -> ShortHash)
-> ((Name, Reference) -> Reference)
-> (Name, Reference)
-> ShortHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, Reference) -> Reference
forall a b. (a, b) -> b
snd
      Maybe ShortHash
Nothing -> [(Name, Reference)] -> [(Name, Reference)]
forall a. a -> a
id
    typeResult :: (Name, Reference) -> SearchResult
typeResult (Name
n, Reference
r) = Names -> Name -> Reference -> SearchResult
SR.typeSearchResult Names
b Name
n Reference
r
    termResult :: (Name, Referent) -> SearchResult
termResult (Name
n, Referent
r) = Names -> Name -> Referent -> SearchResult
SR.termSearchResult Names
b Name
n Referent
r

type Pos = Int

type Len = Int

-- This [(Pos, Len)] type is the same as `tail . toList` of a regex MatchArray
highlight ::
  (P.Pretty P.ColorText -> P.Pretty P.ColorText) ->
  Text ->
  [(Pos, Len)] ->
  P.Pretty P.ColorText
highlight :: (Pretty ColorText -> Pretty ColorText)
-> Text -> [(Int, Int)] -> Pretty ColorText
highlight Pretty ColorText -> Pretty ColorText
on = (Pretty ColorText -> Pretty ColorText)
-> (Pretty ColorText -> Pretty ColorText)
-> Text
-> [(Int, Int)]
-> Pretty ColorText
highlight' Pretty ColorText -> Pretty ColorText
on Pretty ColorText -> Pretty ColorText
forall a. a -> a
id

highlight' ::
  (P.Pretty P.ColorText -> P.Pretty P.ColorText) ->
  (P.Pretty P.ColorText -> P.Pretty P.ColorText) ->
  Text ->
  [(Pos, Len)] ->
  P.Pretty P.ColorText
highlight' :: (Pretty ColorText -> Pretty ColorText)
-> (Pretty ColorText -> Pretty ColorText)
-> Text
-> [(Int, Int)]
-> Pretty ColorText
highlight' Pretty ColorText -> Pretty ColorText
on Pretty ColorText -> Pretty ColorText
off Text
t [(Int, Int)]
groups = case [(Int, Int)]
groups of
  [] -> (Pretty ColorText -> Pretty ColorText
off (Pretty ColorText -> Pretty ColorText)
-> (Text -> Pretty ColorText) -> Text -> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Pretty ColorText
forall s. IsString s => Text -> Pretty s
P.text) Text
t
  (Int
0, Int
_) : [(Int, Int)]
_ -> [(Int, Int)] -> Pretty ColorText
go [(Int, Int)]
groups
  (Int
start, Int
_) : [(Int, Int)]
_ -> (Pretty ColorText -> Pretty ColorText
off (Pretty ColorText -> Pretty ColorText)
-> (Text -> Pretty ColorText) -> Text -> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Pretty ColorText
forall s. IsString s => Text -> Pretty s
P.text (Text -> Pretty ColorText)
-> (Text -> Text) -> Text -> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
Text.take Int
start) Text
t Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> [(Int, Int)] -> Pretty ColorText
go [(Int, Int)]
groups
  where
    go :: [(Int, Int)] -> Pretty ColorText
go = \case
      [] -> String -> Pretty ColorText
forall a. HasCallStack => String -> a
error String
"unpossible I think"
      (Int
start, Int
len) : (Int
start2, Int
len2) : [(Int, Int)]
groups
        | Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
start2 ->
            -- avoid an on/off since there's no gap between groups
            [(Int, Int)] -> Pretty ColorText
go ((Int
start, Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len2) (Int, Int) -> [(Int, Int)] -> [(Int, Int)]
forall a. a -> [a] -> [a]
: [(Int, Int)]
groups)
      (Int
start, Int
len) : [(Int, Int)]
groups ->
        let (Text
selected, Text
remaining) = Int -> Text -> (Text, Text)
Text.splitAt Int
len (Text -> (Text, Text)) -> (Text -> Text) -> Text -> (Text, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
Text.drop Int
start (Text -> (Text, Text)) -> Text -> (Text, Text)
forall a b. (a -> b) -> a -> b
$ Text
t
         in (Pretty ColorText -> Pretty ColorText
on (Pretty ColorText -> Pretty ColorText)
-> (Text -> Pretty ColorText) -> Text -> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Pretty ColorText
forall s. IsString s => Text -> Pretty s
P.text) Text
selected Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> case [(Int, Int)]
groups of
              [] -> (Pretty ColorText -> Pretty ColorText
off (Pretty ColorText -> Pretty ColorText)
-> (Text -> Pretty ColorText) -> Text -> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Pretty ColorText
forall s. IsString s => Text -> Pretty s
P.text) Text
remaining
              (Int
start2, Int
_) : [(Int, Int)]
_ ->
                (Pretty ColorText -> Pretty ColorText
off (Pretty ColorText -> Pretty ColorText)
-> (Text -> Pretty ColorText) -> Text -> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Pretty ColorText
forall s. IsString s => Text -> Pretty s
P.text (Text -> Pretty ColorText)
-> (Text -> Text) -> Text -> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
Text.drop (Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len) (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
Text.take Int
start2 (Text -> Pretty ColorText) -> Text -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Text
t)
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> [(Int, Int)] -> Pretty ColorText
go [(Int, Int)]
groups