{-# OPTIONS_GHC -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TupleSections #-}
-- |
-- Module      : Data.Unicode.Internal.NormalizeStream
-- Copyright   : (c) 2016 Harendra Kumar
--               (c) 2020 Andrew Lelechenko
--
-- License     : BSD-3-Clause
-- Maintainer  : harendra.kumar@gmail.com
-- Stability   : experimental
--
-- Stream based normalization.
--
module Data.Unicode.Internal.NormalizeStream
    (
      UC.DecomposeMode(..)
    , stream
    , unstream
    , unstreamC
    )
    where

import Data.Char (chr, ord)
import GHC.ST (ST(..))
import GHC.Types (SPEC(..))

import qualified Data.Text.Array as A
import qualified Unicode.Char as UC

#if MIN_VERSION_text(2,0,0)
import Data.Text.Internal.Fusion (stream)
#else
import Data.Bits (shiftR)
import Data.Text.Internal.Unsafe.Char (unsafeChr)
import Data.Text.Internal.Fusion.Size (betweenSize)
import Data.Text.Internal.Encoding.Utf16 (chr2)
#endif

-- Internal modules
import Data.Text.Internal (Text(..))
import Data.Text.Internal.Fusion.Size (upperBound)
import Data.Text.Internal.Fusion.Types (Step(..), Stream(..))
import Data.Text.Internal.Private (runText)
import Data.Text.Internal.Unsafe.Char (unsafeWrite)

-------------------------------------------------------------------------------
-- Reorder buffer to hold characters till the next starter boundary
-------------------------------------------------------------------------------

-- | A list of combining characters, ordered by 'UC.combiningClass'.
-- Couple of top levels are unrolled and unpacked for efficiency.
data ReBuf = Empty | One !Char | Many !Char !Char ![Char]

{-# INLINE insertIntoReBuf #-}
insertIntoReBuf :: Char -> ReBuf -> ReBuf
insertIntoReBuf :: Char -> ReBuf -> ReBuf
insertIntoReBuf Char
c ReBuf
Empty = Char -> ReBuf
One Char
c
insertIntoReBuf Char
c (One Char
c0)
    | Char -> Int
UC.combiningClass Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Char -> Int
UC.combiningClass Char
c0
    = Char -> Char -> [Char] -> ReBuf
Many Char
c Char
c0 []
    | Bool
otherwise
    = Char -> Char -> [Char] -> ReBuf
Many Char
c0 Char
c []
insertIntoReBuf Char
c (Many Char
c0 Char
c1 [Char]
cs)
    | Int
cc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Char -> Int
UC.combiningClass Char
c0
    = Char -> Char -> [Char] -> ReBuf
Many Char
c Char
c0 (Char
c1 Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
cs)
    | Int
cc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Char -> Int
UC.combiningClass Char
c1
    = Char -> Char -> [Char] -> ReBuf
Many Char
c0 Char
c (Char
c1 Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
cs)
    | Bool
otherwise
    = Char -> Char -> [Char] -> ReBuf
Many Char
c0 Char
c1 ([Char]
cs' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (Char
c Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
cs''))
    where
        cc :: Int
cc = Char -> Int
UC.combiningClass Char
c
        ([Char]
cs', [Char]
cs'') = (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
cc) (Int -> Bool) -> (Char -> Int) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
UC.combiningClass) [Char]
cs

writeStr :: A.MArray s -> Int -> [Char] -> ST s Int
writeStr :: MArray s -> Int -> [Char] -> ST s Int
writeStr MArray s
marr Int
di [Char]
str = Int -> [Char] -> ST s Int
go Int
di [Char]
str
    where
        go :: Int -> [Char] -> ST s Int
go Int
i [] = Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
i
        go Int
i (Char
c : [Char]
cs) = do
            Int
n <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
marr Int
i Char
c
            Int -> [Char] -> ST s Int
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) [Char]
cs

{-# INLINE writeReorderBuffer #-}
writeReorderBuffer :: A.MArray s -> Int -> ReBuf -> ST s Int
writeReorderBuffer :: MArray s -> Int -> ReBuf -> ST s Int
writeReorderBuffer MArray s
_ Int
di ReBuf
Empty = Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
di

writeReorderBuffer MArray s
marr Int
di (One Char
c) = do
    Int
n <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
marr Int
di Char
c
    Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
di Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)

writeReorderBuffer MArray s
marr Int
di (Many Char
c1 Char
c2 [Char]
str) = do
    Int
n1 <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
marr Int
di Char
c1
    Int
n2 <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
marr (Int
di Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n1) Char
c2
    MArray s -> Int -> [Char] -> ST s Int
forall s. MArray s -> Int -> [Char] -> ST s Int
writeStr MArray s
marr (Int
di Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n2) [Char]
str

-------------------------------------------------------------------------------
-- Decomposition of Hangul characters is done algorithmically
-------------------------------------------------------------------------------

-- {-# INLINE decomposeCharHangul #-}
decomposeCharHangul :: A.MArray s -> Int -> Char -> ST s Int
decomposeCharHangul :: MArray s -> Int -> Char -> ST s Int
decomposeCharHangul MArray s
marr Int
j Char
c =
    if Char
t Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Char
chr Int
UC.jamoTFirst then do
        Int
n1 <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
marr Int
j Char
l
        Int
n2 <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
marr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n1) Char
v
        Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n2)
    else do
        Int
n1 <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
marr Int
j Char
l
        Int
n2 <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
marr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n1) Char
v
        Int
n3 <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
marr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n2) Char
t
        Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n3)
    where
        (Char
l, Char
v, Char
t) = Char -> (Char, Char, Char)
UC.decomposeHangul Char
c

{-# INLINE decomposeChar #-}
decomposeChar
    :: UC.DecomposeMode
    -> A.MArray s       -- destination array for decomposition
    -> Int              -- array index
    -> ReBuf            -- reorder buffer
    -> Char             -- char to be decomposed
    -> ST s (Int, ReBuf)
decomposeChar :: DecomposeMode
-> MArray s -> Int -> ReBuf -> Char -> ST s (Int, ReBuf)
decomposeChar DecomposeMode
mode MArray s
marr Int
index ReBuf
reBuf Char
ch
    | Char -> Bool
UC.isHangul Char
ch = do
        Int
j <- MArray s -> Int -> ReBuf -> ST s Int
forall s. MArray s -> Int -> ReBuf -> ST s Int
writeReorderBuffer MArray s
marr Int
index ReBuf
reBuf
        (, ReBuf
Empty) (Int -> (Int, ReBuf)) -> ST s Int -> ST s (Int, ReBuf)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
decomposeCharHangul MArray s
marr Int
j Char
ch
    | DecomposeMode -> Char -> Bool
UC.isDecomposable DecomposeMode
mode Char
ch =
        MArray s -> Int -> ReBuf -> [Char] -> ST s (Int, ReBuf)
forall s. MArray s -> Int -> ReBuf -> [Char] -> ST s (Int, ReBuf)
decomposeAll MArray s
marr Int
index ReBuf
reBuf (DecomposeMode -> Char -> [Char]
UC.decompose DecomposeMode
mode Char
ch)
    | Bool
otherwise =
        MArray s -> Int -> ReBuf -> Char -> ST s (Int, ReBuf)
forall s. MArray s -> Int -> ReBuf -> Char -> ST s (Int, ReBuf)
reorder MArray s
marr Int
index ReBuf
reBuf Char
ch

    where

    {-# INLINE decomposeAll #-}
    decomposeAll :: MArray s -> Int -> ReBuf -> [Char] -> ST s (Int, ReBuf)
decomposeAll MArray s
_ Int
i ReBuf
rbuf [] = (Int, ReBuf) -> ST s (Int, ReBuf)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
i, ReBuf
rbuf)
    decomposeAll MArray s
arr Int
i ReBuf
rbuf (Char
x : [Char]
xs)
        | DecomposeMode -> Char -> Bool
UC.isDecomposable DecomposeMode
mode Char
x = do
            (Int
i', ReBuf
rbuf') <- MArray s -> Int -> ReBuf -> [Char] -> ST s (Int, ReBuf)
decomposeAll MArray s
arr Int
i ReBuf
rbuf (DecomposeMode -> Char -> [Char]
UC.decompose DecomposeMode
mode Char
x)
            MArray s -> Int -> ReBuf -> [Char] -> ST s (Int, ReBuf)
decomposeAll MArray s
arr Int
i' ReBuf
rbuf' [Char]
xs
        | Bool
otherwise  = do
            (Int
i', ReBuf
rbuf') <- MArray s -> Int -> ReBuf -> Char -> ST s (Int, ReBuf)
forall s. MArray s -> Int -> ReBuf -> Char -> ST s (Int, ReBuf)
reorder MArray s
arr Int
i ReBuf
rbuf Char
x
            MArray s -> Int -> ReBuf -> [Char] -> ST s (Int, ReBuf)
decomposeAll MArray s
arr Int
i' ReBuf
rbuf' [Char]
xs

    {-# INLINE reorder #-}
    reorder :: MArray s -> Int -> ReBuf -> Char -> ST s (Int, ReBuf)
reorder MArray s
arr Int
i ReBuf
rbuf Char
c
        | Char -> Bool
UC.isCombining Char
c = (Int, ReBuf) -> ST s (Int, ReBuf)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
i, Char -> ReBuf -> ReBuf
insertIntoReBuf Char
c ReBuf
rbuf)
        | Bool
otherwise = do
            Int
j <- MArray s -> Int -> ReBuf -> ST s Int
forall s. MArray s -> Int -> ReBuf -> ST s Int
writeReorderBuffer MArray s
arr Int
i ReBuf
rbuf
            Int
n <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
arr Int
j Char
c
            (Int, ReBuf) -> ST s (Int, ReBuf)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n, ReBuf
Empty)

#if !MIN_VERSION_text(2,0,0)
-- | /O(n)/ Convert a 'Text' into a 'Stream Char'.
stream :: Text -> Stream Char
stream :: Text -> Stream Char
stream (Text Array
arr Int
off Int
len) = (Int -> Step Int Char) -> Int -> Size -> Stream Char
forall a s. (s -> Step s a) -> s -> Size -> Stream a
Stream Int -> Step Int Char
next Int
off (Int -> Int -> Size
betweenSize (Int
len Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
1) Int
len)
    where
      !end :: Int
end = Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
len
      {-# INLINE next #-}
      next :: Int -> Step Int Char
next !Int
i
          | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
end                   = Step Int Char
forall s a. Step s a
Done
          -- shift generates only two branches instead of three in case of
          -- range check, works quite a bit faster with llvm backend.
          | (Word16
n Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftR` Int
10) Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
0x36    = Char -> Int -> Step Int Char
forall s a. a -> s -> Step s a
Yield (Word16 -> Word16 -> Char
chr2 Word16
n Word16
n2) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
          | Bool
otherwise                  = Char -> Int -> Step Int Char
forall s a. a -> s -> Step s a
Yield (Word16 -> Char
unsafeChr Word16
n) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
          where
            n :: Word16
n  = Array -> Int -> Word16
A.unsafeIndex Array
arr Int
i
            n2 :: Word16
n2 = Array -> Int -> Word16
A.unsafeIndex Array
arr (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
{-# INLINE [0] stream #-}
#endif

-- | /O(n)/ Convert a 'Stream Char' into a decompose-normalized 'Text'.
unstream :: UC.DecomposeMode -> Stream Char -> Text
unstream :: DecomposeMode -> Stream Char -> Text
unstream DecomposeMode
mode (Stream s -> Step s Char
next0 s
s0 Size
len) = (forall s. (MArray s -> Int -> ST s Text) -> ST s Text) -> Text
runText ((forall s. (MArray s -> Int -> ST s Text) -> ST s Text) -> Text)
-> (forall s. (MArray s -> Int -> ST s Text) -> ST s Text) -> Text
forall a b. (a -> b) -> a -> b
$ \MArray s -> Int -> ST s Text
done -> do
  -- Before encoding each char we perform a buffer realloc check assuming
  -- worst case encoding size of two 16-bit units for the char. Just add an
  -- extra space to the buffer so that we do not end up reallocating even when
  -- all the chars are encoded as single unit.
  let margin :: Int
margin = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
maxDecomposeLen
      mlen :: Int
mlen = (Int -> Size -> Int
upperBound Int
4 Size
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
margin)
  MArray s
arr0 <- Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.new Int
mlen
  let outer :: MArray s -> Int -> s -> Int -> ReBuf -> ST s Text
outer !MArray s
arr !Int
maxi = s -> Int -> ReBuf -> ST s Text
encode
       where
        -- keep the common case loop as small as possible
        encode :: s -> Int -> ReBuf -> ST s Text
encode !s
si !Int
di ReBuf
rbuf =
            -- simply check for the worst case
            if Int
maxi Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
di Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
margin
            then s -> Int -> ReBuf -> ST s Text
realloc s
si Int
di ReBuf
rbuf
            else
                case s -> Step s Char
next0 s
si of
                    Step s Char
Done -> do
                        Int
di' <- MArray s -> Int -> ReBuf -> ST s Int
forall s. MArray s -> Int -> ReBuf -> ST s Int
writeReorderBuffer MArray s
arr Int
di ReBuf
rbuf
                        MArray s -> Int -> ST s Text
done MArray s
arr Int
di'
                    Skip s
si'    -> s -> Int -> ReBuf -> ST s Text
encode s
si' Int
di ReBuf
rbuf
                    Yield Char
c s
si' -> do
                                (Int
di', ReBuf
rbuf') <- DecomposeMode
-> MArray s -> Int -> ReBuf -> Char -> ST s (Int, ReBuf)
forall s.
DecomposeMode
-> MArray s -> Int -> ReBuf -> Char -> ST s (Int, ReBuf)
decomposeChar DecomposeMode
mode MArray s
arr Int
di ReBuf
rbuf Char
c
                                s -> Int -> ReBuf -> ST s Text
encode s
si' Int
di' ReBuf
rbuf'
                                -- n <- unsafeWrite arr di c
                                -- encode si' (di + n) rbuf

        -- keep uncommon case separate from the common case code
        {-# NOINLINE realloc #-}
        realloc :: s -> Int -> ReBuf -> ST s Text
realloc !s
si !Int
di ReBuf
rbuf = do
            let newlen :: Int
newlen = Int
maxi Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2
            MArray s
arr' <- Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.new Int
newlen
            MArray s -> Int -> MArray s -> Int -> Int -> ST s ()
forall s. MArray s -> Int -> MArray s -> Int -> Int -> ST s ()
A.copyM MArray s
arr' Int
0 MArray s
arr Int
0 Int
di
            MArray s -> Int -> s -> Int -> ReBuf -> ST s Text
outer MArray s
arr' (Int
newlen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) s
si Int
di ReBuf
rbuf

  MArray s -> Int -> s -> Int -> ReBuf -> ST s Text
outer MArray s
arr0 (Int
mlen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) s
s0 Int
0 ReBuf
Empty
{-# INLINE [0] unstream #-}

-- we can generate this from UCD
maxDecomposeLen :: Int
maxDecomposeLen :: Int
maxDecomposeLen = Int
32

-------------------------------------------------------------------------------
-- Composition
-------------------------------------------------------------------------------

-- If we are composing we do not need to first decompose Hangul. We can just
-- compose assuming there could be some partially composed syllables e.g. LV
-- syllable followed by a jamo T. We need to compose this case as well.

-- Hold an L to wait for V, hold an LV to wait for T.
data JamoBuf
    = Jamo !Char -- Jamo L, V or T
    | Hangul !Char -- Hangul Syllable LV or LVT
    | HangulLV !Char

data RegBuf
    = RegOne !Char
    | RegMany !Char !Char ![Char]

data ComposeState
    = ComposeNone
    | ComposeReg !RegBuf
    | ComposeJamo !JamoBuf

-------------------------------------------------------------------------------
-- Composition of Jamo into Hangul syllables, done algorithmically
-------------------------------------------------------------------------------

{-# INLINE writeJamoBuf #-}
writeJamoBuf :: A.MArray s -> Int -> JamoBuf -> ST s Int
writeJamoBuf :: MArray s -> Int -> JamoBuf -> ST s Int
writeJamoBuf MArray s
arr Int
i JamoBuf
jbuf = do
    Int
n <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
arr Int
i (JamoBuf -> Char
getCh JamoBuf
jbuf)
    Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)

    where

    getCh :: JamoBuf -> Char
getCh (Jamo Char
ch) = Char
ch
    getCh (Hangul Char
ch) = Char
ch
    getCh (HangulLV Char
ch) = Char
ch

{-# INLINE initHangul #-}
initHangul :: Char -> Int -> ST s (Int, ComposeState)
initHangul :: Char -> Int -> ST s (Int, ComposeState)
initHangul Char
c Int
i = (Int, ComposeState) -> ST s (Int, ComposeState)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
i, JamoBuf -> ComposeState
ComposeJamo (Char -> JamoBuf
Hangul Char
c))

{-# INLINE initJamo #-}
initJamo :: Char -> Int -> ST s (Int, ComposeState)
initJamo :: Char -> Int -> ST s (Int, ComposeState)
initJamo Char
c Int
i = (Int, ComposeState) -> ST s (Int, ComposeState)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
i, JamoBuf -> ComposeState
ComposeJamo (Char -> JamoBuf
Jamo Char
c))

{-# INLINE insertJamo #-}
insertJamo
    :: A.MArray s -> Int -> JamoBuf -> Char -> ST s (Int, ComposeState)
insertJamo :: MArray s -> Int -> JamoBuf -> Char -> ST s (Int, ComposeState)
insertJamo MArray s
arr Int
i JamoBuf
jbuf Char
ch
    | Int
ich Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
UC.jamoLLast = do
        Int
j <- MArray s -> Int -> JamoBuf -> ST s Int
forall s. MArray s -> Int -> JamoBuf -> ST s Int
writeJamoBuf MArray s
arr Int
i JamoBuf
jbuf
        (Int, ComposeState) -> ST s (Int, ComposeState)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
j, JamoBuf -> ComposeState
ComposeJamo (Char -> JamoBuf
Jamo Char
ch))
    | Int
ich Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
UC.jamoVFirst =
        MArray s -> Int -> JamoBuf -> Char -> ST s (Int, ComposeState)
forall s.
MArray s -> Int -> JamoBuf -> Char -> ST s (Int, ComposeState)
flushAndWrite MArray s
arr Int
i JamoBuf
jbuf Char
ch
    | Int
ich Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
UC.jamoVLast = do
        case JamoBuf
jbuf of
            Jamo Char
c ->
                case Char -> Maybe Int
UC.jamoLIndex Char
c of
                    Just Int
li ->
                        let vi :: Int
vi = Int
ich Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
UC.jamoVFirst
                            lvi :: Int
lvi = Int
li Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
UC.jamoNCount Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
vi Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
UC.jamoTCount
                            lv :: Char
lv = Int -> Char
chr (Int
UC.hangulFirst Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lvi)
                         in (Int, ComposeState) -> ST s (Int, ComposeState)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
i, JamoBuf -> ComposeState
ComposeJamo (Char -> JamoBuf
HangulLV Char
lv))
                    Maybe Int
Nothing -> MArray s -> Int -> Char -> Char -> ST s (Int, ComposeState)
forall s.
MArray s -> Int -> Char -> Char -> ST s (Int, ComposeState)
writeTwo MArray s
arr Int
i Char
c Char
ch
            Hangul Char
c -> MArray s -> Int -> Char -> Char -> ST s (Int, ComposeState)
forall s.
MArray s -> Int -> Char -> Char -> ST s (Int, ComposeState)
writeTwo MArray s
arr Int
i Char
c Char
ch
            HangulLV Char
c -> MArray s -> Int -> Char -> Char -> ST s (Int, ComposeState)
forall s.
MArray s -> Int -> Char -> Char -> ST s (Int, ComposeState)
writeTwo MArray s
arr Int
i Char
c Char
ch
    | Int
ich Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
UC.jamoTFirst = do
        MArray s -> Int -> JamoBuf -> Char -> ST s (Int, ComposeState)
forall s.
MArray s -> Int -> JamoBuf -> Char -> ST s (Int, ComposeState)
flushAndWrite MArray s
arr Int
i JamoBuf
jbuf Char
ch
    | Bool
otherwise = do
        let ti :: Int
ti = Int
ich Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
UC.jamoTFirst
        case JamoBuf
jbuf of
            Jamo Char
c -> MArray s -> Int -> Char -> Char -> ST s (Int, ComposeState)
forall s.
MArray s -> Int -> Char -> Char -> ST s (Int, ComposeState)
writeTwo MArray s
arr Int
i Char
c Char
ch
            Hangul Char
c
                | Char -> Bool
UC.isHangulLV Char
c -> do
                    MArray s -> Int -> Char -> Int -> ST s (Int, ComposeState)
forall s.
MArray s -> Int -> Char -> Int -> ST s (Int, ComposeState)
writeLVT MArray s
arr Int
i Char
c Int
ti
                | Bool
otherwise ->
                    MArray s -> Int -> Char -> Char -> ST s (Int, ComposeState)
forall s.
MArray s -> Int -> Char -> Char -> ST s (Int, ComposeState)
writeTwo MArray s
arr Int
i Char
c Char
ch
            HangulLV Char
c ->
                MArray s -> Int -> Char -> Int -> ST s (Int, ComposeState)
forall s.
MArray s -> Int -> Char -> Int -> ST s (Int, ComposeState)
writeLVT MArray s
arr Int
i Char
c Int
ti

    where

    ich :: Int
ich = Char -> Int
ord Char
ch

    {-# INLINE flushAndWrite #-}
    flushAndWrite :: MArray s -> Int -> JamoBuf -> Char -> ST s (Int, ComposeState)
flushAndWrite MArray s
marr Int
ix JamoBuf
jb Char
c = do
        Int
j <- MArray s -> Int -> JamoBuf -> ST s Int
forall s. MArray s -> Int -> JamoBuf -> ST s Int
writeJamoBuf MArray s
marr Int
ix JamoBuf
jb
        Int
n <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
marr Int
j Char
c
        (Int, ComposeState) -> ST s (Int, ComposeState)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n, ComposeState
ComposeNone)

    {-# INLINE writeLVT #-}
    writeLVT :: MArray s -> Int -> Char -> Int -> ST s (Int, ComposeState)
writeLVT MArray s
marr Int
ix Char
lv Int
ti = do
        Int
n <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
marr Int
ix (Int -> Char
chr ((Char -> Int
ord Char
lv) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ti))
        (Int, ComposeState) -> ST s (Int, ComposeState)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n, ComposeState
ComposeNone)

    {-# INLINE writeTwo #-}
    writeTwo :: MArray s -> Int -> Char -> Char -> ST s (Int, ComposeState)
writeTwo MArray s
marr Int
ix Char
c1 Char
c2 = do
        Int
n <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
marr Int
ix Char
c1
        Int
m <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
marr (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) Char
c2
        (Int, ComposeState) -> ST s (Int, ComposeState)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
m), ComposeState
ComposeNone)

{-# INLINE insertHangul #-}
insertHangul
    :: A.MArray s -> Int -> JamoBuf -> Char -> ST s (Int, ComposeState)
insertHangul :: MArray s -> Int -> JamoBuf -> Char -> ST s (Int, ComposeState)
insertHangul MArray s
arr Int
i JamoBuf
jbuf Char
ch = do
    Int
j <- MArray s -> Int -> JamoBuf -> ST s Int
forall s. MArray s -> Int -> JamoBuf -> ST s Int
writeJamoBuf MArray s
arr Int
i JamoBuf
jbuf
    (Int, ComposeState) -> ST s (Int, ComposeState)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
j, JamoBuf -> ComposeState
ComposeJamo (Char -> JamoBuf
Hangul Char
ch))

{-# INLINE insertIntoRegBuf #-}
insertIntoRegBuf :: Char -> RegBuf -> RegBuf
insertIntoRegBuf :: Char -> RegBuf -> RegBuf
insertIntoRegBuf Char
c (RegOne Char
c0)
    | Char -> Int
UC.combiningClass Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Char -> Int
UC.combiningClass Char
c0
    = Char -> Char -> [Char] -> RegBuf
RegMany Char
c Char
c0 []
    | Bool
otherwise
    = Char -> Char -> [Char] -> RegBuf
RegMany Char
c0 Char
c []
insertIntoRegBuf Char
c (RegMany Char
c0 Char
c1 [Char]
cs)
    | Int
cc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Char -> Int
UC.combiningClass Char
c0
    = Char -> Char -> [Char] -> RegBuf
RegMany Char
c Char
c0 (Char
c1 Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
cs)
    | Int
cc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Char -> Int
UC.combiningClass Char
c1
    = Char -> Char -> [Char] -> RegBuf
RegMany Char
c0 Char
c (Char
c1 Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
cs)
    | Bool
otherwise
    = Char -> Char -> [Char] -> RegBuf
RegMany Char
c0 Char
c1 ([Char]
cs' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (Char
c Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
cs''))
    where
        cc :: Int
cc = Char -> Int
UC.combiningClass Char
c
        ([Char]
cs', [Char]
cs'') = (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
cc) (Int -> Bool) -> (Char -> Int) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
UC.combiningClass) [Char]
cs

{-# INLINE writeRegBuf #-}
writeRegBuf :: A.MArray s -> Int -> RegBuf -> ST s Int
writeRegBuf :: MArray s -> Int -> RegBuf -> ST s Int
writeRegBuf MArray s
arr Int
i = \case
    RegOne Char
c -> do
        Int
n <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
arr Int
i Char
c
        Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)
    RegMany Char
st Char
c [] ->
        case Char -> Char -> Maybe Char
UC.compose Char
st Char
c of
            Just Char
x -> do
                Int
n <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
arr Int
i Char
x
                Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)
            Maybe Char
Nothing -> do
                Int
n <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
arr Int
i Char
st
                Int
m <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
arr (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) Char
c
                Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
m)
    RegMany Char
st0 Char
c0 [Char]
cs0 -> [Char] -> Char -> [Char] -> ST s Int
go [] Char
st0 (Char
c0 Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
cs0)

    where

    -- arguments: uncombined chars, starter, unprocessed str
    go :: [Char] -> Char -> [Char] -> ST s Int
go [Char]
uncs Char
st [] = MArray s -> Int -> [Char] -> ST s Int
forall s. MArray s -> Int -> [Char] -> ST s Int
writeStr MArray s
arr Int
i (Char
st Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
uncs)
    go [Char]
uncs Char
st (Char
c : [Char]
cs) = case Char -> Char -> Maybe Char
UC.compose Char
st Char
c of
        Maybe Char
Nothing -> [Char] -> Char -> [Char] -> ST s Int
go ([Char]
uncs [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (Char
c Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
same)) Char
st [Char]
bigger
        Just Char
x  -> [Char] -> Char -> [Char] -> ST s Int
go [Char]
uncs Char
x [Char]
cs
        where
            cc :: Int
cc = Char -> Int
UC.combiningClass Char
c
            ([Char]
same, [Char]
bigger) = (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
cc) (Int -> Bool) -> (Char -> Int) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
UC.combiningClass) [Char]
cs

{-# INLINE flushComposeState #-}
flushComposeState :: A.MArray s -> Int -> ComposeState -> ST s Int
flushComposeState :: MArray s -> Int -> ComposeState -> ST s Int
flushComposeState MArray s
arr Int
i = \case
    ComposeState
ComposeNone -> Int -> ST s Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
i
    ComposeReg RegBuf
rbuf -> MArray s -> Int -> RegBuf -> ST s Int
forall s. MArray s -> Int -> RegBuf -> ST s Int
writeRegBuf MArray s
arr Int
i RegBuf
rbuf
    ComposeJamo JamoBuf
jbuf -> MArray s -> Int -> JamoBuf -> ST s Int
forall s. MArray s -> Int -> JamoBuf -> ST s Int
writeJamoBuf MArray s
arr Int
i JamoBuf
jbuf

{-# INLINE composeChar #-}
composeChar
    :: UC.DecomposeMode
    -> A.MArray s       -- destination array for composition
    -> Char             -- input char
    -> Int              -- array index
    -> ComposeState
    -> ST s (Int, ComposeState)
composeChar :: DecomposeMode
-> MArray s
-> Char
-> Int
-> ComposeState
-> ST s (Int, ComposeState)
composeChar DecomposeMode
mode MArray s
marr = Char -> Int -> ComposeState -> ST s (Int, ComposeState)
go0

    where

    go0 :: Char -> Int -> ComposeState -> ST s (Int, ComposeState)
go0 Char
ch !Int
i !ComposeState
st =
        case ComposeState
st of
            ComposeReg RegBuf
rbuf
                | Int
ich Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
UC.jamoLFirst ->
                    RegBuf -> Char -> Int -> ComposeState -> ST s (Int, ComposeState)
composeReg RegBuf
rbuf Char
ch Int
i ComposeState
st
                | Int
ich Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
UC.jamoTLast -> do
                    Int
j <- MArray s -> Int -> RegBuf -> ST s Int
forall s. MArray s -> Int -> RegBuf -> ST s Int
writeRegBuf MArray s
marr Int
i RegBuf
rbuf
                    Char -> Int -> ST s (Int, ComposeState)
forall s. Char -> Int -> ST s (Int, ComposeState)
initJamo Char
ch Int
j
                | Int
ich Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
UC.hangulFirst ->
                    RegBuf -> Char -> Int -> ComposeState -> ST s (Int, ComposeState)
composeReg RegBuf
rbuf Char
ch Int
i ComposeState
st
                | Int
ich Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
UC.hangulLast -> do
                    Int
j <- MArray s -> Int -> RegBuf -> ST s Int
forall s. MArray s -> Int -> RegBuf -> ST s Int
writeRegBuf MArray s
marr Int
i RegBuf
rbuf
                    Char -> Int -> ST s (Int, ComposeState)
forall s. Char -> Int -> ST s (Int, ComposeState)
initHangul Char
ch Int
j
                | Bool
otherwise ->
                    RegBuf -> Char -> Int -> ComposeState -> ST s (Int, ComposeState)
composeReg RegBuf
rbuf Char
ch Int
i ComposeState
st
            ComposeJamo JamoBuf
jbuf
                | Int
ich Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
UC.jamoLFirst -> do
                    MArray s -> Int -> JamoBuf -> Char -> ST s (Int, ComposeState)
jamoToReg MArray s
marr Int
i JamoBuf
jbuf Char
ch
                | Int
ich Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
UC.jamoTLast -> do
                    MArray s -> Int -> JamoBuf -> Char -> ST s (Int, ComposeState)
forall s.
MArray s -> Int -> JamoBuf -> Char -> ST s (Int, ComposeState)
insertJamo MArray s
marr Int
i JamoBuf
jbuf Char
ch
                | Int
ich Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
UC.hangulFirst ->
                    MArray s -> Int -> JamoBuf -> Char -> ST s (Int, ComposeState)
jamoToReg MArray s
marr Int
i JamoBuf
jbuf Char
ch
                | Int
ich Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
UC.hangulLast -> do
                    MArray s -> Int -> JamoBuf -> Char -> ST s (Int, ComposeState)
forall s.
MArray s -> Int -> JamoBuf -> Char -> ST s (Int, ComposeState)
insertHangul MArray s
marr Int
i JamoBuf
jbuf Char
ch
                | Bool
otherwise ->
                    MArray s -> Int -> JamoBuf -> Char -> ST s (Int, ComposeState)
jamoToReg MArray s
marr Int
i JamoBuf
jbuf Char
ch
            ComposeState
ComposeNone
                | Int
ich Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
UC.jamoLFirst ->
                    Char -> Int -> ST s (Int, ComposeState)
initReg Char
ch Int
i
                | Int
ich Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
UC.jamoTLast ->
                    Char -> Int -> ST s (Int, ComposeState)
forall s. Char -> Int -> ST s (Int, ComposeState)
initJamo Char
ch Int
i
                | Int
ich Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
UC.hangulFirst ->
                    Char -> Int -> ST s (Int, ComposeState)
initReg Char
ch Int
i
                | Int
ich Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
UC.hangulLast ->
                    Char -> Int -> ST s (Int, ComposeState)
forall s. Char -> Int -> ST s (Int, ComposeState)
initHangul Char
ch Int
i
                | Bool
otherwise ->
                    Char -> Int -> ST s (Int, ComposeState)
initReg Char
ch Int
i
        where ich :: Int
ich = Char -> Int
ord Char
ch

    {-# INLINE jamoToReg #-}
    jamoToReg :: MArray s -> Int -> JamoBuf -> Char -> ST s (Int, ComposeState)
jamoToReg MArray s
arr Int
i JamoBuf
jbuf Char
ch = do
        Int
j <- MArray s -> Int -> JamoBuf -> ST s Int
forall s. MArray s -> Int -> JamoBuf -> ST s Int
writeJamoBuf MArray s
arr Int
i JamoBuf
jbuf
        Char -> Int -> ST s (Int, ComposeState)
initReg Char
ch Int
j

    {-# INLINE initReg #-}
    initReg :: Char -> Int -> ST s (Int, ComposeState)
initReg !Char
ch !Int
i
        | DecomposeMode -> Char -> Bool
UC.isDecomposable DecomposeMode
mode Char
ch =
            [Char] -> Int -> ComposeState -> ST s (Int, ComposeState)
go (DecomposeMode -> Char -> [Char]
UC.decompose DecomposeMode
mode Char
ch) Int
i ComposeState
ComposeNone
        | Bool
otherwise =
            (Int, ComposeState) -> ST s (Int, ComposeState)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
i, RegBuf -> ComposeState
ComposeReg (Char -> RegBuf
RegOne Char
ch))

    {-# INLINE composeReg #-}
    composeReg :: RegBuf -> Char -> Int -> ComposeState -> ST s (Int, ComposeState)
composeReg RegBuf
rbuf !Char
ch !Int
i !ComposeState
st
        | DecomposeMode -> Char -> Bool
UC.isDecomposable DecomposeMode
mode Char
ch =
            [Char] -> Int -> ComposeState -> ST s (Int, ComposeState)
go (DecomposeMode -> Char -> [Char]
UC.decompose DecomposeMode
mode Char
ch) Int
i ComposeState
st
        | Char -> Bool
UC.isCombining Char
ch = do
            (Int, ComposeState) -> ST s (Int, ComposeState)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
i, RegBuf -> ComposeState
ComposeReg (Char -> RegBuf -> RegBuf
insertIntoRegBuf Char
ch RegBuf
rbuf))
        -- The first char in RegBuf may or may not be a starter. In
        -- case it is not we rely on composeStarters failing.
        | RegOne Char
s <- RegBuf
rbuf
        , Char -> Bool
UC.isCombiningStarter Char
ch
        , Just Char
x <- Char -> Char -> Maybe Char
UC.composeStarters Char
s Char
ch =
            (Int, ComposeState) -> ST s (Int, ComposeState)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
i, (RegBuf -> ComposeState
ComposeReg (Char -> RegBuf
RegOne Char
x)))
        | Bool
otherwise = do
            Int
j <- MArray s -> Int -> RegBuf -> ST s Int
forall s. MArray s -> Int -> RegBuf -> ST s Int
writeRegBuf MArray s
marr Int
i RegBuf
rbuf
            (Int, ComposeState) -> ST s (Int, ComposeState)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
j, RegBuf -> ComposeState
ComposeReg (Char -> RegBuf
RegOne Char
ch))

    go :: [Char] -> Int -> ComposeState -> ST s (Int, ComposeState)
go [] !Int
i !ComposeState
st = (Int, ComposeState) -> ST s (Int, ComposeState)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
i, ComposeState
st)
    go (Char
ch : [Char]
rest) Int
i ComposeState
st =
        case ComposeState
st of
            ComposeReg RegBuf
rbuf
                | Char -> Bool
UC.isHangul Char
ch -> do
                    Int
j <- MArray s -> Int -> RegBuf -> ST s Int
forall s. MArray s -> Int -> RegBuf -> ST s Int
writeRegBuf MArray s
marr Int
i RegBuf
rbuf
                    (Int
k, ComposeState
s) <- Char -> Int -> ST s (Int, ComposeState)
forall s. Char -> Int -> ST s (Int, ComposeState)
initHangul Char
ch Int
j
                    [Char] -> Int -> ComposeState -> ST s (Int, ComposeState)
go [Char]
rest Int
k ComposeState
s
                | Char -> Bool
UC.isJamo Char
ch -> do
                    Int
j <- MArray s -> Int -> RegBuf -> ST s Int
forall s. MArray s -> Int -> RegBuf -> ST s Int
writeRegBuf MArray s
marr Int
i RegBuf
rbuf
                    (Int
k, ComposeState
s) <- Char -> Int -> ST s (Int, ComposeState)
forall s. Char -> Int -> ST s (Int, ComposeState)
initJamo Char
ch Int
j
                    [Char] -> Int -> ComposeState -> ST s (Int, ComposeState)
go [Char]
rest Int
k ComposeState
s
                | DecomposeMode -> Char -> Bool
UC.isDecomposable DecomposeMode
mode Char
ch ->
                    [Char] -> Int -> ComposeState -> ST s (Int, ComposeState)
go (DecomposeMode -> Char -> [Char]
UC.decompose DecomposeMode
mode Char
ch [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
rest) Int
i ComposeState
st
                | Char -> Bool
UC.isCombining Char
ch -> do
                    [Char] -> Int -> ComposeState -> ST s (Int, ComposeState)
go [Char]
rest Int
i (RegBuf -> ComposeState
ComposeReg (Char -> RegBuf -> RegBuf
insertIntoRegBuf Char
ch RegBuf
rbuf))
                | RegOne Char
s <- RegBuf
rbuf
                , Char -> Bool
UC.isCombiningStarter Char
ch
                , Just Char
x <- Char -> Char -> Maybe Char
UC.composeStarters Char
s Char
ch ->
                    [Char] -> Int -> ComposeState -> ST s (Int, ComposeState)
go [Char]
rest Int
i (RegBuf -> ComposeState
ComposeReg (Char -> RegBuf
RegOne Char
x))
                | Bool
otherwise -> do
                    Int
j <- MArray s -> Int -> RegBuf -> ST s Int
forall s. MArray s -> Int -> RegBuf -> ST s Int
writeRegBuf MArray s
marr Int
i RegBuf
rbuf
                    [Char] -> Int -> ComposeState -> ST s (Int, ComposeState)
go [Char]
rest Int
j (RegBuf -> ComposeState
ComposeReg (Char -> RegBuf
RegOne Char
ch))
            ComposeJamo JamoBuf
jbuf
                | Char -> Bool
UC.isJamo Char
ch -> do
                    (Int
j, ComposeState
s) <- MArray s -> Int -> JamoBuf -> Char -> ST s (Int, ComposeState)
forall s.
MArray s -> Int -> JamoBuf -> Char -> ST s (Int, ComposeState)
insertJamo MArray s
marr Int
i JamoBuf
jbuf Char
ch
                    [Char] -> Int -> ComposeState -> ST s (Int, ComposeState)
go [Char]
rest Int
j ComposeState
s
                | Char -> Bool
UC.isHangul Char
ch -> do
                    (Int
j, ComposeState
s) <- MArray s -> Int -> JamoBuf -> Char -> ST s (Int, ComposeState)
forall s.
MArray s -> Int -> JamoBuf -> Char -> ST s (Int, ComposeState)
insertHangul MArray s
marr Int
i JamoBuf
jbuf Char
ch
                    [Char] -> Int -> ComposeState -> ST s (Int, ComposeState)
go [Char]
rest Int
j ComposeState
s
                | Bool
otherwise -> do
                    Int
j <- MArray s -> Int -> JamoBuf -> ST s Int
forall s. MArray s -> Int -> JamoBuf -> ST s Int
writeJamoBuf MArray s
marr Int
i JamoBuf
jbuf
                    case () of
                        ()
_
                            | DecomposeMode -> Char -> Bool
UC.isDecomposable DecomposeMode
mode Char
ch ->
                                [Char] -> Int -> ComposeState -> ST s (Int, ComposeState)
go (DecomposeMode -> Char -> [Char]
UC.decompose DecomposeMode
mode Char
ch [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
rest) Int
j
                                   ComposeState
ComposeNone
                            | Bool
otherwise ->
                                [Char] -> Int -> ComposeState -> ST s (Int, ComposeState)
go [Char]
rest Int
j (RegBuf -> ComposeState
ComposeReg (Char -> RegBuf
RegOne Char
ch))
            ComposeState
ComposeNone
                | Char -> Bool
UC.isHangul Char
ch -> do
                    (Int
j, ComposeState
s) <- Char -> Int -> ST s (Int, ComposeState)
forall s. Char -> Int -> ST s (Int, ComposeState)
initHangul Char
ch Int
i
                    [Char] -> Int -> ComposeState -> ST s (Int, ComposeState)
go [Char]
rest Int
j ComposeState
s
                | Char -> Bool
UC.isJamo Char
ch -> do
                    (Int
j, ComposeState
s) <- Char -> Int -> ST s (Int, ComposeState)
forall s. Char -> Int -> ST s (Int, ComposeState)
initJamo Char
ch Int
i
                    [Char] -> Int -> ComposeState -> ST s (Int, ComposeState)
go [Char]
rest Int
j ComposeState
s
                | DecomposeMode -> Char -> Bool
UC.isDecomposable DecomposeMode
mode Char
ch ->
                    [Char] -> Int -> ComposeState -> ST s (Int, ComposeState)
go (DecomposeMode -> Char -> [Char]
UC.decompose DecomposeMode
mode Char
ch [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
rest) Int
i ComposeState
st
                | Bool
otherwise ->
                    [Char] -> Int -> ComposeState -> ST s (Int, ComposeState)
go [Char]
rest Int
i (RegBuf -> ComposeState
ComposeReg (Char -> RegBuf
RegOne Char
ch))

-- | /O(n)/ Convert a 'Stream Char' into a composed normalized 'Text'.
unstreamC :: UC.DecomposeMode -> Stream Char -> Text
unstreamC :: DecomposeMode -> Stream Char -> Text
unstreamC DecomposeMode
mode (Stream s -> Step s Char
next0 s
s0 Size
len) = (forall s. (MArray s -> Int -> ST s Text) -> ST s Text) -> Text
runText ((forall s. (MArray s -> Int -> ST s Text) -> ST s Text) -> Text)
-> (forall s. (MArray s -> Int -> ST s Text) -> ST s Text) -> Text
forall a b. (a -> b) -> a -> b
$ \MArray s -> Int -> ST s Text
done -> do
  -- Before encoding each char we perform a buffer realloc check assuming
  -- worst case encoding size of two 16-bit units for the char. Just add an
  -- extra space to the buffer so that we do not end up reallocating even when
  -- all the chars are encoded as single unit.
  let margin :: Int
margin = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
maxDecomposeLen
      mlen :: Int
mlen = (Int -> Size -> Int
upperBound Int
4 Size
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
margin)
  MArray s
arr0 <- Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.new Int
mlen
  let outer :: MArray s -> Int -> s -> Int -> ComposeState -> ST s Text
outer !MArray s
arr !Int
maxi = SPEC -> s -> Int -> ComposeState -> ST s Text
encode SPEC
SPEC
       where
        -- keep the common case loop as small as possible
        encode :: SPEC -> s -> Int -> ComposeState -> ST s Text
encode !SPEC
_ !s
si !Int
di ComposeState
st =
            -- simply check for the worst case
            if Int
maxi Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
di Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
margin
               then s -> Int -> ComposeState -> ST s Text
realloc s
si Int
di ComposeState
st
            else
                case s -> Step s Char
next0 s
si of
                    Step s Char
Done -> do
                        Int
di' <- MArray s -> Int -> ComposeState -> ST s Int
forall s. MArray s -> Int -> ComposeState -> ST s Int
flushComposeState MArray s
arr Int
di ComposeState
st
                        MArray s -> Int -> ST s Text
done MArray s
arr Int
di'
                    Skip s
si'    -> SPEC -> s -> Int -> ComposeState -> ST s Text
encode SPEC
SPEC s
si' Int
di ComposeState
st
                    Yield Char
c s
si' -> do
                        (Int
di', ComposeState
st') <- DecomposeMode
-> MArray s
-> Char
-> Int
-> ComposeState
-> ST s (Int, ComposeState)
forall s.
DecomposeMode
-> MArray s
-> Char
-> Int
-> ComposeState
-> ST s (Int, ComposeState)
composeChar DecomposeMode
mode MArray s
arr Char
c Int
di ComposeState
st
                        SPEC -> s -> Int -> ComposeState -> ST s Text
encode SPEC
SPEC s
si' Int
di' ComposeState
st'

        -- keep uncommon case separate from the common case code
        {-# NOINLINE realloc #-}
        realloc :: s -> Int -> ComposeState -> ST s Text
realloc !s
si !Int
di ComposeState
st = do
            let newlen :: Int
newlen = Int
maxi Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2
            MArray s
arr' <- Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.new Int
newlen
            MArray s -> Int -> MArray s -> Int -> Int -> ST s ()
forall s. MArray s -> Int -> MArray s -> Int -> Int -> ST s ()
A.copyM MArray s
arr' Int
0 MArray s
arr Int
0 Int
di
            MArray s -> Int -> s -> Int -> ComposeState -> ST s Text
outer MArray s
arr' (Int
newlen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) s
si Int
di ComposeState
st

  MArray s -> Int -> s -> Int -> ComposeState -> ST s Text
outer MArray s
arr0 (Int
mlen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) s
s0 Int
0 ComposeState
ComposeNone
{-# INLINE [0] unstreamC #-}