BigNum.hs

{-# LANGUAGE NoImplicitPrelude
           , OverloadedStrings
           , PackageImports
           , UnicodeSyntax
  #-}

module Text.Numeral.BigNum
  ( cardinal
  , rule
  , cardinalRepr
  , symMap
  , forms

  , PostfixRepr
  , scaleRepr
  , pelletierRepr

  , quantityName
  , ordQuantityName
  ) 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" 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 "this"                       Text.Numeral.Misc     ( dec )
import qualified "containers" Data.Map as M ( Map, fromList, lookup )
import qualified "this"       Text.Numeral.Exp as E
import "text" Data.Text ( Text )


--------------------------------------------------------------------------------
-- Language of Big Numbers
--------------------------------------------------------------------------------

cardinal ∷ (Integral α) ⇒ inf → α → Maybe Text
cardinal inf = render cardinalRepr inf ∘ (pos $ fix rule)

rule ∷ (Integral α, E.Unknown β, E.Lit β, E.Add β, E.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         )
              , (1001, add 1000 L  )
              , (2000, mul 1000 R L)
              ]
                (dec 4 - 1)

cardinalRepr ∷ Repr inf
cardinalRepr =
    defaultRepr { reprValue = \_ n → M.lookup n symMap
                , reprAdd   = Just $ \_ _ _ → ""
                , reprMul   = Just $ \_ _ _ → ""
                }

symMap ∷ (Integral α) ⇒ M.Map α (Ctx (Exp i) → Text)
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")
         ]

forms ∷ Text → Text → Text → Text → Text → Ctx (Exp i) → Text
forms t a1 a2 m1 m2 ctx =
    case ctx of
      CtxAdd _ (Lit 10)  _ → a1
      CtxAdd {}            → a2
      CtxMul _ (Lit 10)  _ → m1
      CtxMul {}            → m2
      _                    → t


--------------------------------------------------------------------------------
-- Representations of scales
--------------------------------------------------------------------------------

-- | Function that renders the postfix part of a large number name. Or
-- more simply put, this calculates the \"illion\" part of
-- \"million\", \"billion\", etc.
type PostfixRepr i = i           -- ^ Current inflection.
                   → Ctx (Exp i) -- ^ Context.
                   → Text        -- ^ Postfix representation.

scaleRepr ∷ PostfixRepr i
          → [(ℤ, Ctx (Exp i) → Text)] -- ^ Additional symbol map entries.
          → ScaleRepr i
scaleRepr pf syms inf _ _ e ctx = (⊕ pf inf ctx) <$> render repr inf e
    where
      repr = cardinalRepr { reprValue = \_ n → M.lookup n syms' }
      syms' = M.fromList syms ∪ symMap

pelletierRepr ∷ PostfixRepr i -- ^Postfix for offset 0 names.
              → PostfixRepr i -- ^Postfix for offset 3 names.
              → [(ℤ, Ctx (Exp i) → Text)] -- ^ Additional symbol map entries.
              → ScaleRepr i
pelletierRepr pf0 pf3 syms inf
              b o e ctx | o ≡ 0 = scaleRepr pf0 syms inf b o e ctx
                        | o ≡ 3 = scaleRepr pf3 syms inf b o e ctx
                        | otherwise = Nothing

quantityName ∷ Text → Text → PostfixRepr i
quantityName s p _ ctx =
    case ctx of
      CtxMul _ (Lit 1) _ → s
      CtxMul {}          → p
      _                  → s

ordQuantityName ∷ Text → Text → Text → Text → PostfixRepr i
ordQuantityName sc so pc po _ ctx =
    case ctx of
      CtxMul _ (Lit 1) _ | outside   → so
                         | otherwise → sc
      CtxMul {}          | outside   → po
                         | otherwise → pc
      _                  | outside   → so
                         | otherwise → sc
    where
      outside = isOutside R ctx