-- |
-- Module      : Basement.UTF8.Helper
-- License     : BSD-style
-- Maintainer  : Foundation
--
-- Some low level helpers to use UTF8
--
-- Most helpers are lowlevel and unsafe, don't use
-- directly.
{-# LANGUAGE BangPatterns               #-}
{-# LANGUAGE MagicHash                  #-}
{-# LANGUAGE NoImplicitPrelude          #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE CPP                        #-}
module Basement.UTF8.Helper
    where

import           Basement.Compat.Base
import           Basement.Compat.Primitive
import           Basement.Types.OffsetSize
import           Basement.UTF8.Types
import           Basement.Bits
import           GHC.Prim
import           GHC.Types
import           GHC.Word

-- mask an UTF8 continuation byte (stripping the leading 10 and returning 6 valid bits)
maskContinuation# :: Word# -> Word#
maskContinuation# :: Word# -> Word#
maskContinuation# Word#
v = Word# -> Word# -> Word#
and# Word#
v Word#
0x3f##
{-# INLINE maskContinuation# #-}

-- mask a UTF8 header for 2 bytes encoding (110xxxxx and 5 valid bits)
maskHeader2# :: Word# -> Word#
maskHeader2# :: Word# -> Word#
maskHeader2# Word#
h = Word# -> Word# -> Word#
and# Word#
h Word#
0x1f##
{-# INLINE maskHeader2# #-}

-- mask a UTF8 header for 3 bytes encoding (1110xxxx and 4 valid bits)
maskHeader3# :: Word# -> Word#
maskHeader3# :: Word# -> Word#
maskHeader3# Word#
h = Word# -> Word# -> Word#
and# Word#
h Word#
0xf##
{-# INLINE maskHeader3# #-}

-- mask a UTF8 header for 4 bytes encoding (11110xxx and 3 valid bits)
maskHeader4# :: Word# -> Word#
maskHeader4# :: Word# -> Word#
maskHeader4# Word#
h = Word# -> Word# -> Word#
and# Word#
h Word#
0x7##
{-# INLINE maskHeader4# #-}

or3# :: Word# -> Word# -> Word# -> Word#
or3# :: Word# -> Word# -> Word# -> Word#
or3# Word#
a Word#
b Word#
c = Word# -> Word# -> Word#
or# Word#
a (Word# -> Word# -> Word#
or# Word#
b Word#
c)
{-# INLINE or3# #-}

or4# :: Word# -> Word# -> Word# -> Word# -> Word#
or4# :: Word# -> Word# -> Word# -> Word# -> Word#
or4# Word#
a Word#
b Word#
c Word#
d = Word# -> Word# -> Word#
or# (Word# -> Word# -> Word#
or# Word#
a Word#
b) (Word# -> Word# -> Word#
or# Word#
c Word#
d)
{-# INLINE or4# #-}

toChar# :: Word# -> Char
toChar# :: Word# -> Char
toChar# Word#
w = Char# -> Char
C# (Int# -> Char#
chr# (Word# -> Int#
word2Int# Word#
w))
{-# INLINE toChar# #-}

toChar1 :: StepASCII -> Char
toChar1 :: StepASCII -> Char
toChar1 (StepASCII (W8# Word#
w)) = Char# -> Char
C# (Word# -> Char#
word8ToChar# Word#
w)

toChar2 :: StepASCII -> Word8 -> Char
toChar2 :: StepASCII -> Word8 -> Char
toChar2 (StepASCII (W8# Word#
b1)) (W8# Word#
b2) =
    Word# -> Char
toChar# (Word# -> Word# -> Word#
or# (Word# -> Int# -> Word#
uncheckedShiftL# (Word# -> Word#
maskHeader2# Word#
w1) Int#
6#) (Word# -> Word#
maskContinuation# Word#
w2))
  where
    w1 :: Word#
w1 = Word# -> Word#
word8ToWord# Word#
b1
    w2 :: Word#
w2 = Word# -> Word#
word8ToWord# Word#
b2

toChar3 :: StepASCII -> Word8 -> Word8 -> Char
toChar3 :: StepASCII -> Word8 -> Word8 -> Char
toChar3 (StepASCII (W8# Word#
b1)) (W8# Word#
b2) (W8# Word#
b3) =
    Word# -> Char
toChar# (Word# -> Word# -> Word# -> Word#
or3# (Word# -> Int# -> Word#
uncheckedShiftL# (Word# -> Word#
maskHeader3# Word#
w1) Int#
12#)
                  (Word# -> Int# -> Word#
uncheckedShiftL# (Word# -> Word#
maskContinuation# Word#
w2) Int#
6#)
                  (Word# -> Word#
maskContinuation# Word#
w3)
            )
  where
    w1 :: Word#
w1 = Word# -> Word#
word8ToWord# Word#
b1
    w2 :: Word#
w2 = Word# -> Word#
word8ToWord# Word#
b2
    w3 :: Word#
w3 = Word# -> Word#
word8ToWord# Word#
b3

toChar4 :: StepASCII -> Word8 -> Word8 -> Word8 -> Char
toChar4 :: StepASCII -> Word8 -> Word8 -> Word8 -> Char
toChar4 (StepASCII (W8# Word#
b1)) (W8# Word#
b2) (W8# Word#
b3) (W8# Word#
b4) =
    Word# -> Char
toChar# (Word# -> Word# -> Word# -> Word# -> Word#
or4# (Word# -> Int# -> Word#
uncheckedShiftL# (Word# -> Word#
maskHeader4# Word#
w1) Int#
18#)
                  (Word# -> Int# -> Word#
uncheckedShiftL# (Word# -> Word#
maskContinuation# Word#
w2) Int#
12#)
                  (Word# -> Int# -> Word#
uncheckedShiftL# (Word# -> Word#
maskContinuation# Word#
w3) Int#
6#)
                  (Word# -> Word#
maskContinuation# Word#
w4)
            )
  where
    w1 :: Word#
w1 = Word# -> Word#
word8ToWord# Word#
b1
    w2 :: Word#
w2 = Word# -> Word#
word8ToWord# Word#
b2
    w3 :: Word#
w3 = Word# -> Word#
word8ToWord# Word#
b3
    w4 :: Word#
w4 = Word# -> Word#
word8ToWord# Word#
b4

-- | Different way to encode a Character in UTF8 represented as an ADT
data UTF8Char =
      UTF8_1 {-# UNPACK #-} !Word8
    | UTF8_2 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
    | UTF8_3 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
    | UTF8_4 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8

-- | Transform a Unicode code point 'Char' into
--
-- note that we expect here a valid unicode code point in the *allowed* range.
-- bits will be lost if going above 0x10ffff
asUTF8Char :: Char -> UTF8Char
asUTF8Char :: Char -> UTF8Char
asUTF8Char !(C# Char#
c)
  | Int# -> Bool
bool# (Word# -> Word# -> Int#
ltWord# Word#
x Word#
0x80##   ) = UTF8Char
encode1
  | Int# -> Bool
bool# (Word# -> Word# -> Int#
ltWord# Word#
x Word#
0x800##  ) = UTF8Char
encode2
  | Int# -> Bool
bool# (Word# -> Word# -> Int#
ltWord# Word#
x Word#
0x10000##) = UTF8Char
encode3
  | Bool
otherwise                   = UTF8Char
encode4
    where
      !x :: Word#
x = Int# -> Word#
int2Word# (Char# -> Int#
ord# Char#
c)

      encode1 :: UTF8Char
encode1 = Word8 -> UTF8Char
UTF8_1 (Word# -> Word8
W8# (Word# -> Word#
wordToWord8# Word#
x))
      encode2 :: UTF8Char
encode2 =
          let !x1 :: Word8
x1 = Word# -> Word8
W8# (Word# -> Word#
wordToWord8# (Word# -> Word# -> Word#
or# (Word# -> Int# -> Word#
uncheckedShiftRL# Word#
x Int#
6#) Word#
0xc0##))
              !x2 :: Word8
x2 = Word# -> Word8
toContinuation Word#
x
           in Word8 -> Word8 -> UTF8Char
UTF8_2 Word8
x1 Word8
x2
      encode3 :: UTF8Char
encode3 =
          let !x1 :: Word8
x1 = Word# -> Word8
W8# (Word# -> Word#
wordToWord8# (Word# -> Word# -> Word#
or# (Word# -> Int# -> Word#
uncheckedShiftRL# Word#
x Int#
12#) Word#
0xe0##))
              !x2 :: Word8
x2 = Word# -> Word8
toContinuation (Word# -> Int# -> Word#
uncheckedShiftRL# Word#
x Int#
6#)
              !x3 :: Word8
x3 = Word# -> Word8
toContinuation Word#
x
           in Word8 -> Word8 -> Word8 -> UTF8Char
UTF8_3 Word8
x1 Word8
x2 Word8
x3
      encode4 :: UTF8Char
encode4 =
          let !x1 :: Word8
x1 = Word# -> Word8
W8# (Word# -> Word#
wordToWord8# (Word# -> Word# -> Word#
or# (Word# -> Int# -> Word#
uncheckedShiftRL# Word#
x Int#
18#) Word#
0xf0##))
              !x2 :: Word8
x2 = Word# -> Word8
toContinuation (Word# -> Int# -> Word#
uncheckedShiftRL# Word#
x Int#
12#)
              !x3 :: Word8
x3 = Word# -> Word8
toContinuation (Word# -> Int# -> Word#
uncheckedShiftRL# Word#
x Int#
6#)
              !x4 :: Word8
x4 = Word# -> Word8
toContinuation Word#
x
           in Word8 -> Word8 -> Word8 -> Word8 -> UTF8Char
UTF8_4 Word8
x1 Word8
x2 Word8
x3 Word8
x4

      toContinuation :: Word# -> Word8
      toContinuation :: Word# -> Word8
toContinuation Word#
w = Word# -> Word8
W8# (Word# -> Word#
wordToWord8# (Word# -> Word# -> Word#
or# (Word# -> Word# -> Word#
and# Word#
w Word#
0x3f##) Word#
0x80##))
      {-# INLINE toContinuation #-}

-- given the encoding of UTF8 Char, get the number of bytes of this sequence
numBytes :: UTF8Char -> CountOf Word8
numBytes :: UTF8Char -> CountOf Word8
numBytes UTF8_1{} = Int -> CountOf Word8
forall ty. Int -> CountOf ty
CountOf Int
1
numBytes UTF8_2{} = Int -> CountOf Word8
forall ty. Int -> CountOf ty
CountOf Int
2
numBytes UTF8_3{} = Int -> CountOf Word8
forall ty. Int -> CountOf ty
CountOf Int
3
numBytes UTF8_4{} = Int -> CountOf Word8
forall ty. Int -> CountOf ty
CountOf Int
4

-- given the leading byte of a utf8 sequence, get the number of bytes of this sequence
skipNextHeaderValue :: Word8 -> CountOf Word8
skipNextHeaderValue :: Word8 -> CountOf Word8
skipNextHeaderValue !Word8
x
    | Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
0xC0  = Int -> CountOf Word8
forall ty. Int -> CountOf ty
CountOf Int
1 -- 0b11000000
    | Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
0xE0  = Int -> CountOf Word8
forall ty. Int -> CountOf ty
CountOf Int
2 -- 0b11100000
    | Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
0xF0  = Int -> CountOf Word8
forall ty. Int -> CountOf ty
CountOf Int
3 -- 0b11110000
    | Bool
otherwise = Int -> CountOf Word8
forall ty. Int -> CountOf ty
CountOf Int
4
{-# INLINE skipNextHeaderValue #-}

headerIsAscii :: StepASCII -> Bool
headerIsAscii :: StepASCII -> Bool
headerIsAscii (StepASCII Word8
x) = Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
0x80

charToBytes :: Int -> CountOf Word8
charToBytes :: Int -> CountOf Word8
charToBytes Int
c
    | Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x80     = Int -> CountOf Word8
forall ty. Int -> CountOf ty
CountOf Int
1
    | Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x800    = Int -> CountOf Word8
forall ty. Int -> CountOf ty
CountOf Int
2
    | Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x10000  = Int -> CountOf Word8
forall ty. Int -> CountOf ty
CountOf Int
3
    | Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x110000 = Int -> CountOf Word8
forall ty. Int -> CountOf ty
CountOf Int
4
    | Bool
otherwise    = [Char] -> CountOf Word8
forall a. HasCallStack => [Char] -> a
error ([Char]
"invalid code point: " [Char] -> [Char] -> [Char]
forall a. Monoid a => a -> a -> a
`mappend` Int -> [Char]
forall a. Show a => a -> [Char]
show Int
c)

-- | Encode a Char into a CharUTF8
encodeCharUTF8 :: Char -> CharUTF8
encodeCharUTF8 :: Char -> CharUTF8
encodeCharUTF8 !(C# Char#
c)
    | Int# -> Bool
bool# (Word# -> Word# -> Int#
ltWord# Word#
x Word#
0x80##   ) = Word32 -> CharUTF8
CharUTF8 (Word# -> Word32
W32# (Word# -> Word#
wordToWord32# Word#
x))
    | Int# -> Bool
bool# (Word# -> Word# -> Int#
ltWord# Word#
x Word#
0x800##  ) = Word32 -> CharUTF8
CharUTF8 (Word# -> Word32
W32# (Word# -> Word#
wordToWord32# Word#
encode2))
    | Int# -> Bool
bool# (Word# -> Word# -> Int#
ltWord# Word#
x Word#
0x10000##) = Word32 -> CharUTF8
CharUTF8 (Word# -> Word32
W32# (Word# -> Word#
wordToWord32# Word#
encode3))
    | Bool
otherwise                   = Word32 -> CharUTF8
CharUTF8 (Word# -> Word32
W32# (Word# -> Word#
wordToWord32# Word#
encode4))
  where
    !x :: Word#
x = Int# -> Word#
int2Word# (Char# -> Int#
ord# Char#
c)

    -- clearing mask, clearing all the bits that need to be clear as per the UTF8 encoding
    mask2 :: Word#
mask2 = Word#
0x0000bfdf## -- 1 continuation , 5 bits header
    mask3 :: Word#
mask3 = Word#
0x00bfbfef## -- 2 continuations, 4 bits header
    mask4 :: Word#
mask4 = Word#
0xbfbfbff7## -- 3 continuations, 3 bits header

    -- setting mask, settings all the bits that need to be set per the UTF8 encoding
    set2 :: Word#
set2  = Word#
0x000080c0## -- 10xxxxxx     110xxxxx
    set3 :: Word#
set3  = Word#
0x008080e0## -- 10xxxxxx * 2 1110xxxx
    set4 :: Word#
set4  = Word#
0x808080f0## -- 10xxxxxx * 3 11111xxx

    encode2 :: Word#
encode2 = Word# -> Word# -> Word#
and# Word#
mask2 (Word# -> Word# -> Word# -> Word#
or3# Word#
set2
                               (Word# -> Int# -> Word#
uncheckedShiftRL# Word#
x Int#
6#) -- 5 bits to 1st byte
                               (Word# -> Int# -> Word#
uncheckedShiftL# Word#
x Int#
8# ) -- move lowest bits to the 2nd byte
                         )
    encode3 :: Word#
encode3 = Word# -> Word# -> Word#
and# Word#
mask3 (Word# -> Word# -> Word# -> Word# -> Word#
or4# Word#
set3
                               (Word# -> Int# -> Word#
uncheckedShiftRL# Word#
x Int#
12#) -- 4 bits to 1st byte
                               (Word# -> Word# -> Word#
and# Word#
0x3f00## (Word# -> Int# -> Word#
uncheckedShiftL# Word#
x Int#
2#)) -- 6 bits to the 2nd byte
                               (Word# -> Int# -> Word#
uncheckedShiftL# Word#
x Int#
16# ) -- move lowest bits to the 3rd byte
                         )
    encode4 :: Word#
encode4 = Word# -> Word# -> Word#
and# Word#
mask4 (Word# -> Word# -> Word# -> Word# -> Word#
or4# Word#
set4
                               (Word# -> Int# -> Word#
uncheckedShiftRL# Word#
x Int#
18#) -- 3 bits to 1st byte
                               (Word# -> Word# -> Word#
or# (Word# -> Word# -> Word#
and# Word#
0x3f00## (Word# -> Int# -> Word#
uncheckedShiftRL# Word#
x Int#
4#))   -- 6 bits to the 2nd byte
                                    (Word# -> Word# -> Word#
and# Word#
0x3f0000## (Word# -> Int# -> Word#
uncheckedShiftL# Word#
x Int#
10#)) -- 6 bits to the 3nd byte
                               )
                               (Word# -> Int# -> Word#
uncheckedShiftL# Word#
x Int#
24# ) -- move lowest bits to the 4rd byte
                         )

-- | decode a CharUTF8 into a Char
--
-- If the value inside a CharUTF8 is not properly encoded, this will result in violation
-- of the Char invariants
decodeCharUTF8 :: CharUTF8 -> Char
decodeCharUTF8 :: CharUTF8 -> Char
decodeCharUTF8 c :: CharUTF8
c@(CharUTF8 !(W32# Word#
w_))
    | CharUTF8 -> Bool
isCharUTF8Case1 CharUTF8
c = Word# -> Char
toChar# Word#
w
    | CharUTF8 -> Bool
isCharUTF8Case2 CharUTF8
c = Char
encode2
    | CharUTF8 -> Bool
isCharUTF8Case3 CharUTF8
c = Char
encode3
    | Bool
otherwise         = Char
encode4
  where
    w :: Word#
w = Word# -> Word#
word32ToWord# Word#
w_
    encode2 :: Char
encode2 =
        Word# -> Char
toChar# (Word# -> Word# -> Word#
or# (Word# -> Int# -> Word#
uncheckedShiftL# (Word# -> Word#
maskHeader2# Word#
w) Int#
6#)
                     (Word# -> Word#
maskContinuation# (Word# -> Int# -> Word#
uncheckedShiftRL# Word#
w Int#
8#))
                )
    encode3 :: Char
encode3 =
        Word# -> Char
toChar# (Word# -> Word# -> Word# -> Word#
or3# (Word# -> Int# -> Word#
uncheckedShiftL# (Word# -> Word#
maskHeader3# Word#
w) Int#
12#)
                      (Word# -> Int# -> Word#
uncheckedShiftRL# (Word# -> Word# -> Word#
and# Word#
0x3f00## Word#
w) Int#
8#)
                      (Word# -> Word#
maskContinuation# (Word# -> Int# -> Word#
uncheckedShiftRL# Word#
w Int#
16#))
                )
    encode4 :: Char
encode4 =
        Word# -> Char
toChar# (Word# -> Word# -> Word# -> Word# -> Word#
or4# (Word# -> Int# -> Word#
uncheckedShiftL#  (Word# -> Word#
maskHeader4# Word#
w) Int#
18#)
                      (Word# -> Int# -> Word#
uncheckedShiftRL# (Word# -> Word# -> Word#
and# Word#
0x3f00## Word#
w) Int#
10#)
                      (Word# -> Int# -> Word#
uncheckedShiftL#  (Word# -> Word# -> Word#
and# Word#
0x3f0000## Word#
w) Int#
4#)
                      (Word# -> Word#
maskContinuation# (Word# -> Int# -> Word#
uncheckedShiftRL# Word#
w Int#
24#))
                )

    -- clearing mask, removing all UTF8 metadata and keeping only signal (content)
    --maskContent2 = 0x00003f1f## -- 1 continuation , 5 bits header
    --maskContent3 = 0x003f3f0f## -- 2 continuations, 4 bits header
    --maskContent4 = 0x3f3f3f07## -- 3 continuations, 3 bits header

isCharUTF8Case1 :: CharUTF8 -> Bool
isCharUTF8Case1 :: CharUTF8 -> Bool
isCharUTF8Case1 (CharUTF8 !Word32
w) = (Word32
w Word32 -> Word32 -> Word32
forall bits. BitOps bits => bits -> bits -> bits
.&. Word32
0x80) Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0
{-# INLINE isCharUTF8Case1 #-}

isCharUTF8Case2 :: CharUTF8 -> Bool
isCharUTF8Case2 :: CharUTF8 -> Bool
isCharUTF8Case2 (CharUTF8 !Word32
w) = (Word32
w Word32 -> Word32 -> Word32
forall bits. BitOps bits => bits -> bits -> bits
.&. Word32
0x20) Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0
{-# INLINE isCharUTF8Case2 #-}

isCharUTF8Case3 :: CharUTF8 -> Bool
isCharUTF8Case3 :: CharUTF8 -> Bool
isCharUTF8Case3 (CharUTF8 !Word32
w) = (Word32
w Word32 -> Word32 -> Word32
forall bits. BitOps bits => bits -> bits -> bits
.&. Word32
0x10) Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0
{-# INLINE isCharUTF8Case3 #-}

isCharUTF8Case4 :: CharUTF8 -> Bool
isCharUTF8Case4 :: CharUTF8 -> Bool
isCharUTF8Case4 (CharUTF8 !Word32
w) = (Word32
w Word32 -> Word32 -> Word32
forall bits. BitOps bits => bits -> bits -> bits
.&. Word32
0x08) Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0
{-# INLINE isCharUTF8Case4 #-}