{-# LANGUAGE Safe #-}

-- |
-- Module      :  Text.Megaparsec.Unicode
-- Copyright   :  © 2024–present Megaparsec contributors
-- License     :  FreeBSD
--
-- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>
-- Stability   :  experimental
-- Portability :  portable
--
-- Utility functions for working with Unicode.
--
-- @since 9.7.0
module Text.Megaparsec.Unicode
  ( stringLength,
    charLength,
    isWideChar,
    isZeroWidthChar,
  )
where

import Data.Array (Array, bounds, (!))
import Data.Char (ord)
import Text.Megaparsec.Unicode.Tables

-- | Calculate the length of a string, taking into account the fact that
-- certain 'Char's may span more than 1 column.
--
-- @since 9.7.0
stringLength :: (Traversable t) => t Char -> Int
stringLength :: forall (t :: * -> *). Traversable t => t Char -> Int
stringLength = t Int -> Int
forall a. Num a => t a -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (t Int -> Int) -> (t Char -> t Int) -> t Char -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Int) -> t Char -> t Int
forall a b. (a -> b) -> t a -> t b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Int
charLength

-- | Return the length of an individual 'Char'.
--
-- @since 9.7.0
charLength :: Char -> Int
charLength :: Char -> Int
charLength Char
ch
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
simpleCharLimit = if Int -> Bool
isSimpleZeroWidth Int
n then Int
0 else Int
1
  -- The two tables are disjoint, so the order of the lookups only affects
  -- speed. Wide characters are looked up first because scripts that use
  -- them use them for nearly every character, while combining marks are
  -- interspersed with characters that are in neither table.
  | Array Int (Int, Int) -> Int -> Bool
inRanges Array Int (Int, Int)
wideCharRanges Int
n = Int
2
  | Array Int (Int, Int) -> Int -> Bool
inRanges Array Int (Int, Int)
zeroWidthCharRanges Int
n = Int
0
  | Bool
otherwise = Int
1
  where
    n :: Int
n = Char -> Int
ord Char
ch

-- | Determine whether the given 'Char' is “wide”, that is, whether it spans
-- 2 columns instead of one.
--
-- @since 9.7.0
isWideChar :: Char -> Bool
isWideChar :: Char -> Bool
isWideChar Char
ch = Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
simpleCharLimit Bool -> Bool -> Bool
&& Array Int (Int, Int) -> Int -> Bool
inRanges Array Int (Int, Int)
wideCharRanges Int
n
  where
    n :: Int
n = Char -> Int
ord Char
ch

-- | Determine whether the given 'Char' is “zero-width”, that is, whether it
-- has no visible representation and does not advance the cursor position.
-- This includes control characters and certain Unicode zero-width
-- characters.
--
-- @since 9.8.0
isZeroWidthChar :: Char -> Bool
isZeroWidthChar :: Char -> Bool
isZeroWidthChar Char
ch
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
simpleCharLimit = Int -> Bool
isSimpleZeroWidth Int
n
  | Bool
otherwise = Array Int (Int, Int) -> Int -> Bool
inRanges Array Int (Int, Int)
zeroWidthCharRanges Int
n
  where
    n :: Int
n = Char -> Int
ord Char
ch

-- | Decide whether a code point below 'simpleCharLimit' is zero-width. Only
-- the control characters and the soft hyphen are; the generator checks that
-- this agrees with the data it produces.
isSimpleZeroWidth :: Int -> Bool
isSimpleZeroWidth :: Int -> Bool
isSimpleZeroWidth Int
n =
  Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x20 -- C0 control chars
    Bool -> Bool -> Bool
|| (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0x7f Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x9f) -- DEL and C1 control chars
    Bool -> Bool -> Bool
|| Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0xad -- soft hyphen
{-# INLINE isSimpleZeroWidth #-}

-- | Look up a code point in a sorted collection of ranges that neither
-- overlap nor touch.
inRanges :: Array Int (Int, Int) -> Int -> Bool
inRanges :: Array Int (Int, Int) -> Int -> Bool
inRanges Array Int (Int, Int)
ranges Int
n = (Int, Int) -> Bool
go (Array Int (Int, Int) -> (Int, Int)
forall i e. Array i e -> (i, i)
bounds Array Int (Int, Int)
ranges)
  where
    go :: (Int, Int) -> Bool
go (Int
lo, Int
hi)
      | Int
hi Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
lo = Bool
False
      | Int
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
b = Bool
True
      | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
a = (Int, Int) -> Bool
go (Int
lo, Int -> Int
forall a. Enum a => a -> a
pred Int
mid)
      | Bool
otherwise = (Int, Int) -> Bool
go (Int -> Int
forall a. Enum a => a -> a
succ Int
mid, Int
hi)
      where
        mid :: Int
mid = (Int
lo Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
hi) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
        (Int
a, Int
b) = Array Int (Int, Int)
ranges Array Int (Int, Int) -> Int -> (Int, Int)
forall i e. Ix i => Array i e -> i -> e
! Int
mid