{-# LANGUAGE BangPatterns #-}
-- |
-- Module      : Data.Unicode.Properties.DecomposeHangul
-- Copyright   : (c) 2016 Harendra Kumar
--
-- License     : BSD-style
-- Maintainer  : harendra.kumar@gmail.com
-- Stability   : experimental
--
module Data.Unicode.Properties.DecomposeHangul
    (decomposeCharHangul
    , hangulFirst
    , isHangul
    , isHangulLV
    , isJamo
    , jamoLFirst
    , jamoLIndex
    , jamoNCount
    , jamoVIndex
    , jamoTCount
    , jamoTIndex
    )
where

import           Data.Char (ord)
import           GHC.Base  (unsafeChr)

-- Hangul characters can be decomposed algorithmically instead of via mappings

-------------------------------------------------------------------------------
-- General utilities used by decomposition as well as composition
-------------------------------------------------------------------------------

-- jamo leading
jamoLFirst, jamoLCount :: Int
jamoLFirst :: Int
jamoLFirst  = Int
0x1100
jamoLCount :: Int
jamoLCount = Int
19

-- jamo vowel
jamoVFirst, jamoVCount :: Int
jamoVFirst :: Int
jamoVFirst  = Int
0x1161
jamoVCount :: Int
jamoVCount = Int
21

-- jamo trailing
jamoTFirst, jamoTCount :: Int
jamoTFirst :: Int
jamoTFirst  = Int
0x11a7
jamoTCount :: Int
jamoTCount = Int
28

jamoLast :: Int
jamoLast :: Int
jamoLast = Int
jamoTFirst Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
jamoTCount Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

-- VCount * TCount
jamoNCount :: Int
jamoNCount :: Int
jamoNCount = Int
588

-- hangul
hangulFirst, hangulLast :: Int
hangulFirst :: Int
hangulFirst = Int
0xac00
hangulLast :: Int
hangulLast = Int
hangulFirst Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
jamoLCount Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
jamoVCount Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
jamoTCount Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

isHangul :: Char -> Bool
isHangul :: Char -> Bool
isHangul Char
c = Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
hangulFirst Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
hangulLast
    where n :: Int
n = Char -> Int
ord Char
c

isHangulLV :: Char -> Bool
isHangulLV :: Char -> Bool
isHangulLV Char
c = Int
ti Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
    where
        i :: Int
i = (Char -> Int
ord Char
c) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
hangulFirst
        !(Int
_, Int
ti) = Int
i  Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
jamoTCount

isJamo :: Char -> Bool
isJamo :: Char -> Bool
isJamo Char
c = Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
jamoLFirst Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
jamoLast
    where n :: Int
n = Char -> Int
ord Char
c

-- if it is a jamo L char return the index
jamoLIndex :: Char -> Maybe Int
jamoLIndex :: Char -> Maybe Int
jamoLIndex Char
c
  | Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
jamoLCount = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
index
  | Bool
otherwise = Maybe Int
forall a. Maybe a
Nothing
    where index :: Int
index = Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
jamoLFirst

jamoVIndex :: Char -> Maybe Int
jamoVIndex :: Char -> Maybe Int
jamoVIndex Char
c
  | Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
jamoVCount = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
index
  | Bool
otherwise = Maybe Int
forall a. Maybe a
Nothing
    where index :: Int
index = Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
jamoVFirst

-- Note that index 0 is not a valid index for a trailing consonant. Index 0
-- means no T, only LV syllable.
-- See Unicode 9.0.0: 3.12 (Hangul Syllable Decomposition)
-- TBase is set to one less than the beginning of the range of trailing
-- consonants, which starts at U+11A8.
jamoTIndex :: Char -> Maybe Int
jamoTIndex :: Char -> Maybe Int
jamoTIndex Char
c
  | Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
jamoTCount = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
index
  | Bool
otherwise = Maybe Int
forall a. Maybe a
Nothing
    where index :: Int
index = Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
jamoTFirst

-------------------------------------------------------------------------------
-- Hangul decomposition
-------------------------------------------------------------------------------

{-# INLINE decomposeCharHangul #-}
decomposeCharHangul :: Char -> Either (Char, Char) (Char, Char, Char)
decomposeCharHangul :: Char -> Either (Char, Char) (Char, Char, Char)
decomposeCharHangul Char
c
    | Int
ti Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0   = (Char, Char) -> Either (Char, Char) (Char, Char, Char)
forall a b. a -> Either a b
Left (Char
l, Char
v)
    | Bool
otherwise = (Char, Char, Char) -> Either (Char, Char) (Char, Char, Char)
forall a b. b -> Either a b
Right (Char
l, Char
v, Char
t)
    where
        i :: Int
i = (Char -> Int
ord Char
c) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
hangulFirst
        !(Int
tn, Int
ti) = Int
i  Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
jamoTCount
        !(Int
li, Int
vi) = Int
tn Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
jamoVCount

        l :: Char
l = Int -> Char
unsafeChr (Int
jamoLFirst Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
li)
        v :: Char
v = Int -> Char
unsafeChr (Int
jamoVFirst Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
vi)
        t :: Char
t = Int -> Char
unsafeChr (Int
jamoTFirst Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ti)