Commit dd85f69e authored by Nicolas Pouillard's avatar Nicolas Pouillard

some more refactoring towards better highlighting

parent b71b0ad0
...@@ -110,7 +110,7 @@ import Data.Symbol (SProxy(..)) ...@@ -110,7 +110,7 @@ import Data.Symbol (SProxy(..))
import Data.These (These(..)) import Data.These (These(..))
import Data.Traversable (for, traverse_, traverse) import Data.Traversable (for, traverse_, traverse)
import Data.TraversableWithIndex (traverseWithIndex) import Data.TraversableWithIndex (traverseWithIndex)
import Data.Tuple (Tuple(..)) import Data.Tuple (Tuple(..), snd)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2) import DOM.Simple.Console (log2)
import Effect.Aff (Aff, launchAff_) import Effect.Aff (Aff, launchAff_)
...@@ -467,9 +467,8 @@ highlightNgrams ntype table@(NgramsTable {ngrams_repo_elements: elts}) input0 = ...@@ -467,9 +467,8 @@ highlightNgrams ntype table@(NgramsTable {ngrams_repo_elements: elts}) input0 =
| S.null x = xs | S.null x = xs
| otherwise = Tuple x Nil : xs | otherwise = Tuple x Nil : xs
goAcc :: Partial => NgramsTerm -> Int -> HighlightAccumulator -> HighlightAccumulator goAcc :: Partial => Tuple NgramsTerm Int -> Int -> HighlightAccumulator -> HighlightAccumulator
goAcc pat i { i0, s, l } = goAcc (pat /\ lpat) i { i0, s, l } =
let lpat = S.length (db (ngramsTermText pat)) in
case lookupRootList pat table of case lookupRootList pat table of
Nothing -> Nothing ->
crashWith "highlightNgrams: pattern missing from table" crashWith "highlightNgrams: pattern missing from table"
...@@ -498,7 +497,10 @@ highlightNgrams ntype table@(NgramsTable {ngrams_repo_elements: elts}) input0 = ...@@ -498,7 +497,10 @@ highlightNgrams ntype table@(NgramsTable {ngrams_repo_elements: elts}) input0 =
-- Skip this pattern which is overlapping with a previous one. -- Skip this pattern which is overlapping with a previous one.
{ i0, s, l } { i0, s, l }
| otherwise = | otherwise =
let pats' = fromMaybe' (\_ -> crashWith "highlightNgrams: out of bounds pattern") (traverse (A.index pats) pis) in let pats' = A.sortWith snd $
map (\pat -> pat /\ S.length (db (ngramsTermText pat))) $
fromMaybe' (\_ -> crashWith "highlightNgrams: out of bounds pattern") $
traverse (A.index pats) pis in
case List.fromFoldable pats' of case List.fromFoldable pats' of
Nil -> { i0, s, l } Nil -> { i0, s, l }
pat : _ -> goAcc pat i acc pat : _ -> goAcc pat i acc
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment