numerals-base-0.3: src/Text/Numeral/BigNum.hs
{-# LANGUAGE NoImplicitPrelude
, OverloadedStrings
, PackageImports
, UnicodeSyntax
#-}
module Text.Numeral.BigNum
( cardinal
, rule
, cardinalRepr
, symMap
, forms
, scaleRepr
, pelletierRepr
) where
-------------------------------------------------------------------------------
-- Imports
-------------------------------------------------------------------------------
import "base" Data.Bool ( otherwise )
import "base" Data.Function ( ($), const, fix )
import "base" Data.Functor ( (<$>) )
import "base" Data.Maybe ( Maybe(Nothing, Just) )
import "base" Data.Monoid ( Monoid )
import "base" Data.String ( IsString )
import "base" Prelude ( Integral )
import "base-unicode-symbols" Data.Eq.Unicode ( (≡) )
import "base-unicode-symbols" Data.Function.Unicode ( (∘) )
import "base-unicode-symbols" Data.List.Unicode ( (∈) )
import "base-unicode-symbols" Data.Monoid.Unicode ( (⊕) )
import "base-unicode-symbols" Prelude.Unicode ( ℤ )
import "containers-unicode-symbols" Data.Map.Unicode ( (∪) )
import "this" Text.Numeral
import qualified "containers" Data.Map as M ( Map, fromList, lookup )
import qualified "this" Text.Numeral.Exp.Classes as C
--------------------------------------------------------------------------------
-- Language of Big Numbers
--------------------------------------------------------------------------------
cardinal ∷ (Monoid s, IsString s, Integral α) ⇒ α → Maybe s
cardinal = render cardinalRepr ∘ (pos $ fix rule)
rule ∷ (Integral α, C.Unknown β, C.Lit β, C.Add β, C.Mul β) ⇒ Rule α β
rule = findRule ( 1, lit )
[ ( 11, add 10 L )
, ( 20, mul 10 L L)
, ( 100, lit )
, ( 101, add 100 L )
, ( 200, mul 100 R L)
, (1000, lit )
]
1000
cardinalRepr ∷ (Monoid s, IsString s) ⇒ Repr s
cardinalRepr =
defaultRepr { reprValue = \n → M.lookup n symMap
, reprAdd = Just $ \_ _ _ → ""
, reprMul = Just $ \_ _ _ → ""
}
symMap ∷ (Integral α, IsString s) ⇒ M.Map α (Ctx Exp → s)
symMap = M.fromList
[ (1, forms "m" "un" "un" "" "")
, (2, forms "b" "duo" "duo" "vi" "du")
, (3, forms "tr" "tre" "tres" "tri" "tre")
, (4, forms "quadr" "quattuor" "quattuor" "quadra" "quadri")
, (5, forms "quint" "quin" "quinqua" "quinqua" "quin")
, (6, forms "sext" "sex" "ses" "sexa" "ses")
, (7, forms "sept" "septen" "septem" "septua" "septin")
, (8, forms "oct" "octo" "octo" "octo" "octin")
, (9, forms "non" "novem" "novem" "nona" "non")
, (10, \c → case c of
CtxAdd _ (Lit 100) _ → "deci"
CtxMul _ _ (CtxAdd L (Lit 100) _) → "ginta"
CtxMul {} → "gint"
_ → "dec"
)
, (100, \c → case c of
CtxMul _ (Lit n) _
| n ∈ [2,3,6] → "cent"
| otherwise → "gent"
_ → "cent"
)
, (1000, const "millin")
, (10000, const "myr")
]
forms ∷ s → s → s → s → s → Ctx Exp → s
forms t a1 a2 m1 m2 ctx =
case ctx of
CtxAdd _ (Lit 10) _ → a1
CtxAdd {} → a2
CtxMul _ (Lit 100) _ → m2
CtxMul {} → m1
_ → t
--------------------------------------------------------------------------------
-- Representations of scales
--------------------------------------------------------------------------------
scaleRepr ∷ (IsString s, Monoid s)
⇒ s -- ^Postfix for singular names.
→ s -- ^Postfix for plural names.
→ [(ℤ, Ctx Exp → s)]
→ ℤ → ℤ → Exp → Ctx Exp → Maybe s
scaleRepr s p syms _ _ e ctx = (⊕ pf) <$> render repr e
where
pf = case ctx of
CtxMul _ (Lit 1) _ → s
CtxMul {} → p
_ → s
repr = cardinalRepr { reprValue = \n → M.lookup n syms' }
syms' = M.fromList syms ∪ symMap
pelletierRepr ∷ (IsString s, Monoid s)
⇒ s -- ^Postfix for singular offset 0 names.
→ s -- ^Postfix for singular offset 0 names.
→ s -- ^Postfix for plural offset 3 names.
→ s -- ^Postfix for plural offset 3 names.
→ [(ℤ, Ctx Exp → s)]
→ ℤ → ℤ → Exp → Ctx Exp → Maybe s
pelletierRepr s0 p0 s3 p3 syms
b o e ctx | o ≡ 0 = scaleRepr s0 p0 syms b o e ctx
| o ≡ 3 = scaleRepr s3 p3 syms b o e ctx
| otherwise = Nothing