{-# LANGUAGE CPP, DeriveDataTypeable, DeriveGeneric, OverloadedStrings, RankNTypes, TupleSections #-}
module Text.Numerals.Algorithm (
NumeralsAlgorithm
, numeralsAlgorithm
, HighNumberAlgorithm(ShortScale, LongScale)
, shortScale, longScale
, shortScaleTitle, longScaleTitle
, valueSplit'
, toSegments
, toSegmentLow, toSegmentMid, toSegmentHigh
, compressSegments
) where
import Control.DeepSeq(NFData)
import Data.Data(Data)
import Data.Default.Class(Default(def))
import Data.Foldable(toList)
import Data.List(sortOn)
#if __GLASGOW_HASKELL__ < 803
import Data.Semigroup((<>))
#endif
import Data.Text(Text, cons, toTitle)
import Data.Vector(Vector, (!), (!?), fromList)
import qualified Data.Vector as V
import GHC.Generics(Generic)
import Test.QuickCheck(oneof)
import Test.QuickCheck.Arbitrary(Arbitrary(arbitrary, shrink))
import Text.Numerals.Class(
NumToWord(toCardinal, toOrdinal, toShortOrdinal, toTimeText')
, FreeMergerFunction, FreeNumberToWords, FreeValueSplitter
, MergerFunction, MNumberSegment
, NumberSegment(NumberSegment), NumberSegmenting
, ValueSplit(valueSplit), ValueSplitter
, ClockText
, toClockSegment, toDaySegment
)
import Text.Numerals.Internal(_genText, _shrinkText, _thousand, _iLogFloor)
import Text.Numerals.Prefix(latinPrefixes)
data NumeralsAlgorithm = NumeralsAlgorithm {
NumeralsAlgorithm -> Text
minusWord :: Text
, NumeralsAlgorithm -> Text
oneWord :: Text
, NumeralsAlgorithm -> Vector Text
lowWords :: Vector Text
, NumeralsAlgorithm -> [(Integer, Text)]
midWords :: [(Integer, Text)]
, NumeralsAlgorithm -> forall i. Integral i => ValueSplitter i
highWords :: FreeValueSplitter
, NumeralsAlgorithm -> forall i. Integral i => MergerFunction i
mergeFunction :: FreeMergerFunction
, NumeralsAlgorithm -> Text -> Text
ordinize :: Text -> Text
, NumeralsAlgorithm -> forall i. Integral i => NumberToWords i
shortOrdinal :: FreeNumberToWords
, NumeralsAlgorithm -> ClockText
clockText :: ClockText
}
instance NumToWord NumeralsAlgorithm where
toCardinal :: NumeralsAlgorithm -> i -> Text
toCardinal NumeralsAlgorithm { minusWord :: NumeralsAlgorithm -> Text
minusWord=Text
_minusWord, oneWord :: NumeralsAlgorithm -> Text
oneWord=Text
_oneWord, lowWords :: NumeralsAlgorithm -> Vector Text
lowWords=Vector Text
_lowWords, midWords :: NumeralsAlgorithm -> [(Integer, Text)]
midWords=[(Integer, Text)]
_midWords, highWords :: NumeralsAlgorithm -> forall i. Integral i => ValueSplitter i
highWords=forall i. Integral i => ValueSplitter i
_highWords, mergeFunction :: NumeralsAlgorithm -> forall i. Integral i => MergerFunction i
mergeFunction=forall i. Integral i => MergerFunction i
_mergeFunction } = i -> Text
forall i. Integral i => NumberToWords i
cardinal
where cardinal :: a -> Text
cardinal a
i
| a
i a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 = Text
_minusWord Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text -> Text
cons Char
' ' (Integer -> Text
go (-Integer
j))
| Bool
otherwise = Integer -> Text
go Integer
j
where go :: Integer -> Text
go = Text -> MergerFunction Integer -> NumberSegment Integer -> Text
forall i.
Integral i =>
Text -> MergerFunction i -> NumberSegment i -> Text
compressSegments Text
_oneWord MergerFunction Integer
forall i. Integral i => MergerFunction i
_mergeFunction (NumberSegment Integer -> Text)
-> (Integer -> NumberSegment Integer) -> Integer -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Text
-> [(Integer, Text)]
-> ValueSplitter Integer
-> Integer
-> NumberSegment Integer
forall i.
Integral i =>
Vector Text
-> [(Integer, Text)] -> ValueSplitter i -> NumberSegmenting i
toSegments Vector Text
_lowWords [(Integer, Text)]
_midWords ValueSplitter Integer
forall i. Integral i => ValueSplitter i
_highWords
j :: Integer
j = a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i :: Integer
toOrdinal :: NumeralsAlgorithm -> i -> Text
toOrdinal na :: NumeralsAlgorithm
na@NumeralsAlgorithm { ordinize :: NumeralsAlgorithm -> Text -> Text
ordinize=Text -> Text
_ordinize } = Text -> Text
_ordinize (Text -> Text) -> (i -> Text) -> i -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NumeralsAlgorithm -> i -> Text
forall a i. (NumToWord a, Integral i) => a -> i -> Text
toCardinal NumeralsAlgorithm
na
toShortOrdinal :: NumeralsAlgorithm -> i -> Text
toShortOrdinal = NumeralsAlgorithm -> i -> Text
NumeralsAlgorithm -> forall i. Integral i => NumberToWords i
shortOrdinal
toTimeText' :: NumeralsAlgorithm -> Int -> Int -> Text
toTimeText' NumeralsAlgorithm
alg Int
h Int
m = NumeralsAlgorithm -> ClockText
clockText NumeralsAlgorithm
alg (Int -> ClockSegment
toClockSegment Int
m) (Int -> DaySegment
toDaySegment Int
h) Int
h Int
m
_toNumberScale :: (Integral i, Integral j) => i -> (j, i)
_toNumberScale :: i -> (j, i)
_toNumberScale i
i = (j
l, i
k)
where ~(i
_, j
l, i
k) = i -> i -> (i, j, i)
forall i j. (Integral i, Integral j) => i -> i -> (i, j, i)
_iLogFloor i
forall i. Integral i => i
_thousand i
i
data HighNumberAlgorithm
= ShortScale Text
| LongScale Text Text
deriving (Typeable HighNumberAlgorithm
DataType
Constr
Typeable HighNumberAlgorithm
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HighNumberAlgorithm
-> c HighNumberAlgorithm)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HighNumberAlgorithm)
-> (HighNumberAlgorithm -> Constr)
-> (HighNumberAlgorithm -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HighNumberAlgorithm))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HighNumberAlgorithm))
-> ((forall b. Data b => b -> b)
-> HighNumberAlgorithm -> HighNumberAlgorithm)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HighNumberAlgorithm -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HighNumberAlgorithm -> r)
-> (forall u.
(forall d. Data d => d -> u) -> HighNumberAlgorithm -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> HighNumberAlgorithm -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HighNumberAlgorithm -> m HighNumberAlgorithm)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HighNumberAlgorithm -> m HighNumberAlgorithm)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HighNumberAlgorithm -> m HighNumberAlgorithm)
-> Data HighNumberAlgorithm
HighNumberAlgorithm -> DataType
HighNumberAlgorithm -> Constr
(forall b. Data b => b -> b)
-> HighNumberAlgorithm -> HighNumberAlgorithm
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HighNumberAlgorithm
-> c HighNumberAlgorithm
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HighNumberAlgorithm
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> HighNumberAlgorithm -> u
forall u.
(forall d. Data d => d -> u) -> HighNumberAlgorithm -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HighNumberAlgorithm -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HighNumberAlgorithm -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HighNumberAlgorithm -> m HighNumberAlgorithm
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HighNumberAlgorithm -> m HighNumberAlgorithm
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HighNumberAlgorithm
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HighNumberAlgorithm
-> c HighNumberAlgorithm
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HighNumberAlgorithm)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HighNumberAlgorithm)
$cLongScale :: Constr
$cShortScale :: Constr
$tHighNumberAlgorithm :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> HighNumberAlgorithm -> m HighNumberAlgorithm
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HighNumberAlgorithm -> m HighNumberAlgorithm
gmapMp :: (forall d. Data d => d -> m d)
-> HighNumberAlgorithm -> m HighNumberAlgorithm
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HighNumberAlgorithm -> m HighNumberAlgorithm
gmapM :: (forall d. Data d => d -> m d)
-> HighNumberAlgorithm -> m HighNumberAlgorithm
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HighNumberAlgorithm -> m HighNumberAlgorithm
gmapQi :: Int -> (forall d. Data d => d -> u) -> HighNumberAlgorithm -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HighNumberAlgorithm -> u
gmapQ :: (forall d. Data d => d -> u) -> HighNumberAlgorithm -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> HighNumberAlgorithm -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HighNumberAlgorithm -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HighNumberAlgorithm -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HighNumberAlgorithm -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HighNumberAlgorithm -> r
gmapT :: (forall b. Data b => b -> b)
-> HighNumberAlgorithm -> HighNumberAlgorithm
$cgmapT :: (forall b. Data b => b -> b)
-> HighNumberAlgorithm -> HighNumberAlgorithm
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HighNumberAlgorithm)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HighNumberAlgorithm)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c HighNumberAlgorithm)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HighNumberAlgorithm)
dataTypeOf :: HighNumberAlgorithm -> DataType
$cdataTypeOf :: HighNumberAlgorithm -> DataType
toConstr :: HighNumberAlgorithm -> Constr
$ctoConstr :: HighNumberAlgorithm -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HighNumberAlgorithm
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HighNumberAlgorithm
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HighNumberAlgorithm
-> c HighNumberAlgorithm
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HighNumberAlgorithm
-> c HighNumberAlgorithm
$cp1Data :: Typeable HighNumberAlgorithm
Data, HighNumberAlgorithm -> HighNumberAlgorithm -> Bool
(HighNumberAlgorithm -> HighNumberAlgorithm -> Bool)
-> (HighNumberAlgorithm -> HighNumberAlgorithm -> Bool)
-> Eq HighNumberAlgorithm
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HighNumberAlgorithm -> HighNumberAlgorithm -> Bool
$c/= :: HighNumberAlgorithm -> HighNumberAlgorithm -> Bool
== :: HighNumberAlgorithm -> HighNumberAlgorithm -> Bool
$c== :: HighNumberAlgorithm -> HighNumberAlgorithm -> Bool
Eq, (forall x. HighNumberAlgorithm -> Rep HighNumberAlgorithm x)
-> (forall x. Rep HighNumberAlgorithm x -> HighNumberAlgorithm)
-> Generic HighNumberAlgorithm
forall x. Rep HighNumberAlgorithm x -> HighNumberAlgorithm
forall x. HighNumberAlgorithm -> Rep HighNumberAlgorithm x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HighNumberAlgorithm x -> HighNumberAlgorithm
$cfrom :: forall x. HighNumberAlgorithm -> Rep HighNumberAlgorithm x
Generic, Eq HighNumberAlgorithm
Eq HighNumberAlgorithm
-> (HighNumberAlgorithm -> HighNumberAlgorithm -> Ordering)
-> (HighNumberAlgorithm -> HighNumberAlgorithm -> Bool)
-> (HighNumberAlgorithm -> HighNumberAlgorithm -> Bool)
-> (HighNumberAlgorithm -> HighNumberAlgorithm -> Bool)
-> (HighNumberAlgorithm -> HighNumberAlgorithm -> Bool)
-> (HighNumberAlgorithm
-> HighNumberAlgorithm -> HighNumberAlgorithm)
-> (HighNumberAlgorithm
-> HighNumberAlgorithm -> HighNumberAlgorithm)
-> Ord HighNumberAlgorithm
HighNumberAlgorithm -> HighNumberAlgorithm -> Bool
HighNumberAlgorithm -> HighNumberAlgorithm -> Ordering
HighNumberAlgorithm -> HighNumberAlgorithm -> HighNumberAlgorithm
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: HighNumberAlgorithm -> HighNumberAlgorithm -> HighNumberAlgorithm
$cmin :: HighNumberAlgorithm -> HighNumberAlgorithm -> HighNumberAlgorithm
max :: HighNumberAlgorithm -> HighNumberAlgorithm -> HighNumberAlgorithm
$cmax :: HighNumberAlgorithm -> HighNumberAlgorithm -> HighNumberAlgorithm
>= :: HighNumberAlgorithm -> HighNumberAlgorithm -> Bool
$c>= :: HighNumberAlgorithm -> HighNumberAlgorithm -> Bool
> :: HighNumberAlgorithm -> HighNumberAlgorithm -> Bool
$c> :: HighNumberAlgorithm -> HighNumberAlgorithm -> Bool
<= :: HighNumberAlgorithm -> HighNumberAlgorithm -> Bool
$c<= :: HighNumberAlgorithm -> HighNumberAlgorithm -> Bool
< :: HighNumberAlgorithm -> HighNumberAlgorithm -> Bool
$c< :: HighNumberAlgorithm -> HighNumberAlgorithm -> Bool
compare :: HighNumberAlgorithm -> HighNumberAlgorithm -> Ordering
$ccompare :: HighNumberAlgorithm -> HighNumberAlgorithm -> Ordering
$cp1Ord :: Eq HighNumberAlgorithm
Ord, ReadPrec [HighNumberAlgorithm]
ReadPrec HighNumberAlgorithm
Int -> ReadS HighNumberAlgorithm
ReadS [HighNumberAlgorithm]
(Int -> ReadS HighNumberAlgorithm)
-> ReadS [HighNumberAlgorithm]
-> ReadPrec HighNumberAlgorithm
-> ReadPrec [HighNumberAlgorithm]
-> Read HighNumberAlgorithm
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [HighNumberAlgorithm]
$creadListPrec :: ReadPrec [HighNumberAlgorithm]
readPrec :: ReadPrec HighNumberAlgorithm
$creadPrec :: ReadPrec HighNumberAlgorithm
readList :: ReadS [HighNumberAlgorithm]
$creadList :: ReadS [HighNumberAlgorithm]
readsPrec :: Int -> ReadS HighNumberAlgorithm
$creadsPrec :: Int -> ReadS HighNumberAlgorithm
Read, Int -> HighNumberAlgorithm -> ShowS
[HighNumberAlgorithm] -> ShowS
HighNumberAlgorithm -> String
(Int -> HighNumberAlgorithm -> ShowS)
-> (HighNumberAlgorithm -> String)
-> ([HighNumberAlgorithm] -> ShowS)
-> Show HighNumberAlgorithm
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HighNumberAlgorithm] -> ShowS
$cshowList :: [HighNumberAlgorithm] -> ShowS
show :: HighNumberAlgorithm -> String
$cshow :: HighNumberAlgorithm -> String
showsPrec :: Int -> HighNumberAlgorithm -> ShowS
$cshowsPrec :: Int -> HighNumberAlgorithm -> ShowS
Show)
instance NFData HighNumberAlgorithm
instance Arbitrary HighNumberAlgorithm where
arbitrary :: Gen HighNumberAlgorithm
arbitrary = [Gen HighNumberAlgorithm] -> Gen HighNumberAlgorithm
forall a. [Gen a] -> Gen a
oneof [Text -> HighNumberAlgorithm
ShortScale (Text -> HighNumberAlgorithm)
-> Gen Text -> Gen HighNumberAlgorithm
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Text
_genText, Text -> Text -> HighNumberAlgorithm
LongScale (Text -> Text -> HighNumberAlgorithm)
-> Gen Text -> Gen (Text -> HighNumberAlgorithm)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Text
_genText Gen (Text -> HighNumberAlgorithm)
-> Gen Text -> Gen HighNumberAlgorithm
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
_genText]
shrink :: HighNumberAlgorithm -> [HighNumberAlgorithm]
shrink (ShortScale Text
t) = Text -> HighNumberAlgorithm
ShortScale (Text -> HighNumberAlgorithm) -> [Text] -> [HighNumberAlgorithm]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [Text]
_shrinkText Text
t
shrink (LongScale Text
ta Text
tb) = ((Text -> Text -> HighNumberAlgorithm
`LongScale` Text
tb) (Text -> HighNumberAlgorithm) -> [Text] -> [HighNumberAlgorithm]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [Text]
_shrinkText Text
ta) [HighNumberAlgorithm]
-> [HighNumberAlgorithm] -> [HighNumberAlgorithm]
forall a. Semigroup a => a -> a -> a
<> (Text -> Text -> HighNumberAlgorithm
LongScale Text
ta (Text -> HighNumberAlgorithm) -> [Text] -> [HighNumberAlgorithm]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [Text]
_shrinkText Text
tb)
instance Default HighNumberAlgorithm where
def :: HighNumberAlgorithm
def = Text -> HighNumberAlgorithm
ShortScale Text
"illion"
shortScale :: Text -> FreeValueSplitter
shortScale :: Text -> forall i. Integral i => ValueSplitter i
shortScale = HighNumberAlgorithm -> ValueSplitter i
forall a.
ValueSplit a =>
a -> forall i. Integral i => ValueSplitter i
valueSplit (HighNumberAlgorithm -> ValueSplitter i)
-> (Text -> HighNumberAlgorithm) -> Text -> ValueSplitter i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> HighNumberAlgorithm
ShortScale
longScale :: Text -> Text -> FreeValueSplitter
longScale :: Text -> Text -> forall i. Integral i => ValueSplitter i
longScale Text
suf1 = HighNumberAlgorithm -> ValueSplitter i
forall a.
ValueSplit a =>
a -> forall i. Integral i => ValueSplitter i
valueSplit (HighNumberAlgorithm -> ValueSplitter i)
-> (Text -> HighNumberAlgorithm) -> Text -> ValueSplitter i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> HighNumberAlgorithm
LongScale Text
suf1
shortScaleTitle :: Text -> FreeValueSplitter
shortScaleTitle :: Text -> forall i. Integral i => ValueSplitter i
shortScaleTitle = (Text -> Text)
-> HighNumberAlgorithm -> forall i. Integral i => ValueSplitter i
valueSplit' Text -> Text
toTitle (HighNumberAlgorithm -> ValueSplitter i)
-> (Text -> HighNumberAlgorithm) -> Text -> ValueSplitter i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> HighNumberAlgorithm
ShortScale
longScaleTitle :: Text -> Text -> FreeValueSplitter
longScaleTitle :: Text -> Text -> forall i. Integral i => ValueSplitter i
longScaleTitle Text
suf1 = (Text -> Text)
-> HighNumberAlgorithm -> forall i. Integral i => ValueSplitter i
valueSplit' Text -> Text
toTitle (HighNumberAlgorithm -> ValueSplitter i)
-> (Text -> HighNumberAlgorithm) -> Text -> ValueSplitter i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> HighNumberAlgorithm
LongScale Text
suf1
_highWithSuffix :: Text -> Int -> Maybe Text
_highWithSuffix :: Text -> Int -> Maybe Text
_highWithSuffix Text
suf = (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
suf) (Maybe Text -> Maybe Text)
-> (Int -> Maybe Text) -> Int -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector Text
latinPrefixes Vector Text -> Int -> Maybe Text
forall a. Vector a -> Int -> Maybe a
!?)
_highToText :: HighNumberAlgorithm -> Int -> Maybe Text
_highToText :: HighNumberAlgorithm -> Int -> Maybe Text
_highToText (ShortScale Text
suf) Int
j = Text -> Int -> Maybe Text
_highWithSuffix Text
suf Int
j
_highToText (LongScale Text
suf1 Text
suf2) Int
j
| Int -> Bool
forall a. Integral a => a -> Bool
even Int
j = Text -> Int -> Maybe Text
_highWithSuffix Text
suf1 Int
k
| Bool
otherwise = Text -> Int -> Maybe Text
_highWithSuffix Text
suf2 Int
k
where k :: Int
k = Int -> Int -> Int
forall a. Integral a => a -> a -> a
div Int
j Int
2
valueSplit'
:: (Text -> Text)
-> HighNumberAlgorithm
-> FreeValueSplitter
valueSplit' :: (Text -> Text)
-> HighNumberAlgorithm -> forall i. Integral i => ValueSplitter i
valueSplit' Text -> Text
f HighNumberAlgorithm
vs i
i = (i
m,) (Text -> (i, Text)) -> (Text -> Text) -> Text -> (i, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
f (Text -> (i, Text)) -> Maybe Text -> Maybe (i, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HighNumberAlgorithm -> Int -> Maybe Text
_highToText HighNumberAlgorithm
vs (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2)
where ~(Int
j, i
m) = i -> (Int, i)
forall i j. (Integral i, Integral j) => i -> (j, i)
_toNumberScale i
i
instance ValueSplit HighNumberAlgorithm where
valueSplit :: HighNumberAlgorithm -> forall i. Integral i => ValueSplitter i
valueSplit = (Text -> Text)
-> HighNumberAlgorithm -> forall i. Integral i => ValueSplitter i
valueSplit' Text -> Text
forall a. a -> a
id
numeralsAlgorithm :: (Foldable f, Foldable g) => Text -> Text -> Text -> f Text -> g (Integer, Text) -> FreeValueSplitter -> FreeMergerFunction -> (Text -> Text) -> FreeNumberToWords -> ClockText -> NumeralsAlgorithm
numeralsAlgorithm :: Text
-> Text
-> Text
-> f Text
-> g (Integer, Text)
-> (forall i. Integral i => ValueSplitter i)
-> (forall i. Integral i => MergerFunction i)
-> (Text -> Text)
-> (forall i. Integral i => NumberToWords i)
-> ClockText
-> NumeralsAlgorithm
numeralsAlgorithm Text
minus Text
zero Text
one f Text
_lowWords g (Integer, Text)
_midWords = Text
-> Text
-> Vector Text
-> [(Integer, Text)]
-> (forall i. Integral i => ValueSplitter i)
-> (forall i. Integral i => MergerFunction i)
-> (Text -> Text)
-> (forall i. Integral i => NumberToWords i)
-> ClockText
-> NumeralsAlgorithm
NumeralsAlgorithm Text
minus Text
one ([Text] -> Vector Text
forall a. [a] -> Vector a
fromList (Text
zero Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text
one Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: f Text -> [Text]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f Text
_lowWords)) (((Integer, Text) -> Integer)
-> [(Integer, Text)] -> [(Integer, Text)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Integer -> Integer
forall a. Num a => a -> a
negate (Integer -> Integer)
-> ((Integer, Text) -> Integer) -> (Integer, Text) -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer, Text) -> Integer
forall a b. (a, b) -> a
fst) (g (Integer, Text) -> [(Integer, Text)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList g (Integer, Text)
_midWords))
_maybeSegment :: Integral i => (i -> NumberSegment i) -> i -> MNumberSegment i
_maybeSegment :: (i -> NumberSegment i) -> i -> MNumberSegment i
_maybeSegment i -> NumberSegment i
f = i -> MNumberSegment i
go
where go :: i -> MNumberSegment i
go i
0 = MNumberSegment i
forall a. Maybe a
Nothing
go i
i = NumberSegment i -> MNumberSegment i
forall a. a -> Maybe a
Just (i -> NumberSegment i
f i
i)
toSegmentLow :: Integral i
=> Vector Text
-> NumberSegmenting i
toSegmentLow :: Vector Text -> NumberSegmenting i
toSegmentLow Vector Text
vs = NumberSegmenting i
go
where go :: NumberSegmenting i
go i
i | i
i i -> i -> Bool
forall a. Ord a => a -> a -> Bool
>= i
nvs = MNumberSegment i
-> i -> Text -> MNumberSegment i -> NumberSegment i
forall i.
MNumberSegment i
-> i -> Text -> MNumberSegment i -> NumberSegment i
NumberSegment (NumberSegment i -> MNumberSegment i
forall a. a -> Maybe a
Just (NumberSegmenting i
go i
dv)) i
nvs Text
lv (i -> MNumberSegment i
tl i
md)
| Bool
otherwise = MNumberSegment i
-> i -> Text -> MNumberSegment i -> NumberSegment i
forall i.
MNumberSegment i
-> i -> Text -> MNumberSegment i -> NumberSegment i
NumberSegment MNumberSegment i
forall a. Maybe a
Nothing i
i (Vector Text
vs Vector Text -> Int -> Text
forall a. Vector a -> Int -> a
! i -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral i
i) MNumberSegment i
forall a. Maybe a
Nothing
where (i
dv, i
md) = i -> i -> (i, i)
forall a. Integral a => a -> a -> (a, a)
divMod i
i i
nvs
lv :: Text
lv = Vector Text -> Text
forall a. Vector a -> a
V.last Vector Text
vs
nvs :: i
nvs = Int -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Text -> Int
forall a. Vector a -> Int
V.length Vector Text
vs) i -> i -> i
forall a. Num a => a -> a -> a
- i
1
tl :: i -> MNumberSegment i
tl = NumberSegmenting i -> i -> MNumberSegment i
forall i.
Integral i =>
(i -> NumberSegment i) -> i -> MNumberSegment i
_maybeSegment NumberSegmenting i
go
_splitRecurse :: Integral i => (i -> NumberSegment i) -> (i -> NumberSegment i) -> i -> Text -> i -> NumberSegment i
_splitRecurse :: (i -> NumberSegment i)
-> (i -> NumberSegment i) -> i -> Text -> i -> NumberSegment i
_splitRecurse i -> NumberSegment i
f i -> NumberSegment i
g i
im Text
v i
j = MNumberSegment i
-> i -> Text -> MNumberSegment i -> NumberSegment i
forall i.
MNumberSegment i
-> i -> Text -> MNumberSegment i -> NumberSegment i
NumberSegment MNumberSegment i
hd i
im Text
v ((i -> NumberSegment i) -> i -> MNumberSegment i
forall i.
Integral i =>
(i -> NumberSegment i) -> i -> MNumberSegment i
_maybeSegment i -> NumberSegment i
g i
md)
where hd :: MNumberSegment i
hd | i
dv i -> i -> Bool
forall a. Eq a => a -> a -> Bool
== i
1 = MNumberSegment i
forall a. Maybe a
Nothing
| Bool
otherwise = NumberSegment i -> MNumberSegment i
forall a. a -> Maybe a
Just (i -> NumberSegment i
f i
dv)
~(i
dv, i
md) = i -> i -> (i, i)
forall a. Integral a => a -> a -> (a, a)
divMod i
j i
im
toSegmentMid :: Integral i
=> Vector Text
-> [(Integer, Text)]
-> NumberSegmenting i
toSegmentMid :: Vector Text -> [(Integer, Text)] -> NumberSegmenting i
toSegmentMid Vector Text
lows = [(Integer, Text)] -> NumberSegmenting i
forall i a.
(Integral i, Integral a) =>
[(a, Text)] -> i -> NumberSegment i
go
where go :: [(a, Text)] -> i -> NumberSegment i
go [] i
n = Vector Text -> i -> NumberSegment i
forall i. Integral i => Vector Text -> NumberSegmenting i
toSegmentLow Vector Text
lows i
n
go ma :: [(a, Text)]
ma@((a
m, Text
v) : [(a, Text)]
ms) i
n
| i
im i -> i -> Bool
forall a. Ord a => a -> a -> Bool
> i
n = i -> NumberSegment i
goms i
n
| Bool
otherwise = (i -> NumberSegment i)
-> (i -> NumberSegment i) -> i -> Text -> i -> NumberSegment i
forall i.
Integral i =>
(i -> NumberSegment i)
-> (i -> NumberSegment i) -> i -> Text -> i -> NumberSegment i
_splitRecurse ([(a, Text)] -> i -> NumberSegment i
go [(a, Text)]
ma) i -> NumberSegment i
goms i
im Text
v i
n
where im :: i
im = a -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
m
goms :: i -> NumberSegment i
goms = [(a, Text)] -> i -> NumberSegment i
go [(a, Text)]
ms
toSegmentHigh :: Integral i
=> Vector Text
-> [(Integer, Text)]
-> ValueSplitter i
-> NumberSegmenting i
toSegmentHigh :: Vector Text
-> [(Integer, Text)] -> ValueSplitter i -> NumberSegmenting i
toSegmentHigh Vector Text
lows [(Integer, Text)]
mids ValueSplitter i
highs = NumberSegmenting i
go
where go :: NumberSegmenting i
go i
v | Just (i
i, Text
t) <- ValueSplitter i
highs i
v = NumberSegmenting i
-> NumberSegmenting i -> i -> Text -> NumberSegmenting i
forall i.
Integral i =>
(i -> NumberSegment i)
-> (i -> NumberSegment i) -> i -> Text -> i -> NumberSegment i
_splitRecurse NumberSegmenting i
go NumberSegmenting i
go i
i Text
t i
v
| Bool
otherwise = Vector Text -> [(Integer, Text)] -> NumberSegmenting i
forall i.
Integral i =>
Vector Text -> [(Integer, Text)] -> NumberSegmenting i
toSegmentMid Vector Text
lows [(Integer, Text)]
mids i
v
toSegments :: Integral i
=> Vector Text
-> [(Integer, Text)]
-> ValueSplitter i
-> NumberSegmenting i
toSegments :: Vector Text
-> [(Integer, Text)] -> ValueSplitter i -> NumberSegmenting i
toSegments = Vector Text
-> [(Integer, Text)] -> ValueSplitter i -> NumberSegmenting i
forall i.
Integral i =>
Vector Text
-> [(Integer, Text)] -> ValueSplitter i -> NumberSegmenting i
toSegmentHigh
compressSegments :: Integral i
=> Text
-> MergerFunction i
-> NumberSegment i
-> Text
compressSegments :: Text -> MergerFunction i -> NumberSegment i -> Text
compressSegments Text
one' MergerFunction i
merger = (i, Text) -> Text
forall a b. (a, b) -> b
snd ((i, Text) -> Text)
-> (NumberSegment i -> (i, Text)) -> NumberSegment i -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NumberSegment i -> (i, Text)
go
where go :: NumberSegment i -> (i, Text)
go (NumberSegment MNumberSegment i
dv' i
i Text
t MNumberSegment i
md') = MNumberSegment i -> (i, Text) -> (i, Text)
_mergeTail MNumberSegment i
md' (i
dvi i -> i -> i
forall a. Num a => a -> a -> a
* i
i, MergerFunction i
merger i
dvi i
i Text
dv Text
t)
where (i
dvi, Text
dv) = MNumberSegment i -> (i, Text)
_unwrap MNumberSegment i
dv'
_unwrap :: MNumberSegment i -> (i, Text)
_unwrap = (i, Text)
-> (NumberSegment i -> (i, Text)) -> MNumberSegment i -> (i, Text)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (i
1, Text
one') NumberSegment i -> (i, Text)
go
_mergeTail :: MNumberSegment i -> (i, Text) -> (i, Text)
_mergeTail MNumberSegment i
Nothing (i, Text)
r = (i, Text)
r
_mergeTail (Just NumberSegment i
md') (i
vi, Text
v) = (i
vi i -> i -> i
forall a. Num a => a -> a -> a
+ i
mdi, MergerFunction i
merger i
vi i
mdi Text
v Text
md)
where (i
mdi, Text
md) = NumberSegment i -> (i, Text)
go NumberSegment i
md'