{-# LANGUAGE CPP, OverloadedLists, OverloadedStrings, TemplateHaskell #-}

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

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

module Text.Numerals.Languages.French (
    -- * Num to word algorithm
    french
    -- * 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

#if __GLASGOW_HASKELL__ < 803
import Data.Semigroup((<>))
#endif
import Data.Text(Text, isSuffixOf, pack, snoc)
import Data.Vector(Vector)

import Text.Numerals.Algorithm(HighNumberAlgorithm(LongScale), NumeralsAlgorithm, numeralsAlgorithm)
import Text.Numerals.Algorithm.Template(ordinizeFromDict)
import Text.Numerals.Class(ClockSegment(OClock, QuarterPast, Half, QuarterTo), DayPart(Night, Morning, Afternoon, Evening), DaySegment(dayPart, dayHour), ClockText, FreeMergerFunction, valueSplit, toCardinal)
import Text.Numerals.Internal(_divisable100, _mergeWith, _mergeWithSpace, _mergeWithHyphen, _million, _pluralize', _showIntegral, _stripLastIf, _thousand)

$(pure (ordinizeFromDict "_ordinize'" [
    ("cinq", "cinqu")
  , ("neuf", "neuv")
  ] 'id))

-- | A 'NumeralsAlgorithm' to convert numbers to words in the /French/ language.
french :: NumeralsAlgorithm  -- ^ A 'NumeralsAlgorithm' that can be used to convert numbers to different formats.
french :: NumeralsAlgorithm
french = 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'

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

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

-- | The word used for the number /zero/ in the /French/ language.
zeroWord' :: Text
zeroWord' :: Text
zeroWord' = Text
"zéro"

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

-- | A 'Vector' that contains the word used for the numbers /two/ to /twenty/ in the /French/ language.
lowWords' :: Vector Text
lowWords' :: Vector Text
lowWords' = [
    Item (Vector Text)
"deux"
  , Item (Vector Text)
"trois"
  , Item (Vector Text)
"quatre"
  , Item (Vector Text)
"cinq"
  , Item (Vector Text)
"six"
  , Item (Vector Text)
"sept"
  , Item (Vector Text)
"huit"
  , Item (Vector Text)
"neuf"
  , Item (Vector Text)
"dix"
  , Item (Vector Text)
"onze"
  , Item (Vector Text)
"douze"
  , Item (Vector Text)
"treize"
  , Item (Vector Text)
"quatorze"
  , Item (Vector Text)
"quinze"
  , Item (Vector Text)
"seize"
  , Item (Vector Text)
"dix-sept"
  , Item (Vector Text)
"dix-huit"
  , Item (Vector Text)
"dix-neuf"
  , Item (Vector Text)
"vingt"
  ]

-- | A list of 2-tuples that contains the names of values between /thirty/ and
-- /thousand/ in the /French/ language.
midWords' :: [(Integer, Text)]
midWords' :: [(Integer, Text)]
midWords' = [
    (Integer
1000, Text
"mille")
  , (Integer
100, Text
"cent")
  , (Integer
80, Text
"quatre-vingts")
  , (Integer
60, Text
"soixante")
  , (Integer
50, Text
"cinquante")
  , (Integer
40, Text
"quarante")
  , (Integer
30, Text
"trente")
  ]

-- | A merge function that is used to combine the names of words together to
-- larger words, according to the /French/ grammar rules.
merge' :: FreeMergerFunction
merge' :: MergerFunction i
merge' i
1 i
r | i
r i -> i -> Bool
forall a. Ord a => a -> a -> Bool
< i
forall i. Integral i => i
_million = (Text -> Text) -> Text -> Text -> Text
forall a b. a -> b -> a
const Text -> Text
forall a. a -> a
id
           | Bool
otherwise = MergerFunction i
FreeMergerFunction
_merge' i
1 i
r
merge' i
l i
r = \Text
ta Text
tb -> MergerFunction i
FreeMergerFunction
_merge' i
l i
r (i -> i -> Text -> Text
forall i. Integral i => i -> i -> Text -> Text
_firstWithoutS i
l i
r Text
ta) (i -> i -> Text -> Text
forall i. Integral i => i -> i -> Text -> Text
_secondWithS i
l i
r Text
tb)

_firstWithoutS :: Integral i => i -> i -> Text -> Text
_firstWithoutS :: i -> i -> Text -> Text
_firstWithoutS i
l i
r Text
t
    | (i -> Bool
forall i. Integral i => i -> Bool
_divisable100 (i
l i -> i -> i
forall a. Num a => a -> a -> a
+ i
20) Bool -> Bool -> Bool
|| (i -> Bool
forall i. Integral i => i -> Bool
_divisable100 i
l Bool -> Bool -> Bool
&& i
l i -> i -> Bool
forall a. Ord a => a -> a -> Bool
< i
forall i. Integral i => i
_thousand)) Bool -> Bool -> Bool
&& i
r i -> i -> Bool
forall a. Ord a => a -> a -> Bool
< i
forall i. Integral i => i
_million = Char -> Text -> Text
_stripLastIf Char
's' Text
t
    | Bool
otherwise = Text
t

_secondWithS :: Integral i => i -> i -> Text -> Text
_secondWithS :: i -> i -> Text -> Text
_secondWithS i
l i
r Text
t
    | i
l i -> i -> Bool
forall a. Ord a => a -> a -> Bool
< i
forall i. Integral i => i
_thousand Bool -> Bool -> Bool
&& i
r i -> i -> Bool
forall a. Eq a => a -> a -> Bool
/= i
forall i. Integral i => i
_thousand Bool -> Bool -> Bool
&& i -> Bool
forall i. Integral i => i -> Bool
_divisable100 i
r Bool -> Bool -> Bool
&& Bool -> Bool
not (Text
"s" Text -> Text -> Bool
`isSuffixOf` Text
t) = Text -> Char -> Text
snoc Text
t Char
's'
    | Bool
otherwise = Text
t

_merge' :: Integral i => i -> i -> Text -> Text -> Text
_merge' :: i -> i -> Text -> Text -> Text
_merge' i
l i
r | i
r 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
100 = Text -> Text -> Text
_mergeWithSpace
            | i
r i -> i -> i
forall a. Integral a => a -> a -> a
`mod` i
10 i -> i -> Bool
forall a. Eq a => a -> a -> Bool
== i
1 Bool -> Bool -> Bool
&& i
l i -> i -> Bool
forall a. Eq a => a -> a -> Bool
/= i
80 = Text -> Text -> Text -> Text
_mergeWith Text
" et "
            | Bool
otherwise = Text -> Text -> Text
_mergeWithHyphen

-- | A function that converts a number in words in /cardinal/ form to /ordinal/
-- form according to the /French/ language rules.
ordinize' :: Text -> Text
ordinize' :: Text -> Text
ordinize' Text
"un" = Text
"premier"
ordinize' Text
t = Char -> Text -> Text
_stripLastIf Char
'e' (Text -> Text
_ordinize' Text
t) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"ième"

-- | An algorithm to obtain the names of /large/ numbers (one million or larger)
-- in /French/. French uses a /long scale/ with the @illion@ and @illiard@
-- suffixes.
highWords' :: HighNumberAlgorithm
highWords' :: HighNumberAlgorithm
highWords' =  Text -> Text -> HighNumberAlgorithm
LongScale Text
"illion" Text
"illiard"

-- | A function to convert a number to its /short ordinal/ form in /French/.
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' = String -> Text
pack (String -> Text) -> (i -> String) -> i -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i -> String -> String
forall i. Integral i => i -> String -> String
`_showIntegral` String
"e")

_dayPartText :: DayPart -> Text
_dayPartText :: DayPart -> Text
_dayPartText DayPart
Night = Text
" de la nuit"
_dayPartText DayPart
Morning = Text
" du matin"
_dayPartText DayPart
Afternoon = Text
" de l'après-midi"
_dayPartText DayPart
Evening = Text
" du soir"

_heures :: Text -> Int -> DaySegment -> Text
_heures :: Text -> Int -> DaySegment -> Text
_heures Text
sep Int
dh DaySegment
ds = Int -> Text
FreeNumberToWords
toCardinal' Int
h Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Int -> Text
forall a. a -> a -> Int -> a
_pluralize' Text
"e heure" Text
" heures" Int
h 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
ds)
    where h :: Int
h = DaySegment -> Int
dayHour DaySegment
ds Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dh

-- | Converting the time to a text that describes that time in /French/.
clockText' :: ClockText
clockText' :: ClockText
clockText' ClockSegment
_ DaySegment
_ Int
0 Int
0 = Text
"minuit"
clockText' ClockSegment
_ DaySegment
_ Int
12 Int
0 = Text
"midi"
clockText' ClockSegment
OClock DaySegment
ds Int
_ Int
_ = Text -> Int -> DaySegment -> Text
_heures Text
"" Int
0 DaySegment
ds
clockText' ClockSegment
QuarterPast DaySegment
ds Int
_ Int
_ = Text -> Int -> DaySegment -> Text
_heures Text
" et quart" Int
0 DaySegment
ds
clockText' ClockSegment
Half DaySegment
ds Int
_ Int
_ = Text -> Int -> DaySegment -> Text
_heures Text
" et demie" Int
0 DaySegment
ds
clockText' ClockSegment
QuarterTo DaySegment
ds Int
_ Int
_ = Text -> Int -> DaySegment -> Text
_heures Text
" moins le quart" Int
1 DaySegment
ds
clockText' ClockSegment
_ DaySegment
ds Int
_ Int
m
    | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
30 = Text -> Int -> DaySegment -> Text
_heures (Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
FreeNumberToWords
toCardinal' Int
m) Int
0 DaySegment
ds
    | Bool
otherwise = Text -> Int -> DaySegment -> Text
_heures (Text
" moins " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
FreeNumberToWords
toCardinal' (Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
m)) Int
1 DaySegment
ds