Haskell Quiz/English Numerals/Solution Remi

module Main (main) where
 
import List
import System
import Maybe
 
tNGen combine num tal prev n
    | q == 0    = prev r
    | r == 0    = tal q
    | otherwise = tal q `combine` prev r
    where
        (q,r)   = n `quotRem` num
tN combine exp  = tNGen combine (10^exp)
 
tF sn s n       = sn n ++ s
tFOne sn s 1    = s
tFOne sn s n    = tF sn s n
 
maybeWeird weirds f n
            = fromMaybe (f n) (n `lookup` weirds)
 
spellNumNL  = tN (++) 100 (t    "googol" )
            $ tN (++)  18 (t    "triljoen")
            $ tN (++)  12 (t    "biljoen")
            $ tN (++)   9 (t    "miljard")
            $ tN (++)   6 (t    "miljoen")
            $ tN (++)   3 (tOne "duizend")
            $ tN (++)   2 (tOne "honderd")
            $ maybeWeird weirds
            $ tN (\t e -> e ++ (if last e=='e' then "\235n" else "en") ++ t) 1 ten
            $ unit
    where
        weirds  = zip [11..19]
                    ["elf", "twaalf", "dertien", "veertien", "vijftien"
                    ,"zestien", "zeventien", "achttien", "negentien"]
        unit    = genericIndex ["nul", "\233\233n", "twee", "drie", "vier"
                               ,"vijf", "zes", "zeven", "acht", "negen"]
        ten n   = ["tien", "twintig", "dertig", "veertig", "vijftig", "zestig"
                  ,"zeventig", "tachtig", "negentig"] `genericIndex` (n-1)
        tOne    = tFOne spellNumNL
        t       = tF spellNumNL
 
spellNumFR  = tNS (++) 9 (t "milliard")
            $ tNS (++) 6 (t "million")
            $ tN (++) 3 (tOne "mille")
            $ tNS (++) 2 (tOne "cent")
            $ maybeWeird weirds10
            $ tNGen (++) 80 (\1 -> "quatre-vingt-")
            $ tNGen etUn 60 (\1 -> "soixante")
            $ maybeWeird weirds
            $ tN etUn 1 ten
            $ unit
    where
        tNS combine exp tal
                = weirdF (10^exp) . tN combine exp tal
        weirdF k f n
            | let (q,r) = n `quotRem` k in q > 1 && r == 0
                = f n ++ "s" -- init: ugly hack to strip trailing space;)
            | otherwise
                = f n
        weirds10= [(80, "quatre-vingts")]
        weirds  = zip [11..19]
                    ["onze", "douze", "treize", "quatorze", "quinze"
                    ,"seize", "dix-sept", "dix-huit", "dix-neuf"]
        unit    = genericIndex ["zero", "un", "deux", "trois", "quatre"
                               ,"cingq", "six", "sept", "huit", "neuf"]
        ten n   = ["dix", "vingt", "trente", "quarante", "cinquante"]
                    `genericIndex` (n-1)
 
        tOne    = tFOne spellNumFR
        t       = tF spellNumFR
 
        etUn t "un"     = t ++ " et un"
        etUn t "onze"   = t ++ " et onze"
        etUn t e        = t ++ "-" ++ e
 
spellNumUS  = tN (++) 100 (t "googol" )
            $ tN (++)  18 (t "quantillion")
            $ tN (++)  15 (t "quadrillion")
            $ tN (++)  12 (t "trillion")
            $ tN (++)   9 (t "billion")
            $ tN (++)   6 (t "million")
            $ tN (++)   3 (t "thousand")
            $ tN (++)   2 (t "hundred")
            $ maybeWeird weirds
            $ tN (++)   1 ten
            $ unit
    where
        weirds  = zip [11..19]
                    ["eleven", "twelve", "thirteen", "fourteen", "fifteen"
                    ,"sixteen", "seventeen", "eighteen", "nineteen"]
        unit    = genericIndex ["zero", "one", "two", "three", "four"
                               ,"five", "six", "seven", "eight", "nine"]
        ten n   = ["ten", "twenty", "thirty", "forty", "fifty", "sixty"
                  ,"seventy", "eighty", "ninety"] `genericIndex` (n-1)
        t       = tF spellNumUS
 
main= getArgs >>= putStr . unlines . concatMap (\s -> map ($ read s) spellers)
    where
        spellers= show : map (('\t':) .) [spellNumNL, spellNumUS, spellNumFR]