module CJK.Data.Pinyin where
import qualified Data.Text as Text
import qualified Data.Text.ICU.Normalize as Text
import Data.Maybe
data Tone = Flat
| Rising
| FallingRising
| Falling
| Neutral
deriving (Eq, Ord)
instance Show Tone where
show = show . toneNumber
toneNumber :: Tone -> Int
toneNumber Flat = 1
toneNumber Rising = 2
toneNumber FallingRising = 3
toneNumber Falling = 4
toneNumber Neutral = 5
toneCombiningMark :: Tone -> Maybe Char
toneCombiningMark Flat = Just '\x304'
toneCombiningMark Rising = Just '\x301'
toneCombiningMark FallingRising = Just '\x30C'
toneCombiningMark Falling = Just '\x300'
toneCombiningMark Neutral = Nothing
combiningMarkTone :: Char -> Maybe Tone
combiningMarkTone '\x304' = Just Flat
combiningMarkTone '\x301' = Just Rising
combiningMarkTone '\x30C' = Just FallingRising
combiningMarkTone '\x300' = Just Falling
combiningMarkTone _ = Nothing
data Phone = Phone {
sound :: Text.Text,
tone :: Tone
}
instance Show Phone where
show yin = Text.unpack (sound yin) ++ show (tone yin)
fromAccented :: Text.Text -> Phone
fromAccented s = go [] Nothing $ Text.unpack $ Text.normalize Text.NFD s
where go !tser !mb_tone cs = case cs of
[] -> Phone { sound = Text.pack (reverse tser), tone = fromMaybe Neutral mb_tone }
(c:cs) -> case combiningMarkTone c of
Just tone -> go tser (jst tone) cs
Nothing -> go (c:tser) mb_tone cs
where jst tone' = case mb_tone of
Just tone | tone /= tone' -> error $ "Conflicting tones " ++ show tone ++ " and " ++ show tone' ++ " in " ++ Text.unpack s
_ -> Just tone'
toAccented :: Phone -> Text.Text
toAccented yin = Text.pack $ go $ Text.unpack $ sound yin
where go [] = show (tone yin)
go (c:cs) | isVowel c = maybeToList (toneCombiningMark (tone yin)) ++ c:cs
| otherwise = c : go cs
isVowel 'a' = True
isVowel 'e' = True
isVowel 'i' = True
isVowel 'o' = True
isVowel 'u' = True
isVowel 'A' = True
isVowel 'E' = True
isVowel 'I' = True
isVowel 'O' = True
isVowel 'U' = True
isVowel _ = False