-- |
-- Module      : Streamly.Internal.Unicode.Char
-- Copyright   : (c) 2018 Composewell Technologies
--
-- License     : BSD-3-Clause
-- Maintainer  : streamly@composewell.com
-- Stability   : experimental
-- Portability : GHC

-- XXX We are using head/tail at one place
#if __GLASGOW_HASKELL__ >= 908
{-# OPTIONS_GHC -Wno-x-partial #-}
#endif
-- XXX This module should have the reader/writer unfold/refold and read/write
-- stream/fold routines to convert a char to/from stream.
--
module Streamly.Internal.Unicode.Char
    (
    -- * Predicates
      isAsciiAlpha -- XXX Remove or move to unicode-data

    -- XXX move to Unicode.Char.Case?
    -- * Unicode aware operations
    {-
      toCaseFold
    , toLower
    , toUpper
    , toTitle
    -}

    -- XXX Move to Unicode.Stream.Normalize or Unicode.Normalize?
    -- * Unicode normalization
    , NormalizationMode(..)
    , normalize
    )
where

#include "inline.hs"

import Data.Char (isAsciiUpper, isAsciiLower, chr, ord)
import Unicode.Char (DecomposeMode(..))
import Streamly.Internal.Data.Stream (Stream(..), Step (..))

import qualified Unicode.Char as Char

-------------------------------------------------------------------------------
-- Unicode aware operations on strings
-------------------------------------------------------------------------------

-- | Select alphabetic characters in the ascii character set.
--
-- /Pre-release/
--
{-# INLINE isAsciiAlpha #-}
isAsciiAlpha :: Char -> Bool
isAsciiAlpha :: Char -> Bool
isAsciiAlpha Char
c = Char -> Bool
isAsciiUpper Char
c Bool -> Bool -> Bool
|| Char -> Bool
isAsciiLower Char
c

-------------------------------------------------------------------------------
-- Unicode aware operations on strings
-------------------------------------------------------------------------------

{-
-- |
-- /undefined/
toCaseFold :: IsStream t => Char -> t m Char
toCaseFold = undefined

-- |
-- /undefined/
toLower :: IsStream t => Char -> t m Char
toLower = undefined

-- |
-- /undefined/
toUpper :: IsStream t => Char -> t m Char
toUpper = undefined

-- |
-- /undefined/
toTitle :: IsStream t => Char -> t m Char
toTitle = undefined
-}

-------------------------------------------------------------------------------
-- Unicode normalization
-------------------------------------------------------------------------------

data NormalizationMode
    = NFD    -- ^ Canonical decomposition.
    | NFKD   -- ^ Compatibility decomposition.
    | NFC    -- ^ Canonical decomposition followed by canonical composition.
    | NFKC   -- ^ Compatibility decomposition followed by canonical composition.
      deriving (NormalizationMode -> NormalizationMode -> Bool
(NormalizationMode -> NormalizationMode -> Bool)
-> (NormalizationMode -> NormalizationMode -> Bool)
-> Eq NormalizationMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NormalizationMode -> NormalizationMode -> Bool
$c/= :: NormalizationMode -> NormalizationMode -> Bool
== :: NormalizationMode -> NormalizationMode -> Bool
$c== :: NormalizationMode -> NormalizationMode -> Bool
Eq, Int -> NormalizationMode -> ShowS
[NormalizationMode] -> ShowS
NormalizationMode -> String
(Int -> NormalizationMode -> ShowS)
-> (NormalizationMode -> String)
-> ([NormalizationMode] -> ShowS)
-> Show NormalizationMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NormalizationMode] -> ShowS
$cshowList :: [NormalizationMode] -> ShowS
show :: NormalizationMode -> String
$cshow :: NormalizationMode -> String
showsPrec :: Int -> NormalizationMode -> ShowS
$cshowsPrec :: Int -> NormalizationMode -> ShowS
Show, Int -> NormalizationMode
NormalizationMode -> Int
NormalizationMode -> [NormalizationMode]
NormalizationMode -> NormalizationMode
NormalizationMode -> NormalizationMode -> [NormalizationMode]
NormalizationMode
-> NormalizationMode -> NormalizationMode -> [NormalizationMode]
(NormalizationMode -> NormalizationMode)
-> (NormalizationMode -> NormalizationMode)
-> (Int -> NormalizationMode)
-> (NormalizationMode -> Int)
-> (NormalizationMode -> [NormalizationMode])
-> (NormalizationMode -> NormalizationMode -> [NormalizationMode])
-> (NormalizationMode -> NormalizationMode -> [NormalizationMode])
-> (NormalizationMode
    -> NormalizationMode -> NormalizationMode -> [NormalizationMode])
-> Enum NormalizationMode
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: NormalizationMode
-> NormalizationMode -> NormalizationMode -> [NormalizationMode]
$cenumFromThenTo :: NormalizationMode
-> NormalizationMode -> NormalizationMode -> [NormalizationMode]
enumFromTo :: NormalizationMode -> NormalizationMode -> [NormalizationMode]
$cenumFromTo :: NormalizationMode -> NormalizationMode -> [NormalizationMode]
enumFromThen :: NormalizationMode -> NormalizationMode -> [NormalizationMode]
$cenumFromThen :: NormalizationMode -> NormalizationMode -> [NormalizationMode]
enumFrom :: NormalizationMode -> [NormalizationMode]
$cenumFrom :: NormalizationMode -> [NormalizationMode]
fromEnum :: NormalizationMode -> Int
$cfromEnum :: NormalizationMode -> Int
toEnum :: Int -> NormalizationMode
$ctoEnum :: Int -> NormalizationMode
pred :: NormalizationMode -> NormalizationMode
$cpred :: NormalizationMode -> NormalizationMode
succ :: NormalizationMode -> NormalizationMode
$csucc :: NormalizationMode -> NormalizationMode
Enum)

-------------------------------------------------------------------------------
-- Normalization combinators
-------------------------------------------------------------------------------

type ReBuf = [Char]

{-# INLINE insertIntoReBuf #-}
insertIntoReBuf :: Char -> ReBuf -> ReBuf
insertIntoReBuf :: Char -> ShowS
insertIntoReBuf Char
c [] = [Char
c]
insertIntoReBuf Char
c xxs :: String
xxs@(Char
x:String
xs)
    | Char -> Int
Char.combiningClass Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Char -> Int
Char.combiningClass Char
x = Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: String
xxs
    | Bool
otherwise = Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: Char -> ShowS
insertIntoReBuf Char
c String
xs

-- {-# ANN type DecomposeState Fuse #-}
data DecomposeState st
    = YieldCharList [Char] (DecomposeState st)
    | ReadInputChar ReBuf st
    | IsHangul Char st
    | IsDecomposable [Char] ReBuf st
    | DecomposeStop

{-# INLINE_NORMAL decomposeD #-}
decomposeD ::
       Monad m => Bool -> DecomposeMode -> Stream m Char -> Stream m Char
decomposeD :: forall (m :: * -> *).
Monad m =>
Bool -> DecomposeMode -> Stream m Char -> Stream m Char
decomposeD Bool
decomposeHangul DecomposeMode
mode (Stream State StreamK m Char -> s -> m (Step s Char)
step s
state) =
    (State StreamK m Char
 -> DecomposeState s -> m (Step (DecomposeState s) Char))
-> DecomposeState s -> Stream m Char
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m Char
-> DecomposeState s -> m (Step (DecomposeState s) Char)
sstep (String -> s -> DecomposeState s
forall st. String -> st -> DecomposeState st
ReadInputChar [] s
state)

    where

    {-# INLINE_LATE sstep #-}
    -- XXX Does this cause any problem?
    sstep :: State StreamK m Char
-> DecomposeState s -> m (Step (DecomposeState s) Char)
sstep State StreamK m Char
_ (YieldCharList [] DecomposeState s
ns) = Step (DecomposeState s) Char -> m (Step (DecomposeState s) Char)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (DecomposeState s) Char -> m (Step (DecomposeState s) Char))
-> Step (DecomposeState s) Char -> m (Step (DecomposeState s) Char)
forall a b. (a -> b) -> a -> b
$ DecomposeState s -> Step (DecomposeState s) Char
forall s a. s -> Step s a
Skip DecomposeState s
ns
    sstep State StreamK m Char
_ (YieldCharList (Char
ch:String
chs) DecomposeState s
ns) =
        Step (DecomposeState s) Char -> m (Step (DecomposeState s) Char)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (DecomposeState s) Char -> m (Step (DecomposeState s) Char))
-> Step (DecomposeState s) Char -> m (Step (DecomposeState s) Char)
forall a b. (a -> b) -> a -> b
$ Char -> DecomposeState s -> Step (DecomposeState s) Char
forall s a. a -> s -> Step s a
Yield Char
ch (String -> DecomposeState s -> DecomposeState s
forall st. String -> DecomposeState st -> DecomposeState st
YieldCharList String
chs DecomposeState s
ns)
    sstep State StreamK m Char
gst (ReadInputChar String
rebuf s
st) = do
        Step s Char
res <- State StreamK m Char -> s -> m (Step s Char)
step State StreamK m Char
gst s
st
        Step (DecomposeState s) Char -> m (Step (DecomposeState s) Char)
forall (m :: * -> *) a. Monad m => a -> m a
return
          (Step (DecomposeState s) Char -> m (Step (DecomposeState s) Char))
-> Step (DecomposeState s) Char -> m (Step (DecomposeState s) Char)
forall a b. (a -> b) -> a -> b
$ DecomposeState s -> Step (DecomposeState s) Char
forall s a. s -> Step s a
Skip
          (DecomposeState s -> Step (DecomposeState s) Char)
-> DecomposeState s -> Step (DecomposeState s) Char
forall a b. (a -> b) -> a -> b
$ case Step s Char
res of
                Yield Char
ch s
st1
                    | Char -> Bool
Char.isHangul Char
ch ->
                        if Bool
decomposeHangul
                        then String -> DecomposeState s -> DecomposeState s
forall st. String -> DecomposeState st -> DecomposeState st
YieldCharList String
rebuf (Char -> s -> DecomposeState s
forall st. Char -> st -> DecomposeState st
IsHangul Char
ch s
st1)
                        else String -> DecomposeState s -> DecomposeState s
forall st. String -> DecomposeState st -> DecomposeState st
YieldCharList
                                 (String
rebuf String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
ch])
                                 (String -> s -> DecomposeState s
forall st. String -> st -> DecomposeState st
ReadInputChar [] s
st1)
                    | DecomposeMode -> Char -> Bool
Char.isDecomposable DecomposeMode
mode Char
ch ->
                        String -> String -> s -> DecomposeState s
forall st. String -> String -> st -> DecomposeState st
IsDecomposable (DecomposeMode -> Char -> String
Char.decompose DecomposeMode
mode Char
ch) String
rebuf s
st1
                    | Bool
otherwise ->
                        if Char -> Bool
Char.isCombining Char
ch
                        then String -> s -> DecomposeState s
forall st. String -> st -> DecomposeState st
ReadInputChar (Char -> ShowS
insertIntoReBuf Char
ch String
rebuf) s
st1
                        else String -> DecomposeState s -> DecomposeState s
forall st. String -> DecomposeState st -> DecomposeState st
YieldCharList
                                 (String
rebuf String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
ch])
                                 (String -> s -> DecomposeState s
forall st. String -> st -> DecomposeState st
ReadInputChar [] s
st1)
                Skip s
st1 -> String -> s -> DecomposeState s
forall st. String -> st -> DecomposeState st
ReadInputChar String
rebuf s
st1
                Step s Char
Stop -> String -> DecomposeState s -> DecomposeState s
forall st. String -> DecomposeState st -> DecomposeState st
YieldCharList String
rebuf DecomposeState s
forall st. DecomposeState st
DecomposeStop
    sstep State StreamK m Char
_ (IsHangul Char
ch s
st) =
        Step (DecomposeState s) Char -> m (Step (DecomposeState s) Char)
forall (m :: * -> *) a. Monad m => a -> m a
return
          (Step (DecomposeState s) Char -> m (Step (DecomposeState s) Char))
-> Step (DecomposeState s) Char -> m (Step (DecomposeState s) Char)
forall a b. (a -> b) -> a -> b
$ DecomposeState s -> Step (DecomposeState s) Char
forall s a. s -> Step s a
Skip
          (DecomposeState s -> Step (DecomposeState s) Char)
-> DecomposeState s -> Step (DecomposeState s) Char
forall a b. (a -> b) -> a -> b
$ let (Char
l, Char
v, Char
t) = Char -> (Char, Char, Char)
Char.decomposeHangul Char
ch
             in if Char
t Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Char
chr Int
Char.jamoTFirst
                then String -> DecomposeState s -> DecomposeState s
forall st. String -> DecomposeState st -> DecomposeState st
YieldCharList [Char
l, Char
v] (String -> s -> DecomposeState s
forall st. String -> st -> DecomposeState st
ReadInputChar [] s
st)
                else String -> DecomposeState s -> DecomposeState s
forall st. String -> DecomposeState st -> DecomposeState st
YieldCharList [Char
l, Char
v, Char
t] (String -> s -> DecomposeState s
forall st. String -> st -> DecomposeState st
ReadInputChar [] s
st)
    sstep State StreamK m Char
_ (IsDecomposable [] String
rebuf s
st) =
        Step (DecomposeState s) Char -> m (Step (DecomposeState s) Char)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (DecomposeState s) Char -> m (Step (DecomposeState s) Char))
-> Step (DecomposeState s) Char -> m (Step (DecomposeState s) Char)
forall a b. (a -> b) -> a -> b
$ DecomposeState s -> Step (DecomposeState s) Char
forall s a. s -> Step s a
Skip (DecomposeState s -> Step (DecomposeState s) Char)
-> DecomposeState s -> Step (DecomposeState s) Char
forall a b. (a -> b) -> a -> b
$ String -> s -> DecomposeState s
forall st. String -> st -> DecomposeState st
ReadInputChar String
rebuf s
st
    sstep State StreamK m Char
_ (IsDecomposable (Char
ch:String
chs) String
rebuf s
st)
        | DecomposeMode -> Char -> Bool
Char.isDecomposable DecomposeMode
mode Char
ch =
            Step (DecomposeState s) Char -> m (Step (DecomposeState s) Char)
forall (m :: * -> *) a. Monad m => a -> m a
return
              (Step (DecomposeState s) Char -> m (Step (DecomposeState s) Char))
-> Step (DecomposeState s) Char -> m (Step (DecomposeState s) Char)
forall a b. (a -> b) -> a -> b
$ DecomposeState s -> Step (DecomposeState s) Char
forall s a. s -> Step s a
Skip (DecomposeState s -> Step (DecomposeState s) Char)
-> DecomposeState s -> Step (DecomposeState s) Char
forall a b. (a -> b) -> a -> b
$ String -> String -> s -> DecomposeState s
forall st. String -> String -> st -> DecomposeState st
IsDecomposable (DecomposeMode -> Char -> String
Char.decompose DecomposeMode
mode Char
ch String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
chs) String
rebuf s
st
        | Bool
otherwise =
            Step (DecomposeState s) Char -> m (Step (DecomposeState s) Char)
forall (m :: * -> *) a. Monad m => a -> m a
return
              (Step (DecomposeState s) Char -> m (Step (DecomposeState s) Char))
-> Step (DecomposeState s) Char -> m (Step (DecomposeState s) Char)
forall a b. (a -> b) -> a -> b
$ DecomposeState s -> Step (DecomposeState s) Char
forall s a. s -> Step s a
Skip
              (DecomposeState s -> Step (DecomposeState s) Char)
-> DecomposeState s -> Step (DecomposeState s) Char
forall a b. (a -> b) -> a -> b
$ if Char -> Bool
Char.isCombining Char
ch
                then String -> String -> s -> DecomposeState s
forall st. String -> String -> st -> DecomposeState st
IsDecomposable String
chs (Char -> ShowS
insertIntoReBuf Char
ch String
rebuf) s
st
                else String -> DecomposeState s -> DecomposeState s
forall st. String -> DecomposeState st -> DecomposeState st
YieldCharList (String
rebuf String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
ch]) (String -> String -> s -> DecomposeState s
forall st. String -> String -> st -> DecomposeState st
IsDecomposable String
chs [] s
st)
    sstep State StreamK m Char
_ DecomposeState s
DecomposeStop = Step (DecomposeState s) Char -> m (Step (DecomposeState s) Char)
forall (m :: * -> *) a. Monad m => a -> m a
return Step (DecomposeState s) Char
forall s a. Step s a
Stop

-- 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

{-# INLINE fromJamoBuf #-}
fromJamoBuf :: JamoBuf -> Char
fromJamoBuf :: JamoBuf -> Char
fromJamoBuf (Jamo Char
ch) = Char
ch
fromJamoBuf (Hangul Char
ch) = Char
ch
fromJamoBuf (HangulLV Char
ch) = Char
ch

-- {-# ANN type ComposeState Fuse #-}
data ComposeState st
    = YieldChar Char (ComposeState st)
    | YieldList [Char] (ComposeState st)
    | ComposeNone st
    | ComposeReg Int [Char] st
    | ComposeJamo JamoBuf st
    | ComposeStop

-- Assumes every character except hangul characters are fully decomposed and the
-- combining characters are reordered. Hangul characters may or may not be
-- decomposed.
{-# INLINE_EARLY partialComposeD #-}
partialComposeD :: Monad m => Stream m Char -> Stream m Char
partialComposeD :: forall (m :: * -> *). Monad m => Stream m Char -> Stream m Char
partialComposeD (Stream State StreamK m Char -> s -> m (Step s Char)
step s
state) = (State StreamK m Char
 -> ComposeState s -> m (Step (ComposeState s) Char))
-> ComposeState s -> Stream m Char
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m Char
-> ComposeState s -> m (Step (ComposeState s) Char)
step' (s -> ComposeState s
forall st. st -> ComposeState st
ComposeNone s
state)

    where

    {-# INLINE_NORMAL step' #-}
    step' :: State StreamK m Char
-> ComposeState s -> m (Step (ComposeState s) Char)
step' State StreamK m Char
_ ComposeState s
ComposeStop = Step (ComposeState s) Char -> m (Step (ComposeState s) Char)
forall (m :: * -> *) a. Monad m => a -> m a
return Step (ComposeState s) Char
forall s a. Step s a
Stop
    step' State StreamK m Char
_ (YieldChar Char
ch ComposeState s
ns) = Step (ComposeState s) Char -> m (Step (ComposeState s) Char)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ComposeState s) Char -> m (Step (ComposeState s) Char))
-> Step (ComposeState s) Char -> m (Step (ComposeState s) Char)
forall a b. (a -> b) -> a -> b
$ Char -> ComposeState s -> Step (ComposeState s) Char
forall s a. a -> s -> Step s a
Yield Char
ch ComposeState s
ns
    step' State StreamK m Char
_ (YieldList [] ComposeState s
ns) = Step (ComposeState s) Char -> m (Step (ComposeState s) Char)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ComposeState s) Char -> m (Step (ComposeState s) Char))
-> Step (ComposeState s) Char -> m (Step (ComposeState s) Char)
forall a b. (a -> b) -> a -> b
$ ComposeState s -> Step (ComposeState s) Char
forall s a. s -> Step s a
Skip ComposeState s
ns
    step' State StreamK m Char
_ (YieldList (Char
x:String
xs) ComposeState s
ns) = Step (ComposeState s) Char -> m (Step (ComposeState s) Char)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ComposeState s) Char -> m (Step (ComposeState s) Char))
-> Step (ComposeState s) Char -> m (Step (ComposeState s) Char)
forall a b. (a -> b) -> a -> b
$ Char -> ComposeState s -> Step (ComposeState s) Char
forall s a. a -> s -> Step s a
Yield Char
x (ComposeState s -> Step (ComposeState s) Char)
-> ComposeState s -> Step (ComposeState s) Char
forall a b. (a -> b) -> a -> b
$ String -> ComposeState s -> ComposeState s
forall st. String -> ComposeState st -> ComposeState st
YieldList String
xs ComposeState s
ns
    step' State StreamK m Char
gst (ComposeNone s
st) = do
        Step s Char
r <- State StreamK m Char -> s -> m (Step s Char)
step State StreamK m Char
gst s
st
        Step (ComposeState s) Char -> m (Step (ComposeState s) Char)
forall (m :: * -> *) a. Monad m => a -> m a
return
          (Step (ComposeState s) Char -> m (Step (ComposeState s) Char))
-> Step (ComposeState s) Char -> m (Step (ComposeState s) Char)
forall a b. (a -> b) -> a -> b
$ case Step s Char
r of
                Yield Char
x s
st1 -> ComposeState s -> Step (ComposeState s) Char
forall s a. s -> Step s a
Skip (ComposeState s -> Step (ComposeState s) Char)
-> ComposeState s -> Step (ComposeState s) Char
forall a b. (a -> b) -> a -> b
$ Char -> s -> ComposeState s
forall {st}. Char -> st -> ComposeState st
composeNone Char
x s
st1
                Skip s
st1 -> ComposeState s -> Step (ComposeState s) Char
forall s a. s -> Step s a
Skip (ComposeState s -> Step (ComposeState s) Char)
-> ComposeState s -> Step (ComposeState s) Char
forall a b. (a -> b) -> a -> b
$ s -> ComposeState s
forall st. st -> ComposeState st
ComposeNone s
st1
                Step s Char
Stop -> Step (ComposeState s) Char
forall s a. Step s a
Stop
    step' State StreamK m Char
gst (ComposeJamo JamoBuf
jbuf s
st) = do
        Step s Char
r <- State StreamK m Char -> s -> m (Step s Char)
step State StreamK m Char
gst s
st
        Step (ComposeState s) Char -> m (Step (ComposeState s) Char)
forall (m :: * -> *) a. Monad m => a -> m a
return
          (Step (ComposeState s) Char -> m (Step (ComposeState s) Char))
-> Step (ComposeState s) Char -> m (Step (ComposeState s) Char)
forall a b. (a -> b) -> a -> b
$ case Step s Char
r of
                Yield Char
x s
st1 -> ComposeState s -> Step (ComposeState s) Char
forall s a. s -> Step s a
Skip (ComposeState s -> Step (ComposeState s) Char)
-> ComposeState s -> Step (ComposeState s) Char
forall a b. (a -> b) -> a -> b
$ JamoBuf -> Char -> s -> ComposeState s
forall {st}. JamoBuf -> Char -> st -> ComposeState st
composeJamo JamoBuf
jbuf Char
x s
st1
                Skip s
st1 -> ComposeState s -> Step (ComposeState s) Char
forall s a. s -> Step s a
Skip (ComposeState s -> Step (ComposeState s) Char)
-> ComposeState s -> Step (ComposeState s) Char
forall a b. (a -> b) -> a -> b
$ JamoBuf -> s -> ComposeState s
forall st. JamoBuf -> st -> ComposeState st
ComposeJamo JamoBuf
jbuf s
st1
                Step s Char
Stop -> ComposeState s -> Step (ComposeState s) Char
forall s a. s -> Step s a
Skip (ComposeState s -> Step (ComposeState s) Char)
-> ComposeState s -> Step (ComposeState s) Char
forall a b. (a -> b) -> a -> b
$ Char -> ComposeState s -> ComposeState s
forall st. Char -> ComposeState st -> ComposeState st
YieldChar (JamoBuf -> Char
fromJamoBuf JamoBuf
jbuf) ComposeState s
forall st. ComposeState st
ComposeStop
    step' State StreamK m Char
gst (ComposeReg Int
i String
rbuf s
st) = do
        Step s Char
r <- State StreamK m Char -> s -> m (Step s Char)
step State StreamK m Char
gst s
st
        Step (ComposeState s) Char -> m (Step (ComposeState s) Char)
forall (m :: * -> *) a. Monad m => a -> m a
return
          (Step (ComposeState s) Char -> m (Step (ComposeState s) Char))
-> Step (ComposeState s) Char -> m (Step (ComposeState s) Char)
forall a b. (a -> b) -> a -> b
$ case Step s Char
r of
                Yield Char
x s
st1 -> ComposeState s -> Step (ComposeState s) Char
forall s a. s -> Step s a
Skip (ComposeState s -> Step (ComposeState s) Char)
-> ComposeState s -> Step (ComposeState s) Char
forall a b. (a -> b) -> a -> b
$ Int -> String -> Char -> s -> ComposeState s
forall {st}. Int -> String -> Char -> st -> ComposeState st
composeReg Int
i String
rbuf Char
x s
st1
                Skip s
st1 -> ComposeState s -> Step (ComposeState s) Char
forall s a. s -> Step s a
Skip (ComposeState s -> Step (ComposeState s) Char)
-> ComposeState s -> Step (ComposeState s) Char
forall a b. (a -> b) -> a -> b
$ Int -> String -> s -> ComposeState s
forall st. Int -> String -> st -> ComposeState st
ComposeReg Int
i String
rbuf s
st1
                Step s Char
Stop -> ComposeState s -> Step (ComposeState s) Char
forall s a. s -> Step s a
Skip (ComposeState s -> Step (ComposeState s) Char)
-> ComposeState s -> Step (ComposeState s) Char
forall a b. (a -> b) -> a -> b
$ String -> ComposeState s -> ComposeState s
forall st. String -> ComposeState st -> ComposeState st
YieldList String
rbuf ComposeState s
forall st. ComposeState st
ComposeStop

    {-# INLINE initHangul #-}
    initHangul :: Char -> st -> ComposeState st
initHangul Char
c = JamoBuf -> st -> ComposeState st
forall st. JamoBuf -> st -> ComposeState st
ComposeJamo (Char -> JamoBuf
Hangul Char
c)

    {-# INLINE initJamo #-}
    initJamo :: Char -> st -> ComposeState st
initJamo Char
c = JamoBuf -> st -> ComposeState st
forall st. JamoBuf -> st -> ComposeState st
ComposeJamo (Char -> JamoBuf
Jamo Char
c)

    {-# INLINE initReg #-}
    initReg :: Char -> st -> ComposeState st
initReg !Char
c = Int -> String -> st -> ComposeState st
forall st. Int -> String -> st -> ComposeState st
ComposeReg Int
0 [Char
c]

    {-# INLINE composeNone #-}
    composeNone :: Char -> st -> ComposeState st
composeNone Char
ch st
st
        | Char -> Bool
Char.isHangul Char
ch = Char -> st -> ComposeState st
forall {st}. Char -> st -> ComposeState st
initHangul Char
ch st
st
        | Char -> Bool
Char.isJamo Char
ch = Char -> st -> ComposeState st
forall {st}. Char -> st -> ComposeState st
initJamo Char
ch st
st
        | Bool
otherwise = Char -> st -> ComposeState st
forall {st}. Char -> st -> ComposeState st
initReg Char
ch st
st

    {-# INLINE composeCharHangul #-}
    composeCharHangul :: JamoBuf -> Char -> st -> ComposeState st
composeCharHangul JamoBuf
jbuf Char
ch st
st =
        Char -> ComposeState st -> ComposeState st
forall st. Char -> ComposeState st -> ComposeState st
YieldChar (JamoBuf -> Char
fromJamoBuf JamoBuf
jbuf) (ComposeState st -> ComposeState st)
-> ComposeState st -> ComposeState st
forall a b. (a -> b) -> a -> b
$ JamoBuf -> st -> ComposeState st
forall st. JamoBuf -> st -> ComposeState st
ComposeJamo (Char -> JamoBuf
Hangul Char
ch) st
st

    {-# INLINE composeCharJamo #-}
    composeCharJamo :: JamoBuf -> Char -> st -> ComposeState st
composeCharJamo JamoBuf
jbuf Char
ch st
st
        | Int
ich Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
Char.jamoLLast =
            Char -> ComposeState st -> ComposeState st
forall st. Char -> ComposeState st -> ComposeState st
YieldChar (JamoBuf -> Char
fromJamoBuf JamoBuf
jbuf) (ComposeState st -> ComposeState st)
-> ComposeState st -> ComposeState st
forall a b. (a -> b) -> a -> b
$ JamoBuf -> st -> ComposeState st
forall st. JamoBuf -> st -> ComposeState st
ComposeJamo (Char -> JamoBuf
Jamo Char
ch) st
st
        | Int
ich Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
Char.jamoVFirst = JamoBuf -> Char -> st -> ComposeState st
forall {st}. JamoBuf -> Char -> st -> ComposeState st
flushAndWrite JamoBuf
jbuf Char
ch st
st
        | Int
ich Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
Char.jamoVLast =
            case JamoBuf
jbuf of
                Jamo Char
c ->
                    case Char -> Maybe Int
Char.jamoLIndex Char
c of
                        Just Int
li ->
                            let vi :: Int
vi = Int
ich Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
Char.jamoVFirst
                                lvi :: Int
lvi = Int
li Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
Char.jamoNCount Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
vi Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
Char.jamoTCount
                                lv :: Char
lv = Int -> Char
chr (Int
Char.hangulFirst Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lvi)
                             in JamoBuf -> st -> ComposeState st
forall st. JamoBuf -> st -> ComposeState st
ComposeJamo (Char -> JamoBuf
HangulLV Char
lv) st
st
                        Maybe Int
Nothing -> Char -> Char -> st -> ComposeState st
forall {st}. Char -> Char -> st -> ComposeState st
writeTwo Char
c Char
ch st
st
                Hangul Char
c -> Char -> Char -> st -> ComposeState st
forall {st}. Char -> Char -> st -> ComposeState st
writeTwo Char
c Char
ch st
st
                HangulLV Char
c -> Char -> Char -> st -> ComposeState st
forall {st}. Char -> Char -> st -> ComposeState st
writeTwo Char
c Char
ch st
st
        | Int
ich Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
Char.jamoTFirst = JamoBuf -> Char -> st -> ComposeState st
forall {st}. JamoBuf -> Char -> st -> ComposeState st
flushAndWrite JamoBuf
jbuf Char
ch st
st
        | Bool
otherwise = do
            let ti :: Int
ti = Int
ich Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
Char.jamoTFirst
            case JamoBuf
jbuf of
                Jamo Char
c -> Char -> Char -> st -> ComposeState st
forall {st}. Char -> Char -> st -> ComposeState st
writeTwo Char
c Char
ch st
st
                Hangul Char
c
                    | Char -> Bool
Char.isHangulLV Char
c -> Char -> Int -> st -> ComposeState st
forall {st}. Char -> Int -> st -> ComposeState st
writeLVT Char
c Int
ti st
st
                    | Bool
otherwise -> Char -> Char -> st -> ComposeState st
forall {st}. Char -> Char -> st -> ComposeState st
writeTwo Char
c Char
ch st
st
                HangulLV Char
c -> Char -> Int -> st -> ComposeState st
forall {st}. Char -> Int -> st -> ComposeState st
writeLVT Char
c Int
ti st
st

        where

        flushAndWrite :: JamoBuf -> Char -> st -> ComposeState st
flushAndWrite JamoBuf
jb Char
c st
s = String -> ComposeState st -> ComposeState st
forall st. String -> ComposeState st -> ComposeState st
YieldList [JamoBuf -> Char
fromJamoBuf JamoBuf
jb, Char
c] (ComposeState st -> ComposeState st)
-> ComposeState st -> ComposeState st
forall a b. (a -> b) -> a -> b
$ st -> ComposeState st
forall st. st -> ComposeState st
ComposeNone st
s

        writeLVT :: Char -> Int -> st -> ComposeState st
writeLVT Char
lv Int
ti st
s =
            let lvt :: Char
lvt = Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
lv Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ti
             in Char -> ComposeState st -> ComposeState st
forall st. Char -> ComposeState st -> ComposeState st
YieldChar Char
lvt (ComposeState st -> ComposeState st)
-> ComposeState st -> ComposeState st
forall a b. (a -> b) -> a -> b
$ st -> ComposeState st
forall st. st -> ComposeState st
ComposeNone st
s

        writeTwo :: Char -> Char -> st -> ComposeState st
writeTwo Char
c1 Char
c2 st
s = String -> ComposeState st -> ComposeState st
forall st. String -> ComposeState st -> ComposeState st
YieldList [Char
c1, Char
c2] (ComposeState st -> ComposeState st)
-> ComposeState st -> ComposeState st
forall a b. (a -> b) -> a -> b
$ st -> ComposeState st
forall st. st -> ComposeState st
ComposeNone st
s

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

    {-# INLINE composeJamo #-}
    composeJamo :: JamoBuf -> Char -> st -> ComposeState st
composeJamo JamoBuf
jbuf Char
ch st
st
        | Char -> Bool
Char.isJamo Char
ch = JamoBuf -> Char -> st -> ComposeState st
forall {st}. JamoBuf -> Char -> st -> ComposeState st
composeCharJamo JamoBuf
jbuf Char
ch st
st
        | Char -> Bool
Char.isHangul Char
ch = JamoBuf -> Char -> st -> ComposeState st
forall {st}. JamoBuf -> Char -> st -> ComposeState st
composeCharHangul JamoBuf
jbuf Char
ch st
st
        | Bool
otherwise = Char -> ComposeState st -> ComposeState st
forall st. Char -> ComposeState st -> ComposeState st
YieldChar (JamoBuf -> Char
fromJamoBuf JamoBuf
jbuf) (Int -> String -> st -> ComposeState st
forall st. Int -> String -> st -> ComposeState st
ComposeReg Int
0 [Char
ch] st
st)

    -- i ~ Char.combiningClass (last rbuf)
    {-# INLINE composeCharCombining #-}
    composeCharCombining :: Int -> String -> Char -> st -> ComposeState st
composeCharCombining Int
i String
rbuf Char
ch st
st =
        if Int
cch Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
i
        then case Char -> Char -> Maybe Char
Char.compose Char
str Char
ch of
                 Maybe Char
Nothing -> Int -> String -> st -> ComposeState st
forall st. Int -> String -> st -> ComposeState st
ComposeReg Int
cch (String
rbuf String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
ch]) st
st
                 Just Char
x -> Int -> String -> st -> ComposeState st
forall st. Int -> String -> st -> ComposeState st
ComposeReg Int
i (Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
forall a. [a] -> [a]
tail String
rbuf) st
st
        else Int -> String -> st -> ComposeState st
forall st. Int -> String -> st -> ComposeState st
ComposeReg Int
i (String
rbuf String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
ch]) st
st

        where

        str :: Char
str = String -> Char
forall a. [a] -> a
head String
rbuf
        cch :: Int
cch = Char -> Int
Char.combiningClass Char
ch

    {-# INLINE composeReg #-}
    composeReg :: Int -> String -> Char -> st -> ComposeState st
composeReg Int
i String
rbuf !Char
ch !st
st
        | Char -> Bool
Char.isHangul Char
ch = String -> ComposeState st -> ComposeState st
forall st. String -> ComposeState st -> ComposeState st
YieldList String
rbuf (ComposeState st -> ComposeState st)
-> ComposeState st -> ComposeState st
forall a b. (a -> b) -> a -> b
$ Char -> st -> ComposeState st
forall {st}. Char -> st -> ComposeState st
initHangul Char
ch st
st
        | Char -> Bool
Char.isJamo Char
ch = String -> ComposeState st -> ComposeState st
forall st. String -> ComposeState st -> ComposeState st
YieldList String
rbuf (ComposeState st -> ComposeState st)
-> ComposeState st -> ComposeState st
forall a b. (a -> b) -> a -> b
$ Char -> st -> ComposeState st
forall {st}. Char -> st -> ComposeState st
initJamo Char
ch st
st
        | Char -> Bool
Char.isCombining Char
ch = Int -> String -> Char -> st -> ComposeState st
forall {st}. Int -> String -> Char -> st -> ComposeState st
composeCharCombining Int
i String
rbuf Char
ch st
st
        | [Char
s] <- String
rbuf
        , Char -> Bool
Char.isCombiningStarter Char
ch
        , Just Char
x <- Char -> Char -> Maybe Char
Char.composeStarters Char
s Char
ch = Int -> String -> st -> ComposeState st
forall st. Int -> String -> st -> ComposeState st
ComposeReg Int
0 [Char
x] st
st
        | Bool
otherwise = String -> ComposeState st -> ComposeState st
forall st. String -> ComposeState st -> ComposeState st
YieldList String
rbuf (ComposeState st -> ComposeState st)
-> ComposeState st -> ComposeState st
forall a b. (a -> b) -> a -> b
$ Int -> String -> st -> ComposeState st
forall st. Int -> String -> st -> ComposeState st
ComposeReg Int
0 [Char
ch] st
st

normalizeD :: Monad m => NormalizationMode -> Stream m Char -> Stream m Char
normalizeD :: forall (m :: * -> *).
Monad m =>
NormalizationMode -> Stream m Char -> Stream m Char
normalizeD NormalizationMode
NFD = Bool -> DecomposeMode -> Stream m Char -> Stream m Char
forall (m :: * -> *).
Monad m =>
Bool -> DecomposeMode -> Stream m Char -> Stream m Char
decomposeD Bool
True DecomposeMode
Canonical
normalizeD NormalizationMode
NFKD = Bool -> DecomposeMode -> Stream m Char -> Stream m Char
forall (m :: * -> *).
Monad m =>
Bool -> DecomposeMode -> Stream m Char -> Stream m Char
decomposeD Bool
True DecomposeMode
Kompat
normalizeD NormalizationMode
NFC = Stream m Char -> Stream m Char
forall (m :: * -> *). Monad m => Stream m Char -> Stream m Char
partialComposeD (Stream m Char -> Stream m Char)
-> (Stream m Char -> Stream m Char)
-> Stream m Char
-> Stream m Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> DecomposeMode -> Stream m Char -> Stream m Char
forall (m :: * -> *).
Monad m =>
Bool -> DecomposeMode -> Stream m Char -> Stream m Char
decomposeD Bool
False DecomposeMode
Canonical
normalizeD NormalizationMode
NFKC = Stream m Char -> Stream m Char
forall (m :: * -> *). Monad m => Stream m Char -> Stream m Char
partialComposeD (Stream m Char -> Stream m Char)
-> (Stream m Char -> Stream m Char)
-> Stream m Char
-> Stream m Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> DecomposeMode -> Stream m Char -> Stream m Char
forall (m :: * -> *).
Monad m =>
Bool -> DecomposeMode -> Stream m Char -> Stream m Char
decomposeD Bool
False DecomposeMode
Kompat

normalize ::
       Monad m
    => NormalizationMode
    -> Stream m Char
    -> Stream m Char
normalize :: forall (m :: * -> *).
Monad m =>
NormalizationMode -> Stream m Char -> Stream m Char
normalize = NormalizationMode -> Stream m Char -> Stream m Char
forall (m :: * -> *).
Monad m =>
NormalizationMode -> Stream m Char -> Stream m Char
normalizeD