module Text.Numeral.Language.ZHO
(
trad_entry
, simpl_entry
, finance_trad_entry
, finance_simpl_entry
, pinyin_entry
, trad_cardinal
, simpl_cardinal
, finance_trad_cardinal
, finance_simpl_cardinal
, pinyin_cardinal
, struct
, bounds
) where
import "base" Data.Function ( fix )
import "base" Data.Monoid ( (<>) )
import qualified "containers" Data.Map as M
import "this" Text.Numeral
import "this" Text.Numeral.Misc ( dec )
import "this" Text.Numeral.Entry
import "text" Data.Text ( Text )
entry :: Entry
entry = emptyEntry
{ entIso639_1 = Just "zh"
, entIso639_2 = ["chi", "zho"]
, entIso639_3 = Just "cmn"
, entNativeNames = ["官話"]
, entEnglishName = Just "Chinese"
}
flipIfR :: Side -> (a -> a -> a) -> (a -> a -> a)
flipIfR L = id
flipIfR R = flip
add0 :: (Integral a) => a -> Rule a
add0 val f n | n < val `div` 10 = Lit 0 `Add` f n
| otherwise = f n
mulX :: (Integral a) => a -> Side -> Side -> Rule a
mulX val aSide mSide =
\f n -> let (m, a) = n `divMod` val
mval = if m == 1
then Lit 1 ⊡ Lit (fromIntegral val)
else f m ⊡ Lit (fromIntegral val)
in if a == 0
then mval
else (flipIfR aSide Add) (add0 val f a) mval
where
(⊡) = flipIfR mSide Mul
struct :: (Integral a) => a -> Exp
struct = pos
$ fix
$ findRule (0, lit)
( [(dec 1, step (dec 1) (dec 1) R L)]
<> [(dec n, stepX (dec n) (dec 1) R L) | n <- [2,3]]
<> [(dec n, stepX (dec n) (dec 4) R L) | n <- [4,8..44]]
)
(dec 48 1)
where
stepX = mkStep lit1 addX mulX
addX val _ = \f n -> Add (f val) (add0 val f $ n val)
bounds :: (Integral a) => (a, a)
bounds = let x = dec 48 1 in (negate x, x)
cardinalRepr :: Repr
cardinalRepr = defaultRepr
{ reprAdd = Just $ \_ _ _ -> ""
, reprMul = Just $ \_ _ _ -> ""
}
trad_entry :: Entry
trad_entry = entry
{ entVariant = Just "traditional"
, entCardinal = Just Conversion
{ toNumeral = trad_cardinal
, toStructure = struct
}
}
trad_cardinal :: (Integral a) => Inflection -> a -> Maybe Text
trad_cardinal inf = trad_cardinalRepr inf . struct
trad_cardinalRepr :: Inflection -> Exp -> Maybe Text
trad_cardinalRepr =
render cardinalRepr
{ reprValue = \_ n -> M.lookup n trad_syms
, reprNeg = Just $ \_ _ -> "負"
}
trad_syms :: (Integral a) => M.Map a (Ctx Exp -> Text)
trad_syms =
M.fromList
[ (0, \c -> case c of
CtxEmpty -> "零"
_ -> "〇"
)
, (1, const "一")
, (2, \c -> case c of
CtxMul _ (Lit n) _ | n >= 1000 -> "兩"
_ -> "二"
)
, (3, const "三")
, (4, const "四")
, (5, const "五")
, (6, const "六")
, (7, const "七")
, (8, const "八")
, (9, const "九")
, (10, const "十")
, (100, const "百")
, (1000, const "千")
, (dec 4, const "萬")
, (dec 8, const "億")
, (dec 12, const "兆")
, (dec 16, const "京")
, (dec 20, const "垓")
, (dec 24, const "秭")
, (dec 28, const "穰")
, (dec 32, const "溝")
, (dec 36, const "澗")
, (dec 40, const "正")
, (dec 44, const "載")
]
simpl_entry :: Entry
simpl_entry = entry
{ entVariant = Just "simplified"
, entCardinal = Just Conversion
{ toNumeral = simpl_cardinal
, toStructure = struct
}
}
simpl_cardinal :: (Integral a) => Inflection -> a -> Maybe Text
simpl_cardinal inf = simpl_cardinalRepr inf . struct
simpl_cardinalRepr :: Inflection -> Exp -> Maybe Text
simpl_cardinalRepr =
render cardinalRepr
{ reprValue = \_ n -> M.lookup n (simpl_syms `M.union` trad_syms)
, reprNeg = Just $ \_ _ -> "负"
}
simpl_syms :: (Integral a) => M.Map a (Ctx Exp -> Text)
simpl_syms =
M.fromList
[ (2, \c -> case c of
CtxMul _ (Lit n) _ | n >= 1000 -> "两"
_ -> "二"
)
, (dec 4, const "万")
, (dec 8, const "亿")
]
finance_trad_entry :: Entry
finance_trad_entry = entry
{ entVariant = Just "finance traditional"
, entCardinal = Just Conversion
{ toNumeral = finance_trad_cardinal
, toStructure = struct
}
}
finance_trad_cardinal :: (Integral a) => Inflection -> a -> Maybe Text
finance_trad_cardinal inf = finance_trad_cardinalRepr inf . struct
finance_trad_cardinalRepr :: Inflection -> Exp -> Maybe Text
finance_trad_cardinalRepr =
render cardinalRepr
{ reprValue = \_ n -> M.lookup n (finance_trad_syms `M.union` trad_syms)
, reprNeg = Just $ \_ _ -> "負"
}
finance_trad_syms :: (Integral a) => M.Map a (Ctx Exp -> Text)
finance_trad_syms =
M.fromList
[ (0, const "零")
, (1, const "壹")
, (2, const "貳")
, (3, const "参")
, (4, const "肆")
, (5, const "伍")
, (6, const "陸")
, (7, const "柒")
, (8, const "捌")
, (9, const "玖")
, (10, const "拾")
, (100, const "伯")
, (1000, const "仟")
, (dec 4, const "萬")
, (dec 8, const "億")
]
finance_simpl_entry :: Entry
finance_simpl_entry = entry
{ entVariant = Just "finance simplified"
, entCardinal = Just Conversion
{ toNumeral = finance_simpl_cardinal
, toStructure = struct
}
}
finance_simpl_cardinal :: (Integral a) => Inflection -> a -> Maybe Text
finance_simpl_cardinal inf = finance_simpl_cardinalRepr inf . struct
finance_simpl_cardinalRepr :: Inflection -> Exp -> Maybe Text
finance_simpl_cardinalRepr =
render cardinalRepr
{ reprValue = \_ n -> M.lookup n ( finance_simpl_syms
`M.union` finance_trad_syms
`M.union` trad_syms
)
, reprNeg = Just $ \_ _ -> "负"
}
where
finance_simpl_syms :: (Integral a) => M.Map a (Ctx Exp -> Text)
finance_simpl_syms =
M.fromList
[ (2, const "贰")
, (6, const "陆")
, (dec 4, const "万")
, (dec 8, const "亿")
]
pinyin_entry :: Entry
pinyin_entry = entry
{ entVariant = Just "pinyin"
, entCardinal = Just Conversion
{ toNumeral = pinyin_cardinal
, toStructure = struct
}
}
pinyin_cardinal :: (Integral a) => Inflection -> a -> Maybe Text
pinyin_cardinal inf = pinyin_cardinalRepr inf . struct
pinyin_cardinalRepr :: Inflection -> Exp -> Maybe Text
pinyin_cardinalRepr =
render cardinalRepr
{ reprValue = \_ n -> M.lookup n pinyin_syms
, reprNeg = Just $ \_ _ -> "fù"
, reprAdd = Just (⊞)
}
where
(Lit 10 ⊞ _) _ = ""
(_ ⊞ _) _ = " "
pinyin_syms :: (Integral a) => M.Map a (Ctx Exp -> Text)
pinyin_syms =
M.fromList
[ (0, const "líng")
, (1, const "yī")
, (2, \c -> case c of
CtxMul _ (Lit n) _ | n >= 1000 -> "liǎng"
_ -> "èr"
)
, (3, const "sān")
, (4, const "sì")
, (5, const "wǔ")
, (6, const "liù")
, (7, const "qī")
, (8, const "bā")
, (9, const "jiǔ")
, (10, const "shí")
, (100, const "bǎi")
, (1000, const "qiān")
, (dec 4, const "wàn")
, (dec 8, const "yì")
, (dec 12, const "zhào")
, (dec 16, const "jīng")
, (dec 20, const "gāi")
, (dec 24, const "zǐ")
, (dec 28, const "ráng")
, (dec 32, const "gōu")
, (dec 36, const "jiàn")
, (dec 40, const "zhēng")
, (dec 44, const "zài")
]