{-# LANGUAGE CPP, OverloadedLists, OverloadedStrings, TemplateHaskell #-}
{-# OPTIONS_GHC -Wno-orphans #-}

{-|
Module      : Text.Numerals.Languages.English
Description : A module to convert numbers to words in the /English/ language.
Maintainer  : hapytexeu+gh@gmail.com
Stability   : experimental
Portability : POSIX

This module contains logic to convert numbers to words in the /English/ language.
-}

module Text.Numerals.Languages.English (
    -- * Num to word algorithm
    english
    -- * Convert a cardinal number to text
  , toCardinal'
    -- * Convert to ordinal
  , ordinize'
    -- * Constant words
  , negativeWord', zeroWord', oneWord'
    -- * Names for numbers
  , lowWords', midWords', highWords'
    -- * Merge function
  , merge'
  ) where

import Data.Default.Class(Default(def))
#if __GLASGOW_HASKELL__ < 803
import Data.Semigroup((<>))
#endif
import Data.Text(Text, isSuffixOf, pack)
import qualified Data.Text as T
import Data.Vector(Vector)

import Text.Numerals.Algorithm(HighNumberAlgorithm, NumeralsAlgorithm, numeralsAlgorithm)
import Text.Numerals.Algorithm.Template(ordinizeFromDict)
import Text.Numerals.Class(ClockSegment(OClock, Past, QuarterPast, ToHalf, Half, PastHalf, QuarterTo, To), DayPart(Night, Morning, Afternoon, Evening), DaySegment(dayPart, dayHour), ClockText, hourCorrection, valueSplit, toCardinal)
import Text.Numerals.Internal(_div10, _mergeWith, _mergeWithSpace, _mergeWithHyphen, _rem10, _showIntegral)

_ordinizepp :: Text -> Text
_ordinizepp :: Text -> Text
_ordinizepp Text
t
    | Text
"y" Text -> Text -> Bool
`isSuffixOf` Text
t = Text -> Text
T.init Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"ieth"
    | Bool
otherwise = Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"th"

-- | A function that converts a number in words in /cardinal/ form to /ordinal/
-- form according to the /English/ language rules.
$(pure (ordinizeFromDict "ordinize'" [
    ("one", "first")
  , ("two", "second")
  , ("three", "third")
  , ("four", "fourth")
  , ("five", "fifth")
  , ("six", "sixth")
  , ("seven", "seventh")
  , ("eight", "eighth")
  , ("nine", "ninth")
  , ("ten", "tenth")
  , ("eleven", "eleventh")
  , ("twelve", "twelfth")
  ] '_ordinizepp))

-- | A 'NumeralsAlgorithm' to convert numbers to words in the /English/ language.
english :: NumeralsAlgorithm  -- ^ A 'NumeralsAlgorithm' that can be used to convert numbers to different formats.
english :: NumeralsAlgorithm
english = Text
-> Text
-> Text
-> Vector Text
-> [(Integer, Text)]
-> FreeValueSplitter
-> FreeMergerFunction
-> (Text -> Text)
-> FreeNumberToWords
-> ClockText
-> NumeralsAlgorithm
forall (f :: * -> *) (g :: * -> *).
(Foldable f, Foldable g) =>
Text
-> Text
-> Text
-> f Text
-> g (Integer, Text)
-> FreeValueSplitter
-> FreeMergerFunction
-> (Text -> Text)
-> FreeNumberToWords
-> ClockText
-> NumeralsAlgorithm
numeralsAlgorithm Text
negativeWord' Text
zeroWord' Text
oneWord' Vector Text
lowWords' [(Integer, Text)]
midWords' (HighNumberAlgorithm -> FreeValueSplitter
forall a. ValueSplit a => a -> FreeValueSplitter
valueSplit HighNumberAlgorithm
highWords') FreeMergerFunction
merge' Text -> Text
ordinize' FreeNumberToWords
shortOrdinal' ClockText
clockText'

instance Default NumeralsAlgorithm where
  def :: NumeralsAlgorithm
def = NumeralsAlgorithm
english

-- | Convert numers to their cardinal counterpart in /English/.
toCardinal' :: Integral i
  => i  -- ^ The number to convert to text.
  -> Text  -- ^ The cardinal counterpart in /English/.
toCardinal' :: i -> Text
toCardinal' = NumeralsAlgorithm -> i -> Text
forall a i. (NumToWord a, Integral i) => a -> i -> Text
toCardinal NumeralsAlgorithm
english

-- | The words used to mark a negative number in the /English/ language.
negativeWord' :: Text
negativeWord' :: Text
negativeWord' = Text
"minus"

-- | The word used for the number /zero/ in the /English/ language.
zeroWord' :: Text
zeroWord' :: Text
zeroWord' = Text
"zero"

-- | The word used for the number /one/ in the /English/ language.
oneWord' :: Text
oneWord' :: Text
oneWord' = Text
"one"

-- | A 'Vector' that contains the word used for the numbers /two/ to /twenty/ in the /English/ language.
lowWords' :: Vector Text
lowWords' :: Vector Text
lowWords' = [
    Item (Vector Text)
"two"
  , Item (Vector Text)
"three"
  , Item (Vector Text)
"four"
  , Item (Vector Text)
"five"
  , Item (Vector Text)
"six"
  , Item (Vector Text)
"seven"
  , Item (Vector Text)
"eight"
  , Item (Vector Text)
"nine"
  , Item (Vector Text)
"ten"
  , Item (Vector Text)
"eleven"
  , Item (Vector Text)
"twelve"
  , Item (Vector Text)
"thirteen"
  , Item (Vector Text)
"fourteen"
  , Item (Vector Text)
"fifteen"
  , Item (Vector Text)
"sixteen"
  , Item (Vector Text)
"seventeen"
  , Item (Vector Text)
"eighteen"
  , Item (Vector Text)
"nineteen"
  , Item (Vector Text)
"twenty"
  ]

-- | A list of 2-tuples that contains the names of values between /thirty/ and
-- /thousand/ in the /English/ language.
midWords' :: [(Integer, Text)]
midWords' :: [(Integer, Text)]
midWords' = [
    (Integer
1000, Text
"thousand")
  , (Integer
100, Text
"hundred")
  , (Integer
90, Text
"ninety")
  , (Integer
80, Text
"eighty")
  , (Integer
70, Text
"seventy")
  , (Integer
60, Text
"sixty")
  , (Integer
50, Text
"fifty")
  , (Integer
40, Text
"forty")
  , (Integer
30, Text
"thirty")
  ]

-- | A merge function that is used to combine the names of words together to
-- larger words, according to the /English/ grammar rules.
merge' :: Integral i => i -> i -> Text -> Text -> Text
merge' :: i -> i -> Text -> Text -> Text
merge' i
1 i
r | i
r i -> i -> Bool
forall a. Ord a => a -> a -> Bool
< i
100 = (Text -> Text) -> Text -> Text -> Text
forall a b. a -> b -> a
const Text -> Text
forall a. a -> a
id
merge' i
l i
r | i
100 i -> i -> Bool
forall a. Ord a => a -> a -> Bool
> i
l Bool -> Bool -> Bool
&& i
l i -> i -> Bool
forall a. Ord a => a -> a -> Bool
> i
r = Text -> Text -> Text
_mergeWithHyphen
           | i
l i -> i -> Bool
forall a. Ord a => a -> a -> Bool
>= i
100 Bool -> Bool -> Bool
&& i
100 i -> i -> Bool
forall a. Ord a => a -> a -> Bool
> i
r = Text -> Text -> Text -> Text
_mergeWith Text
" and "
           | i
r i -> i -> Bool
forall a. Ord a => a -> a -> Bool
> i
l = Text -> Text -> Text
_mergeWithSpace
merge' i
_ i
_ = Text -> Text -> Text -> Text
_mergeWith Text
", "

-- | An algorithm to obtain the names of /large/ numbers (one million or larger)
-- in /English/. English uses a /short scale/ with the @illion@ suffix.
highWords' :: HighNumberAlgorithm
highWords' :: HighNumberAlgorithm
highWords' = HighNumberAlgorithm
forall a. Default a => a
def

-- | A function to convert a number to its /short ordinal/ form in /English/.
shortOrdinal' :: Integral i
  => i  -- ^ The number to convert to /short ordinal/ form.
  -> Text  -- ^ The equivalent 'Text' specifying the number in /short ordinal/ form.
shortOrdinal' :: i -> Text
shortOrdinal' i
i = String -> Text
pack (i -> String -> String
forall i. Integral i => i -> String -> String
_showIntegral i
i (i -> String
forall a p. (Integral a, IsString p) => a -> p
_shortOrdinalSuffix i
i))
    where _shortOrdinalSuffix :: a -> p
_shortOrdinalSuffix a
n
              | a -> a
forall i. Integral i => i -> i
_rem10 (a -> a
forall i. Integral i => i -> i
_div10 a
n) a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
1 = p
"th"
              | Bool
otherwise = a -> p
forall a p. (Eq a, Num a, IsString p) => a -> p
go' (a -> a
forall i. Integral i => i -> i
_rem10 a
n)
          go' :: a -> p
go' a
1 = p
"st"
          go' a
2 = p
"nd"
          go' a
3 = p
"rd"
          go' a
_ = p
"th"

_dayPartText :: DayPart -> Text
_dayPartText :: DayPart -> Text
_dayPartText DayPart
Night = Text
"at night"
_dayPartText DayPart
Morning = Text
"in the morning"
_dayPartText DayPart
Afternoon = Text
"in the afternoon"
_dayPartText DayPart
Evening = Text
"in the evening"

_dayComponent :: Text -> Int -> DaySegment -> Text
_dayComponent :: Text -> Int -> DaySegment -> Text
_dayComponent Text
sep Int
dh DaySegment
h = Int -> Text
FreeNumberToWords
toCardinal' (Int -> Int
hourCorrection (DaySegment -> Int
dayHour DaySegment
h Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dh)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
sep Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> DayPart -> Text
_dayPartText (DaySegment -> DayPart
dayPart DaySegment
h)

_dayComponent' :: Int -> DaySegment -> Text
_dayComponent' :: Int -> DaySegment -> Text
_dayComponent' = Text -> Int -> DaySegment -> Text
_dayComponent Text
" "

-- | Converting the time to a text that describes that time in /English/.
clockText' :: ClockText
clockText' :: ClockText
clockText' ClockSegment
OClock DaySegment
ds Int
_ Int
_ = Text -> Int -> DaySegment -> Text
_dayComponent Text
" o'clock " Int
0 DaySegment
ds
clockText' (Past Int
m) DaySegment
ds Int
_ Int
_ = Int -> Text
FreeNumberToWords
toCardinal' Int
m Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" past " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> DaySegment -> Text
_dayComponent' Int
0 DaySegment
ds
clockText' ClockSegment
QuarterPast DaySegment
ds Int
_ Int
_ = Text
"quarter past "  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> DaySegment -> Text
_dayComponent' Int
0 DaySegment
ds
clockText' (ToHalf Int
_) DaySegment
ds Int
_ Int
m = Int -> Text
FreeNumberToWords
toCardinal' Int
m Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" past " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> DaySegment -> Text
_dayComponent' Int
0 DaySegment
ds
clockText' ClockSegment
Half DaySegment
ds Int
_ Int
_ = Text
"half past " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> DaySegment -> Text
_dayComponent' Int
0 DaySegment
ds
clockText' (PastHalf Int
_) DaySegment
ds Int
_ Int
m = Int -> Text
FreeNumberToWords
toCardinal' (Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
m) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> DaySegment -> Text
_dayComponent' Int
1 DaySegment
ds
clockText' ClockSegment
QuarterTo DaySegment
ds Int
_ Int
_ = Text
"quarter to "  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> DaySegment -> Text
_dayComponent' Int
1 DaySegment
ds
clockText' (To Int
m) DaySegment
ds Int
_ Int
_ = Int -> Text
FreeNumberToWords
toCardinal' Int
m Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> DaySegment -> Text
_dayComponent' Int
1 DaySegment
ds