numerals-0.4: src/Text/Numeral/Language/EN.hs
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UnicodeSyntax #-}
{-|
[@ISO639-1@] en
[@ISO639-2B@] eng
[@ISO639-3@] eng
[@Native name@] English
[@English name@] English
-}
module Text.Numeral.Language.EN
( -- * Language entries
gb_entry
, us_entry
-- * Conversions
, gb_cardinal
, gb_ordinal
, gbPelletier_cardinal
, us_cardinal
, us_ordinal
-- * Structure
, shortScaleStruct
, pelletierScaleStruct
-- * Bounds
, bounds
) where
--------------------------------------------------------------------------------
-- Imports
--------------------------------------------------------------------------------
import "base" Data.Bool ( otherwise )
import "base" Data.Function ( ($), const, fix )
import "base" Data.Maybe ( Maybe(Just) )
import "base" Data.Ord ( (<) )
import "base" Prelude ( (+), (-), div, subtract, negate, (^), error, Integral )
import "base-unicode-symbols" Data.Function.Unicode ( (∘) )
import "base-unicode-symbols" Prelude.Unicode ( ℤ, (⋅) )
import qualified "containers" Data.Map as M ( fromList, lookup )
import "this" Text.Numeral
import qualified "this" Text.Numeral.BigNum as BN
import qualified "this" Text.Numeral.Exp as E
import "this" Text.Numeral.Grammar ( Inflection )
import "this" Text.Numeral.Misc ( dec )
import "this" Text.Numeral.Entry
import "text" Data.Text ( Text )
--------------------------------------------------------------------------------
-- EN
--------------------------------------------------------------------------------
entry ∷ Entry
entry = emptyEntry
{ entIso639_1 = Just "en"
, entIso639_2 = ["eng"]
, entIso639_3 = Just "eng"
, entNativeNames = ["English"]
, entEnglishName = Just "English"
}
gb_entry ∷ Entry
gb_entry = entry
{ entVariant = Just "en-GB"
, entCardinal = Just Conversion
{ toNumeral = gb_cardinal
, toStructure = shortScaleStruct
}
, entOrdinal = Just Conversion
{ toNumeral = gb_ordinal
, toStructure = shortScaleStruct
}
}
us_entry ∷ Entry
us_entry = entry
{ entVariant = Just "en-US"
, entCardinal = Just Conversion
{ toNumeral = us_cardinal
, toStructure = shortScaleStruct
}
, entOrdinal = Just Conversion
{ toNumeral = us_ordinal
, toStructure = shortScaleStruct
}
}
gb_cardinal ∷ (Inflection i, Integral α, E.Scale α) ⇒ i → α → Maybe Text
gb_cardinal inf = render (cardinalRepr "minus " gb_add) inf ∘ shortScaleStruct
gb_ordinal ∷ (Inflection i, Integral α, E.Scale α) ⇒ i → α → Maybe Text
gb_ordinal inf = render (ordinalRepr gb_add) inf ∘ shortScaleStruct
gbPelletier_cardinal ∷ (Inflection i, Integral α, E.Scale α)
⇒ i → α → Maybe Text
gbPelletier_cardinal inf = render (cardinalRepr "minus " gb_add) { reprScale = pelletierRepr } inf
∘ pelletierScaleStruct
where
pelletierRepr = BN.pelletierRepr (\_ _ → "illion")
(\_ _ → "illiard")
[]
us_cardinal ∷ (Inflection i, Integral α, E.Scale α) ⇒ i → α → Maybe Text
us_cardinal inf = render (cardinalRepr "negative " us_add) inf ∘ shortScaleStruct
us_ordinal ∷ (Inflection i, Integral α, E.Scale α) ⇒ i → α → Maybe Text
us_ordinal inf = render (ordinalRepr us_add) inf ∘ shortScaleStruct
shortScaleStruct ∷ ( Integral α, E.Scale α
, E.Unknown β, E.Lit β, E.Neg β, E.Add β, E.Mul β, E.Scale β
)
⇒ α → β
shortScaleStruct = pos $ fix $ rule `combine` shortScale1 R L BN.rule
pelletierScaleStruct ∷ ( Integral α, E.Scale α
, E.Unknown β, E.Lit β, E.Neg β, E.Add β, E.Mul β, E.Scale β
)
⇒ α → β
pelletierScaleStruct = pos $ fix $ rule `combine` pelletierScale1 R L BN.rule
rule ∷ (Integral α, E.Unknown β, E.Lit β, E.Add β, E.Mul β) ⇒ Rule α β
rule = findRule ( 0, lit )
[ ( 13, add 10 L )
, ( 20, mul 10 R L)
, ( 100, step1 100 10 R L)
, (1000, step1 1000 1000 R L)
]
(dec 6 - 1)
bounds ∷ (Integral α) ⇒ (α, α)
bounds = let x = dec 30003 - 1 in (negate x, x)
genericRepr ∷ (Exp i → Exp i → Ctx (Exp i) → Text) -- ^ Add representation.
→ Repr i
genericRepr f =
defaultRepr
{ reprAdd = Just f
, reprMul = Just (⊞)
}
where
(_ ⊞ Lit 10) _ = ""
(_ ⊞ _ ) _ = " "
eval ∷ Exp i → ℤ
eval (Lit x) = x
eval (Add x y) = eval x + eval y
eval (Mul x y) = eval x ⋅ eval y
eval (Sub x y) = subtract (eval x) (eval y)
eval (Neg x) = negate (eval x)
eval (Frac n d) = eval n `div` eval d
eval (Scale b o r) = 10 ^ (eval r ⋅ b + o)
eval (Dual x) = eval x
eval (Plural x) = eval x
eval (Inflection _ x) = eval x
eval Unknown = error "eval: unknown"
gb_add ∷ Exp i → Exp i → Ctx (Exp i) → Text
((_ `Mul` Lit 10) `gb_add` _) _ = "-"
((_ `Mul` _ ) `gb_add` x) _
| eval x < (100 ∷ ℤ) = " and "
| otherwise = " "
(_ `gb_add` _) _ = ""
us_add ∷ Exp i → Exp i → Ctx (Exp i) → Text
((_ `Mul` Lit 10) `us_add` _) _ = "-"
((_ `Mul` _ ) `us_add` _) _ = " "
(_ `us_add` _) _ = ""
cardinalRepr ∷ Text -- ^ Negative number prefix.
→ (Exp i → Exp i → Ctx (Exp i) → Text)
→ Repr i
cardinalRepr neg f =
(genericRepr f)
{ reprValue = \_ n → M.lookup n syms
, reprScale = BN.scaleRepr (\_ _ → "illion") []
, reprNeg = Just $ \_ _ → neg
}
where
syms =
M.fromList
[ (0, const "zero")
, (1, const "one")
, (2, ten "two" "two" "twen")
, (3, ten "three" "thir" "thir")
, (4, ten "four" "four" "for")
, (5, ten "five" "fif" "fif")
, (6, const "six")
, (7, const "seven")
, (8, ten "eight" "eigh" "eigh")
, (9, const "nine")
, (10, \c → case c of
CtxAdd _ (Lit _) _ → "teen"
CtxMul R _ _ → "ty"
_ → "ten"
)
, (11, const "eleven")
, (12, const "twelve")
, (100, const "hundred")
, (1000, const "thousand")
]
ten ∷ s → s → s → Ctx (Exp i) → s
ten n a m = \c → case c of
CtxAdd _ (Lit 10) _ → a
CtxMul _ (Lit 10) _ → m
_ → n
ordinalRepr ∷ (Exp i → Exp i → Ctx (Exp i) → Text) → Repr i
ordinalRepr f = (genericRepr f)
{ reprValue = \_ n → M.lookup n syms
, reprScale = BN.scaleRepr (BN.ordQuantityName "illion" "illionth"
"illion" "illionth"
)
[]
}
where
syms =
M.fromList
[ (0, const "zeroth")
, (1, \c → case c of
_ | isOutside R c → "first"
| otherwise → "one"
)
, (2, ten "second" "two" "two" "twen")
, (3, ten "third" "three" "thir" "thir")
, (4, ten "fourth" "four" "four" "for")
, (5, ten "fifth" "five" "fif" "fif")
, (6, \c → if isOutside R c then "sixth" else "six")
, (7, \c → if isOutside R c then "seventh" else "seven")
, (8, ten "eighth" "eight" "eigh" "eigh")
, (9, \c → if isOutside R c then "ninth" else "nine")
, (10, \c → case c of
CtxAdd _ (Lit _) _ | isOutside R c → "teenth"
| otherwise → "teen"
CtxMul R _ _ | isOutside R c → "tieth"
| otherwise → "ty"
_ | isOutside R c → "tenth"
| otherwise → "ten"
)
, (11, \c → if isOutside R c then "eleventh" else "eleven")
, (12, \c → if isOutside R c then "twelfth" else "twelf")
, (100, \c → if isOutside R c then "hundreth" else "hundred")
, (1000, \c → if isOutside R c then "thousandth" else "thousand")
]
ten ∷ s -- ^ Ordinal form.
→ s -- ^ Cardinal form; normal.
→ s -- ^ Cardinal form; added to ten.
→ s -- ^ Cardinal form; multiplied with ten.
→ Ctx (Exp i)
→ s
ten o n a m ctx = case ctx of
_ | isOutside R ctx → o
CtxAdd _ (Lit 10) _ → a
CtxMul _ (Lit 10) _ → m
_ → n