French.hs

{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE 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 (Half, OClock, QuarterPast, QuarterTo), ClockText, DayPart (Afternoon, Evening, Morning, Night), DaySegment (dayHour, dayPart), FreeMergerFunction, toCardinal, valueSplit)
import Text.Numerals.Internal (_divisable100, _mergeWith, _mergeWithHyphen, _mergeWithSpace, _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 ::
  -- | A 'NumeralsAlgorithm' that can be used to convert numbers to different formats.
  NumeralsAlgorithm
french = numeralsAlgorithm negativeWord' zeroWord' oneWord' lowWords' midWords' (valueSplit highWords') merge' ordinize' shortOrdinal' clockText'

-- | Convert numers to their cardinal counterpart in /French/.
toCardinal' ::
  Integral i =>
  -- | The number to convert to text.
  i ->
  -- | The cardinal counterpart in /French/.
  Text
toCardinal' = toCardinal french

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

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

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

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

-- | A list of 2-tuples that contains the names of values between /thirty/ and
-- /thousand/ in the /French/ language.
midWords' :: [(Integer, Text)]
midWords' =
  [ (1000, "mille"),
    (100, "cent"),
    (80, "quatre-vingts"),
    (60, "soixante"),
    (50, "cinquante"),
    (40, "quarante"),
    (30, "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' 1 r
  | r < _million = const id
  | otherwise = _merge' 1 r
merge' l r = \ta tb -> _merge' l r (_firstWithoutS l r ta) (_secondWithS l r tb)

_firstWithoutS :: Integral i => i -> i -> Text -> Text
_firstWithoutS l r t
  | (_divisable100 (l + 20) || (_divisable100 l && l < _thousand)) && r < _million = _stripLastIf 's' t
  | otherwise = t

_secondWithS :: Integral i => i -> i -> Text -> Text
_secondWithS l r t
  | l < _thousand && r /= _thousand && _divisable100 r && not ("s" `isSuffixOf` t) = snoc t 's'
  | otherwise = t

_merge' :: Integral i => i -> i -> Text -> Text -> Text
_merge' l r
  | r >= l || l >= 100 = _mergeWithSpace
  | r `mod` 10 == 1 && l /= 80 = _mergeWith " et "
  | otherwise = _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' "un" = "premier"
ordinize' t = _stripLastIf 'e' (_ordinize' t) <> "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' = LongScale "illion" "illiard"

-- | A function to convert a number to its /short ordinal/ form in /French/.
shortOrdinal' ::
  Integral i =>
  -- | The number to convert to /short ordinal/ form.
  i ->
  -- | The equivalent 'Text' specifying the number in /short ordinal/ form.
  Text
shortOrdinal' = pack . (`_showIntegral` "e")

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

_heures :: Text -> Int -> DaySegment -> Text
_heures sep dh ds = toCardinal' h <> _pluralize' "e heure" " heures" h <> sep <> _dayPartText (dayPart ds)
  where
    h = dayHour ds + dh

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