{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE 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 (Half, OClock, Past, PastHalf, QuarterPast, QuarterTo, To, ToHalf), ClockText, DayPart (Afternoon, Evening, Morning, Night), DaySegment (dayHour, dayPart), hourCorrection, toCardinal, valueSplit)
import Text.Numerals.Internal (_div10, _mergeWith, _mergeWithHyphen, _mergeWithSpace, _rem10, _showIntegral)

_ordinizepp :: Text -> Text
_ordinizepp :: Text -> Text
_ordinizepp Text
t
  | Text
"y" Text -> Text -> Bool
`isSuffixOf` Text
t = HasCallStack => Text -> Text
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 ::
  -- | A 'NumeralsAlgorithm' that can be used to convert numbers to different formats.
  NumeralsAlgorithm
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') i -> i -> Text -> Text -> Text
FreeMergerFunction
merge' Text -> Text
ordinize' i -> Text
FreeNumberToWords
shortOrdinal' ClockText
clockText'

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

-- | Convert numers to their cardinal counterpart in /English/.
toCardinal' ::
  Integral i =>
  -- | The number to convert to text.
  i ->
  -- | The cardinal counterpart in /English/.
  Text
toCardinal' :: FreeNumberToWords
toCardinal' = NumeralsAlgorithm -> i -> Text
forall i. Integral i => 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)
Text
"two",
    Item (Vector Text)
Text
"three",
    Item (Vector Text)
Text
"four",
    Item (Vector Text)
Text
"five",
    Item (Vector Text)
Text
"six",
    Item (Vector Text)
Text
"seven",
    Item (Vector Text)
Text
"eight",
    Item (Vector Text)
Text
"nine",
    Item (Vector Text)
Text
"ten",
    Item (Vector Text)
Text
"eleven",
    Item (Vector Text)
Text
"twelve",
    Item (Vector Text)
Text
"thirteen",
    Item (Vector Text)
Text
"fourteen",
    Item (Vector Text)
Text
"fifteen",
    Item (Vector Text)
Text
"sixteen",
    Item (Vector Text)
Text
"seventeen",
    Item (Vector Text)
Text
"eighteen",
    Item (Vector Text)
Text
"nineteen",
    Item (Vector Text)
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' :: FreeMergerFunction
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 =>
  -- | The number to convert to /short ordinal/ form.
  i ->
  -- | The equivalent 'Text' specifying the number in /short ordinal/ form.
  Text
shortOrdinal' :: FreeNumberToWords
shortOrdinal' i
i = String -> Text
pack (i -> String -> String
forall i. Integral i => i -> String -> String
_showIntegral i
i (i -> String
forall {a} {a}. (Integral a, IsString a) => a -> a
_shortOrdinalSuffix i
i))
  where
    _shortOrdinalSuffix :: a -> a
_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 = a
"th"
      | Bool
otherwise = a -> a
forall {a} {a}. (Eq a, Num a, IsString a) => a -> a
go' (a -> a
forall i. Integral i => i -> i
_rem10 a
n)
    go' :: a -> a
go' a
1 = a
"st"
    go' a
2 = a
"nd"
    go' a
3 = a
"rd"
    go' a
_ = a
"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