module TextBuilderDev.UTF16 where

import TextBuilderDev.Prelude
import qualified TextBuilderDev.Unicode as Unicode

-- |
-- A matching function, which chooses the continuation to run.
type UTF16View =
  forall x. (Word16 -> x) -> (Word16 -> Word16 -> x) -> x

{-# INLINE char #-}
char :: Char -> UTF16View
char :: Char -> UTF16View
char Char
x =
  Int -> UTF16View
unicodeCodePoint (Char -> Int
ord Char
x)

{-# INLINE unicodeCodePoint #-}
unicodeCodePoint :: Int -> UTF16View
unicodeCodePoint :: Int -> UTF16View
unicodeCodePoint Int
x Word16 -> x
case1 Word16 -> Word16 -> x
case2 =
  if Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x10000
    then Word16 -> x
case1 (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x)
    else Word16 -> Word16 -> x
case2 Word16
case2Unit1 Word16
case2Unit2
  where
    m :: Int
m =
      Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
0x10000
    case2Unit1 :: Word16
case2Unit1 =
      Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftR Int
m Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0xD800)
    case2Unit2 :: Word16
case2Unit2 =
      Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Int
m Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3FF) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0xDC00)

{-# INLINE utf8CodeUnits1 #-}
utf8CodeUnits1 :: Word8 -> UTF16View
utf8CodeUnits1 :: Word8 -> UTF16View
utf8CodeUnits1 Word8
x Word16 -> x
case1 Word16 -> Word16 -> x
_ =
  Word16 -> x
case1 (Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x)

{-# INLINE utf8CodeUnits2 #-}
utf8CodeUnits2 :: Word8 -> Word8 -> UTF16View
utf8CodeUnits2 :: Word8 -> Word8 -> UTF16View
utf8CodeUnits2 Word8
byte1 Word8
byte2 Word16 -> x
case1 Word16 -> Word16 -> x
_ =
  Word16 -> x
case1 (Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
shiftL (Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
byte1 Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
- Word16
0xC0) Int
6 Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
byte2 Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
- Word16
0x80)

{-# INLINE utf8CodeUnits3 #-}
utf8CodeUnits3 :: Word8 -> Word8 -> Word8 -> UTF16View
utf8CodeUnits3 :: Word8 -> Word8 -> Word8 -> UTF16View
utf8CodeUnits3 Word8
byte1 Word8
byte2 Word8
byte3 =
  Int -> UTF16View
unicodeCodePoint (Word8 -> Word8 -> Word8 -> Int
Unicode.utf8CodeUnits3 Word8
byte1 Word8
byte2 Word8
byte3)

{-# INLINE utf8CodeUnits4 #-}
utf8CodeUnits4 :: Word8 -> Word8 -> Word8 -> Word8 -> UTF16View
utf8CodeUnits4 :: Word8 -> Word8 -> Word8 -> Word8 -> UTF16View
utf8CodeUnits4 Word8
byte1 Word8
byte2 Word8
byte3 Word8
byte4 =
  Int -> UTF16View
unicodeCodePoint (Word8 -> Word8 -> Word8 -> Word8 -> Int
Unicode.utf8CodeUnits4 Word8
byte1 Word8
byte2 Word8
byte3 Word8
byte4)