{-# LANGUAGE CPP, OverloadedLists, OverloadedStrings, QuasiQuotes, TemplateHaskell #-}
module Text.Numerals.Languages.German (
german
, toCardinal'
, ordinize'
, negativeWord', zeroWord', oneWord'
, lowWords', midWords', highWords'
, merge'
) where
import Data.Bool(bool)
#if __GLASGOW_HASKELL__ < 803
import Data.Semigroup((<>))
#endif
import Data.Text(Text, isSuffixOf, pack, toLower, toTitle)
import Data.Vector(Vector)
import Text.Numerals.Algorithm(HighNumberAlgorithm(LongScale), NumeralsAlgorithm, numeralsAlgorithm, valueSplit')
import Text.Numerals.Algorithm.Template(ordinizeFromDict)
import Text.Numerals.Class(ClockText, FreeMergerFunction, toCardinal)
import Text.Numerals.Internal(_mergeWith, _mergeWithSpace, _million, _showIntegral)
import Text.RE.TDFA.Text(RE, SearchReplace, (*=~/), ed)
$(pure (ordinizeFromDict "_ordinize'" [
("eins", "ers")
, ("drei", "drit")
, ("acht", "ach")
, ("sieben", "sieb")
, ("ig", "igs")
, ("ert", "erts")
, ("end", "ends")
, ("ion", "ions")
, ("nen", "ns")
, ("rde", "rds")
, ("rden", "rds")
] 'id))
german :: NumeralsAlgorithm
german :: NumeralsAlgorithm
german = 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' ((Text -> Text) -> HighNumberAlgorithm -> FreeValueSplitter
valueSplit' Text -> Text
toTitle HighNumberAlgorithm
highWords') FreeMergerFunction
merge' Text -> Text
ordinize' FreeNumberToWords
shortOrdinal' ClockText
clockText'
toCardinal' :: Integral i
=> i
-> Text
toCardinal' :: i -> Text
toCardinal' = NumeralsAlgorithm -> i -> Text
forall a i. (NumToWord a, Integral i) => a -> i -> Text
toCardinal NumeralsAlgorithm
german
negativeWord' :: Text
negativeWord' :: Text
negativeWord' = Text
"minus"
zeroWord' :: Text
zeroWord' :: Text
zeroWord' = Text
"null"
oneWord' :: Text
oneWord' :: Text
oneWord' = Text
"eins"
lowWords' :: Vector Text
lowWords' :: Vector Text
lowWords' = [
Item (Vector Text)
"zwei"
, Item (Vector Text)
"drei"
, Item (Vector Text)
"vier"
, Item (Vector Text)
"fünf"
, Item (Vector Text)
"sechs"
, Item (Vector Text)
"sieben"
, Item (Vector Text)
"acht"
, Item (Vector Text)
"neun"
, Item (Vector Text)
"zehn"
, Item (Vector Text)
"elf"
, Item (Vector Text)
"zwölf"
, Item (Vector Text)
"dreizehn"
, Item (Vector Text)
"vierzehn"
, Item (Vector Text)
"fünfzehn"
, Item (Vector Text)
"sechzehn"
, Item (Vector Text)
"siebzehn"
, Item (Vector Text)
"achtzehn"
, Item (Vector Text)
"neunzehn"
, Item (Vector Text)
"zwanzig"
]
midWords' :: [(Integer, Text)]
midWords' :: [(Integer, Text)]
midWords' = [
(Integer
1000, Text
"tausend")
, (Integer
100, Text
"hundert")
, (Integer
90, Text
"neunzig")
, (Integer
80, Text
"achtzig")
, (Integer
70, Text
"siebzig")
, (Integer
60, Text
"sechzig")
, (Integer
50, Text
"fünfzig")
, (Integer
40, Text
"vierzig")
, (Integer
30, Text
"dreißig")
]
merge' :: FreeMergerFunction
merge' :: MergerFunction i
merge' i
1 i
100 = (Text -> Text) -> Text -> Text -> Text
forall a b. a -> b -> a
const (Text
"ein" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)
merge' i
1 i
1000 = (Text -> Text) -> Text -> Text -> Text
forall a b. a -> b -> a
const (Text
"ein" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)
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
merge' i
1 i
r = (Text -> Text) -> Text -> Text -> Text
forall a b. a -> b -> a
const (MergerFunction i
FreeMergerFunction
_merge' i
1 i
r Text
"eine")
merge' i
l i
r = MergerFunction i
FreeMergerFunction
_merge' i
l i
r
_pluralize :: Text -> Text
_pluralize :: Text -> Text
_pluralize Text
t
| Text
"e" Text -> Text -> Bool
`isSuffixOf` Text
t = Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"n"
| Bool
otherwise = Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"en"
_merge' :: FreeMergerFunction
_merge' :: MergerFunction i
_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 -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> (Text -> Text) -> Bool -> Text -> Text
forall a. a -> a -> Bool -> a
bool Text -> Text
forall a. a -> a
id Text -> Text
_pluralize (i
l i -> i -> Bool
forall a. Ord a => a -> a -> Bool
> i
1)) ((Text -> Text) -> Text -> Text)
-> (Text -> Text -> Text) -> Text -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
(<>)
_merge' i
l i
1 | 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
forall a b. a -> b -> a
const (Text -> Text -> Text) -> (Text -> Text) -> Text -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"einund" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> )
_merge' i
l i
r
| 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) -> Text -> Text -> Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Text -> Text -> Text -> Text
_mergeWith Text
"und")
| 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
(<>)
_ordinalSuffixRe :: SearchReplace RE Text
_ordinalSuffixRe :: SearchReplace RE Text
_ordinalSuffixRe = [ed|(eine)? ([a-z]+(illion|illiard)ste)$///${2}|]
ordinize' :: Text -> Text
ordinize' :: Text -> Text
ordinize' = Text -> Text
postprocess (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"te") (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
_ordinize' (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
toLower
where postprocess :: Text -> Text
postprocess Text
"eintausendste" = Text
"tausendste"
postprocess Text
"einhundertste" = Text
"hundertste"
postprocess Text
t = Text
t Text -> SearchReplace RE Text -> Text
*=~/ SearchReplace RE Text
_ordinalSuffixRe
highWords' :: HighNumberAlgorithm
highWords' :: HighNumberAlgorithm
highWords' = Text -> Text -> HighNumberAlgorithm
LongScale Text
"illion" Text
"illiarde"
shortOrdinal' :: Integral i
=> i
-> Text
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
".")
clockText' :: ClockText
clockText' :: ClockText
clockText' ClockSegment
_ DaySegment
_ Int
h Int
0 = Int -> Text
FreeNumberToWords
toCardinal' Int
h Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" Uhr"
clockText' ClockSegment
_ DaySegment
_ Int
h Int
m = Int -> Text
FreeNumberToWords
toCardinal' Int
h Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" Uhr " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
FreeNumberToWords
toCardinal' Int
m