{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE NumericUnderscores #-}
-- | 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 Data.Bits
import qualified Data.Text.Internal as Text
import qualified Data.Text.Unsafe as Unsafe
import qualified Data.Text as Text
import Data.Char

lengthWord16 :: Text -> Int
lengthWord16 :: Text -> Int
lengthWord16 = (Int -> Char -> Int) -> Int -> Text -> Int
forall a. (a -> Char -> a) -> a -> Text -> a
Text.foldl' (\Int
n Char
c -> Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
utf16Length Char
c) Int
0

utf16Length :: Char -> Int
utf16Length :: Char -> Int
utf16Length Char
c
  | Char -> Int
ord Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x10000 = Int
1
  | Bool
otherwise = Int
2

index8To16 :: Int -> Text -> Int
index8To16 :: Int -> Text -> Int
index8To16 Int
index8 Text
t = Int -> Int -> Int
go Int
0 Int
0
  where
    index8' :: Int
index8' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Text -> Int
Unsafe.lengthWord8 Text
t) Int
index8
    go :: Int -> Int -> Int
go !Int
i8 !Int
i16
      | Int
i8 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
index8' = Int
i16
      | Bool
otherwise = do
        let Unsafe.Iter Char
c Int
delta = Text -> Int -> Iter
Unsafe.iter Text
t Int
i8
        Int -> Int -> Int
go (Int
i8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
delta) (Int
i16 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
utf16Length Char
c)

index16To8 :: Int -> Text -> Int
index16To8 :: Int -> Text -> Int
index16To8 Int
index16 Text
t = Int -> Int -> Int
go Int
0 Int
0
  where
    length8 :: Int
length8 = Text -> Int
Unsafe.lengthWord8 Text
t
    go :: Int -> Int -> Int
go !Int
i8 !Int
i16
      | Int
i8 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
length8 = Int
i8
      | Int
i16 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
index16 = Int
i8
      | Bool
otherwise = do
        let Unsafe.Iter Char
c Int
delta = Text -> Int -> Iter
Unsafe.iter Text
t Int
i8
        Int -> Int -> Int
go (Int
i8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
delta) (Int
i16 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
utf16Length Char
c)

take16 :: Int -> Text -> Text
take16 :: Int -> Text -> Text
take16 Int
i16 Text
t = Int -> Text -> Text
Unsafe.takeWord8 (Int -> Text -> Int
index16To8 Int
i16 Text
t) Text
t

drop16 :: Int -> Text -> Text
drop16 :: Int -> Text -> Text
drop16 Int
i16 Text
t = Int -> Text -> Text
Unsafe.dropWord8 (Int -> Text -> Int
index16To8 Int
i16 Text
t) Text
t

split16At :: Int -> Text -> (Text, Text)
split16At :: Int -> Text -> (Text, Text)
split16At Int
i16 Text
t = Int -> Text -> (Text, Text)
split8At (Int -> Text -> Int
index16To8 Int
i16 Text
t) Text
t

split8At :: Int -> Text -> (Text, Text)
split8At :: Int -> Text -> (Text, Text)
split8At Int
i8 Text
t = (Int -> Text -> Text
Unsafe.takeWord8 Int
i8 Text
t, Int -> Text -> Text
Unsafe.dropWord8 Int
i8 Text
t)

clamp8 :: Int -> Text -> Int
clamp8 :: Int -> Text -> Int
clamp8 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
isFirstCodeUnit = Int
i
  | Bool
otherwise = Int -> Text -> Int
clamp8 (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Text
t
  where
    cu :: Word8
cu = Array -> Int -> Word8
Array.unsafeIndex Array
arr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i)
    len :: Int
len = Text -> Int
Unsafe.lengthWord8 Text
t
    isFirstCodeUnit :: Bool
isFirstCodeUnit = Word8
cu Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b1100_0000 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0b1000_0000

chunks8Of :: Int -> Text -> [Text]
chunks8Of :: Int -> Text -> [Text]
chunks8Of 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]
chunks8Of Int
n Text
post
  where
    (Text
pre, Text
post) = Int -> Text -> (Text, Text)
split8At (Int -> Text -> Int
clamp8 Int
n Text
t) Text
t
    len :: Int
len = Text -> Int
Unsafe.lengthWord8 Text
t