{-# OPTIONS_GHC -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns #-}
{-# 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
    (
      D.DecomposeMode(..)
    , stream
    , unstream
    , unstreamC
    )
    where

import           Data.Char                              (chr, ord)
import qualified Data.Text.Array                        as A
import           Data.Text.Internal                     (Text (..))
import qualified Data.Text.Internal.Encoding.Utf16      as U16
import           Data.Text.Internal.Fusion.Size         (betweenSize,
                                                         upperBound)
import           Data.Text.Internal.Fusion.Types        (Step (..), Stream (..))
import           Data.Text.Internal.Private             (runText)
import           Data.Text.Internal.Unsafe.Char         (unsafeWrite)
import           Data.Text.Internal.Unsafe.Char         (unsafeChr)
import           Data.Text.Internal.Unsafe.Shift        (shiftR)
import           GHC.ST                                 (ST (..))
import           GHC.Types                              (SPEC(..))

import qualified Data.Unicode.Properties.CombiningClass  as CC
import qualified Data.Unicode.Properties.Compositions    as C
import qualified Data.Unicode.Properties.Decompose       as D
import qualified Data.Unicode.Properties.DecomposeHangul as H

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

-- | A list of combining characters, ordered by 'CC.getCombiningClass'.
-- 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
CC.getCombiningClass Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Char -> Int
CC.getCombiningClass 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
CC.getCombiningClass 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
CC.getCombiningClass 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
CC.getCombiningClass 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
CC.getCombiningClass) [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
H.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)
D.decomposeCharHangul Char
c

{-# INLINE decomposeChar #-}
decomposeChar
    :: D.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
D.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
D.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]
D.decomposeChar 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
D.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]
D.decomposeChar 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
CC.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)

-- | /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. UnsafeShift 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. UnsafeShift 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
U16.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 #-}

-- | /O(n)/ Convert a 'Stream Char' into a decompose-normalized 'Text'.
unstream :: D.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
H.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
H.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
H.jamoVLast = do
        case JamoBuf
jbuf of
            Jamo Char
c ->
                case Char -> Maybe Int
H.jamoLIndex Char
c of
                    Just Int
li ->
                        let vi :: Int
vi = Int
ich Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
H.jamoVFirst
                            lvi :: Int
lvi = Int
li Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
H.jamoNCount Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
vi Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
H.jamoTCount
                            lv :: Char
lv = Int -> Char
chr (Int
H.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
H.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
H.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
H.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
CC.getCombiningClass Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Char -> Int
CC.getCombiningClass 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
CC.getCombiningClass 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
CC.getCombiningClass 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
CC.getCombiningClass 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
CC.getCombiningClass) [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
C.composePair 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
C.composePair 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
CC.getCombiningClass 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
CC.getCombiningClass) [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
    :: D.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
H.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
H.jamoLast -> 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
H.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
H.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
H.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
H.jamoLast -> 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
H.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
H.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
H.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
H.jamoLast ->
                    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
H.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
H.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
D.isDecomposable DecomposeMode
mode Char
ch =
            [Char] -> Int -> ComposeState -> ST s (Int, ComposeState)
go (DecomposeMode -> Char -> [Char]
D.decomposeChar 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
D.isDecomposable DecomposeMode
mode Char
ch =
            [Char] -> Int -> ComposeState -> ST s (Int, ComposeState)
go (DecomposeMode -> Char -> [Char]
D.decomposeChar DecomposeMode
mode Char
ch) Int
i ComposeState
st
        | Char -> Bool
CC.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 composeStarterPair failing.
        | RegOne Char
s <- RegBuf
rbuf
        , Char -> Bool
C.isSecondStarter Char
ch
        , Just Char
x <- Char -> Char -> Maybe Char
C.composeStarterPair 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
H.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
H.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
D.isDecomposable DecomposeMode
mode Char
ch ->
                    [Char] -> Int -> ComposeState -> ST s (Int, ComposeState)
go (DecomposeMode -> Char -> [Char]
D.decomposeChar DecomposeMode
mode Char
ch [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
rest) Int
i ComposeState
st
                | Char -> Bool
CC.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
C.isSecondStarter Char
ch
                , Just Char
x <- Char -> Char -> Maybe Char
C.composeStarterPair 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
H.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
H.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
D.isDecomposable DecomposeMode
mode Char
ch ->
                                [Char] -> Int -> ComposeState -> ST s (Int, ComposeState)
go (DecomposeMode -> Char -> [Char]
D.decomposeChar 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
H.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
H.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
D.isDecomposable DecomposeMode
mode Char
ch ->
                    [Char] -> Int -> ComposeState -> ST s (Int, ComposeState)
go (DecomposeMode -> Char -> [Char]
D.decomposeChar 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 :: D.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 #-}