{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE 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') MergerFunction i
FreeMergerFunction
merge' Text -> Text
ordinize' i -> Text
FreeNumberToWords
shortOrdinal' ClockText
clockText'
toCardinal' ::
Integral i =>
i ->
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
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)
Text
"zwei",
Item (Vector Text)
Text
"drei",
Item (Vector Text)
Text
"vier",
Item (Vector Text)
Text
"fünf",
Item (Vector Text)
Text
"sechs",
Item (Vector Text)
Text
"sieben",
Item (Vector Text)
Text
"acht",
Item (Vector Text)
Text
"neun",
Item (Vector Text)
Text
"zehn",
Item (Vector Text)
Text
"elf",
Item (Vector Text)
Text
"zwölf",
Item (Vector Text)
Text
"dreizehn",
Item (Vector Text)
Text
"vierzehn",
Item (Vector Text)
Text
"fünfzehn",
Item (Vector Text)
Text
"sechzehn",
Item (Vector Text)
Text
"siebzehn",
Item (Vector Text)
Text
"achtzehn",
Item (Vector Text)
Text
"neunzehn",
Item (Vector Text)
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' :: FreeMergerFunction
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' :: FreeMergerFunction
_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' :: FreeNumberToWords
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