module Text.Numeral.Language.CRO
(
entry
, cardinal
, shortScaleStruct
, pelletierScaleStruct
, bounds
) where
import "base" Data.Function ( fix )
import qualified "containers" Data.Map as M ( fromList, lookup )
import "this" Text.Numeral
import qualified "this" Text.Numeral.BigNum as BN
import "this" Text.Numeral.Misc ( dec )
import "this" Text.Numeral.Entry
import "text" Data.Text ( Text )
entry :: Entry
entry = emptyEntry
{ entIso639_1 = Just "hr"
, entIso639_2 = ["cro"]
, entIso639_3 = Just "cro"
, entNativeNames = ["Hrvatski"]
, entEnglishName = Just "Croatian"
, entCardinal = Just Conversion
{ toNumeral = cardinal
, toStructure = struct
}
}
struct :: (Integral a) => a -> Exp
struct = pos $ fix $ rule
cardinal :: (Integral a) => Inflection -> a -> Maybe Text
cardinal inf = render (cardinalRepr "minus " hr_add) inf . shortScaleStruct
shortScaleStruct :: (Integral a) => a -> Exp
shortScaleStruct = pos $ fix $ rule `combine` shortScale1 R L BN.rule
pelletierScaleStruct :: (Integral a) => a -> Exp
pelletierScaleStruct = pos $ fix $ rule `combine` pelletierScale1 R L BN.rule
rule :: (Integral a) => Rule a
rule = findRule ( 0, lit )
[ ( 11, add 10 L )
, ( 20, mul 10 R L)
, ( 100, step 100 10 R L)
, (1000, step 1000 1000 R L)
] (dec 6 1)
bounds :: (Integral a) => (a, a)
bounds = let x = dec 30003 1 in (negate x, x)
genericRepr :: (Exp -> Exp -> Ctx Exp -> Text)
-> Repr
genericRepr _ =
defaultRepr
{ reprAdd = Just (hr_add)
, reprMul = Just (⊞)
}
where
(_ ⊞ Lit 10) _ = ""
(_ ⊞ Lit 100) _ = ""
(_ ⊞ _ ) _ = " "
hr_add :: Exp -> Exp -> Ctx Exp -> Text
((Lit 100) `hr_add` _) _ = " "
((Lit 1000) `hr_add`_) _ = " "
((_ `Mul` _ ) `hr_add` _) _ = " "
(_ `hr_add` _) _ = ""
cardinalRepr :: Text
-> (Exp -> Exp -> Ctx Exp -> Text)
-> Repr
cardinalRepr neg f =
(genericRepr f)
{ reprValue = \_ n -> M.lookup n syms
, reprScale = BN.scaleRepr (\_ _ -> "ljun") []
, reprNeg = Just $ \_ _ -> neg
}
where
syms =
M.fromList
[ (0, const "nula")
, (1, ten "jedan" "jeda" "jedan")
, (2, hun "dva" "dva" "dvje" "dva")
, (3, const "tri")
, (4, ten "četiri" "četr" "četr")
, (5, ten "pet" "pet" "pe")
, (6, hun "šest" "šes" "še" "šes")
, (7, const "sedam")
, (8, const "osam")
, (9, ten "devet" "devet" "deve")
, (10, \c -> case c of
CtxAdd _ (Lit 100) _ -> "deset"
CtxAdd _ (Lit _) _ -> "naest"
_ -> "deset"
)
, (60, const "šedeset")
, (100, const "sto")
, (1000, \c -> case c of
CtxMul R _ _ -> "tisuća"
_ -> "tisuću")
]
ten :: Text -> Text -> Text -> Ctx Exp -> Text
ten n a m = \c -> case c of
CtxAdd _ (Lit 10) _ -> a
CtxMul _ (Lit 10) _ -> m
_ -> n
hun :: Text -> Text -> Text -> Text -> Ctx Exp -> Text
hun n a h m = \c -> case c of
CtxAdd _ (Lit 10) _ -> a
CtxMul _ (Lit 10) _ -> m
CtxMul _ (Lit 100) _ -> h
_ -> n