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

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

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

module Text.Numerals.Languages.Dutch (
    -- * Num to word algorithm
    dutch
    -- * 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, 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, Past, QuarterPast, ToHalf, Half, PastHalf, QuarterTo, To), DayPart(Night, Morning, Afternoon, Evening), DaySegment(dayPart, dayHour), ClockText, hourCorrection, toCardinal, valueSplit)
import Text.Numerals.Internal(_million, _mergeWithSpace, _pluralize', _showIntegral)

$(pure (ordinizeFromDict "_ordinize'" [
    ("nul", "nuld")
  , ("één", "eerst")
  , ("twee", "tweed")
  , ("drie", "derd")
  , ("vier", "vierd")
  , ("vijf", "vijfd")
  , ("zes", "zesd")
  , ("zeven", "zevend")
  , ("acht", "achtst")
  , ("negen", "negend")
  , ("tien", "tiend")
  , ("elf", "elfd")
  , ("twaalf", "twaalfd")
  , ("ig", "igst")
  , ("erd", "erdst")
  , ("end", "endst")
  , ("joen", "joenst")
  , ("rd", "rdst")
  ] 'id))

-- | A function that converts a number in words in /cardinal/ form to /ordinal/
-- form according to the /Dutch/ language rules.
ordinize' :: Text -> Text
ordinize' :: Text -> Text
ordinize' = (Text -> Char -> Text
`snoc` Char
'e') (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
_ordinize'

-- | A 'NumeralsAlgorithm' to convert numbers to words in the /Dutch/ language.
dutch :: NumeralsAlgorithm  -- ^ A 'NumeralsAlgorithm' that can be used to convert numbers to different formats.
dutch :: NumeralsAlgorithm
dutch = 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 /Dutch/.
toCardinal' :: Integral i
  => i  -- ^ The number to convert to text.
  -> Text  -- ^ The cardinal counterpart in /Dutch/.
toCardinal' :: i -> Text
toCardinal' = NumeralsAlgorithm -> i -> Text
forall a i. (NumToWord a, Integral i) => a -> i -> Text
toCardinal NumeralsAlgorithm
dutch

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

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

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

-- | A 'Vector' that contains the word used for the numbers /two/ to /twenty/ in the /Dutch/ language.
lowWords' :: Vector Text
lowWords' :: Vector Text
lowWords' = [
    Item (Vector Text)
"twee"
  , Item (Vector Text)
"drie"
  , Item (Vector Text)
"vier"
  , Item (Vector Text)
"vijf"
  , Item (Vector Text)
"zes"
  , Item (Vector Text)
"zeven"
  , Item (Vector Text)
"acht"
  , Item (Vector Text)
"negen"
  , Item (Vector Text)
"tien"
  , Item (Vector Text)
"elf"
  , Item (Vector Text)
"twaalf"
  , Item (Vector Text)
"dertien"
  , Item (Vector Text)
"veertien"
  , Item (Vector Text)
"vijftien"
  , Item (Vector Text)
"zestien"
  , Item (Vector Text)
"zeventien"
  , Item (Vector Text)
"achttien"
  , Item (Vector Text)
"negentien"
  , Item (Vector Text)
"twintig"
  ]

-- | A list of 2-tuples that contains the names of values between /thirty/ and
-- /thousand/ in the /Dutch/ language.
midWords' :: [(Integer, Text)]
midWords' :: [(Integer, Text)]
midWords' = [
    (Integer
1000, Text
"duizend")
  , (Integer
100, Text
"honderd")
  , (Integer
90, Text
"negentig")
  , (Integer
80, Text
"tachtig")
  , (Integer
70, Text
"zeventig")
  , (Integer
60, Text
"zestig")
  , (Integer
50, Text
"vijftig")
  , (Integer
40, Text
"veertig")
  , (Integer
30, Text
"dertig")
  ]

_rightAnd :: Integral i => i -> Text -> Text
_rightAnd :: i -> Text -> Text
_rightAnd i
1 = Text -> Text -> Text
forall a b. a -> b -> a
const Text
"een"
_rightAnd i
_ = Text -> Text
forall a. a -> a
id

_leftAnd :: Integral i => i -> Text -> Text
_leftAnd :: i -> Text -> Text
_leftAnd i
1 = Text -> Text -> Text
forall a b. a -> b -> a
const Text
"eenen"
_leftAnd i
n | i
2 <- i
n = Text -> Text
addE
           | i
3 <- i
n = Text -> Text
addE
           | Bool
otherwise = (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"en")
           where addE :: Text -> Text
addE = (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"ën")

-- | A merge function that is used to combine the names of words together to
-- larger words, according to the /Dutch/ 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
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 = (Text -> Text) -> Text -> Text -> Text
forall a b. a -> b -> a
const (i -> i -> Text -> Text -> Text
FreeMergerFunction
_merge' i
1 i
r Text
"een")
merge' i
l i
r = i -> i -> Text -> Text -> Text
FreeMergerFunction
_merge' i
l i
r

_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
r i -> i -> Bool
forall a. Ord a => a -> a -> Bool
>= i
forall i. Integral i => i
_million = Text -> Text -> Text
_mergeWithSpace
    | i
r i -> i -> Bool
forall a. Ord a => a -> a -> Bool
> i
l = Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>)
    | i
r i -> i -> Bool
forall a. Ord a => a -> a -> Bool
< i
10 Bool -> Bool -> Bool
&& i
10 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
go
    | i
l i -> i -> Bool
forall a. Ord a => a -> a -> Bool
>= i
forall i. Integral i => i
_million = Text -> Text -> Text
_mergeWithSpace
    | Bool
otherwise = Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>)
    where go :: Text -> Text -> Text
go Text
tl Text
tr = i -> Text -> Text
forall i. Integral i => i -> Text -> Text
_leftAnd i
r Text
tr Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> i -> Text -> Text
forall i. Integral i => i -> Text -> Text
_rightAnd i
l Text
tl

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

-- | A function to convert a number to its /short ordinal/ form in /Dutch/.
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
"'s nachts"
_dayPartText DayPart
Morning = Text
"'s ochtends"
_dayPartText DayPart
Afternoon = Text
"'s middags"
_dayPartText DayPart
Evening = Text
"'s avonds"

_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
" "

_mins :: Int -> Text
_mins :: Int -> Text
_mins = Text -> Text -> Int -> Text
forall a. a -> a -> Int -> a
_pluralize' Text
" minuut " Text
" minuten "

-- | Converting the time to a text that describes that time in /Dutch/.
clockText' :: ClockText
clockText' :: ClockText
clockText' ClockSegment
OClock DaySegment
ds Int
_ Int
_ = Text -> Int -> DaySegment -> Text
_dayComponent Text
" uur " 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
<> Int -> Text
_mins Int
m Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"na " 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
"kwart na "  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> DaySegment -> Text
_dayComponent' Int
0 DaySegment
ds
clockText' (ToHalf Int
m) DaySegment
ds Int
_ Int
_ = Int -> Text
FreeNumberToWords
toCardinal' Int
m Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
_mins Int
m Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"voor half " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> DaySegment -> Text
_dayComponent' Int
1 DaySegment
ds
clockText' ClockSegment
Half DaySegment
ds Int
_ Int
_ = Text
"half " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> DaySegment -> Text
_dayComponent' Int
1 DaySegment
ds
clockText' (PastHalf Int
m) DaySegment
ds Int
_ Int
_ = Int -> Text
FreeNumberToWords
toCardinal' Int
m Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
_mins Int
m Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"na half " 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
"kwart voor "  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
<> Int -> Text
_mins Int
m Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"voor " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> DaySegment -> Text
_dayComponent' Int
1 DaySegment
ds