{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module      : Text.Numerals.Prefix
-- Description : A module used to define /numeric prefixes/ for /long/ and /short scales/.
-- Maintainer  : hapytexeu+gh@gmail.com
-- Stability   : experimental
-- Portability : POSIX
--
-- A module that defines /Latin/ prefixes. These prefixes are used to construct names for the /long/ and /short scales/.
-- So the /m/, /b/, /tr/ in /million/, /billion/, /trillion/.
module Text.Numerals.Prefix
  ( -- * Latin prefixes
    latinPrefixes,
    latinPrefixes',
    latinPrefix,
  )
where

import Data.Text (Text)
import Data.Vector (Vector, fromList, (!?))

-- | A list of /Latin/ prefixes, used for the /long/ and /short scale/.
latinPrefixes' ::
  -- | A list of 'Text' objects. This makes explicit recursion more convenient.
  [Text]
latinPrefixes' :: [Text]
latinPrefixes' =
  [ Text
"m",
    Text
"b",
    Text
"tr",
    Text
"quadr",
    Text
"quint",
    Text
"sext",
    Text
"sept",
    Text
"oct",
    Text
"non",
    Text
"dec",
    Text
"undec",
    Text
"duodec",
    Text
"tredec",
    Text
"quattuordec",
    Text
"quindec",
    Text
"sedec",
    Text
"septendec",
    Text
"octodec",
    Text
"novendec",
    Text
"vigint",
    Text
"unvigint",
    Text
"duovigint",
    Text
"tresvigint",
    Text
"quattuorvigint",
    Text
"quinvigint",
    Text
"sesvigint",
    Text
"septemvigint",
    Text
"octovigint",
    Text
"novemvigint",
    Text
"trigint",
    Text
"untrigint",
    Text
"duotrigint",
    Text
"trestrigint",
    Text
"quattuortrigint",
    Text
"quintrigint",
    Text
"sestrigint",
    Text
"septentrigint",
    Text
"octotrigint",
    Text
"noventrigint",
    Text
"quadragint"
  ]

-- | The /Latin/ prefixes in a 'Vector' for /O(1)/ lookup.
latinPrefixes ::
  -- | A 'Vector' of 'Text' objects to allow fast lookup.
  Vector Text
latinPrefixes :: Vector Text
latinPrefixes = [Text] -> Vector Text
forall a. [a] -> Vector a
fromList [Text]
latinPrefixes'

-- | Lookup the given /Latin/ prefix for the given value.
latinPrefix ::
  Integral i =>
  -- | The value to map on a Latin prefix.
  i ->
  -- | The corresponding Latin prefix, given this exists.
  Maybe Text
latinPrefix :: forall i. Integral i => i -> Maybe Text
latinPrefix i
n = Vector Text
latinPrefixes Vector Text -> Int -> Maybe Text
forall a. Vector a -> Int -> Maybe a
!? (i -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral i
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)