-- | Helpers for working with 'Text' in UTF-16 code units
module Data.Rope.UTF16.Internal.Text where

import Data.Text(Text)
import qualified Data.Text.Array as Array
import qualified Data.Text.Internal as Text
import qualified Data.Text.Unsafe as Unsafe

clamp16 :: Int -> Text -> Int
clamp16 :: Int -> Text -> Int
clamp16 Int
i t :: Text
t@(Text.Text Array
arr Int
off Int
_len)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Int
0
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len = Int
len
  | Bool
isLowSurrogate = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
  | Bool
otherwise = Int
i
  where
    cp :: Word16
cp = Array -> Int -> Word16
Array.unsafeIndex Array
arr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i)
    isLowSurrogate :: Bool
isLowSurrogate = Word16
0xDC00 Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word16
cp Bool -> Bool -> Bool
&& Word16
cp Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word16
0xDFFF
    len :: Int
len = Text -> Int
Unsafe.lengthWord16 Text
t

take16 :: Int -> Text -> Text
take16 :: Int -> Text -> Text
take16 Int
n Text
t = Int -> Text -> Text
Unsafe.takeWord16 (Int -> Text -> Int
clamp16 Int
n Text
t) Text
t

drop16 :: Int -> Text -> Text
drop16 :: Int -> Text -> Text
drop16 Int
n Text
t = Int -> Text -> Text
Unsafe.dropWord16 (Int -> Text -> Int
clamp16 Int
n Text
t) Text
t

split16At :: Int -> Text -> (Text, Text)
split16At :: Int -> Text -> (Text, Text)
split16At Int
n Text
t = (Int -> Text -> Text
Unsafe.takeWord16 Int
n' Text
t, Int -> Text -> Text
Unsafe.dropWord16 Int
n' Text
t)
  where
    n' :: Int
n' = Int -> Text -> Int
clamp16 Int
n Text
t

chunks16Of :: Int -> Text -> [Text]
chunks16Of :: Int -> Text -> [Text]
chunks16Of Int
n Text
t
  | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = []
  | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n = [Text
t]
  | Bool
otherwise = Text
pre Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Int -> Text -> [Text]
chunks16Of Int
n Text
post
  where
    (Text
pre, Text
post) = Int -> Text -> (Text, Text)
split16At Int
n Text
t
    len :: Int
len = Text -> Int
Unsafe.lengthWord16 Text
t