Analysis.hs

module KB.Text.Layout.Analysis
  ( -- * Splitting text into break units
    analyze
  , Segment (..)
  , BreakKind (..)
  ) where

import Data.Char (isDigit, isSpace)
import Data.List (intersperse)
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Vector qualified as Vector

import KB.Text.Layout.Segmentation qualified as Segmentation

analyze :: Text -> [Segment]
analyze t = go 0 (tailorSoftBreaks t (Segmentation.softBreaks t)) (map toSegment (Text.groupBy sameKind t))
  where
    sameKind a b = classify a == classify b && groupable (classify a)
    toSegment piece = Segment{text = piece, kind = classify (Text.head piece)}
    go _ _ [] = []
    go off soft (s : rest) =
      let
        end = off + Text.length s.text
        (inside, later) = span (< end) (dropWhile (<= off) soft)
        pieces
          | s.kind == Word, not (null inside) = intersperse breakOpportunity (cutAt off inside s.text)
          | otherwise = [s]
      in
        pieces <> go end later rest
    breakOpportunity = Segment{text = "", kind = ZeroWidthBreak}
    cutAt off cuts txt = pieces 0 (map (subtract off) cuts)
      where
        pieces prev = \case
          [] -> [Segment{text = Text.drop prev txt, kind = Word}]
          p : rest -> Segment{text = Text.take (p - prev) (Text.drop prev txt), kind = Word} : pieces p rest

data Segment = Segment
  { text :: Text
  , kind :: BreakKind
  }
  deriving stock (Eq, Show)

data BreakKind
  = Word
  | Space
  | PreservedSpace
  | Tab
  | Glue
  | ZeroWidthBreak
  | SoftHyphen
  | HardBreak
  | Atomic
  deriving stock (Eq, Ord, Show)

tailorSoftBreaks :: Text -> [Int] -> [Int]
tailorSoftBreaks t soft = merge (filter (not . insideRange) soft) querySplits
  where
    n = Text.length t
    chars = Vector.fromList (Text.unpack t)
    at i = chars Vector.! i
    insideRange p =
      p >= 2
        && p < n
        && (at (p - 1) == '\x2013' || at (p - 1) == '\x2014')
        && isDigit (at (p - 2))
        && isDigit (at p)
    slashToken =
      Vector.fromList $
        concatMap
          (\run -> replicate (Text.length run) (not (isSpace (Text.head run)) && Text.any (== '/') run))
          (Text.groupBy (\a b -> isSpace a == isSpace b) t)
    querySplits =
      [ p
      | p <- [1 .. n - 1]
      , at p == '&' || at p == '=' || at p == '#'
      , slashToken Vector.! p
      ]
    merge xs [] = xs
    merge [] ys = ys
    merge (x : xs) (y : ys)
      | x < y = x : merge xs (y : ys)
      | x > y = y : merge (x : xs) ys
      | otherwise = x : merge xs ys

classify :: Char -> BreakKind
classify = \case
  ' ' -> Space
  '\t' -> Tab
  '\n' -> HardBreak
  '\r' -> HardBreak
  '\xA0' -> Glue
  '\x202F' -> Glue
  '\x2060' -> Glue
  '\xFEFF' -> Glue
  '\x200B' -> ZeroWidthBreak
  '\xAD' -> SoftHyphen
  _ -> Word

groupable :: BreakKind -> Bool
groupable = \case
  Word -> True
  Space -> True
  Glue -> True
  Tab -> True
  _ -> False