packages feed

numerals 0.1 → 0.3

raw patch · 49 files changed

+3458/−1820 lines, 49 filesdep +HUnitdep +base-unicode-symbolsdep +containersdep −bytestringdep −dstringdep −mtldep ~base

Dependencies added: HUnit, base-unicode-symbols, containers, containers-unicode-symbols, numerals-base, test-framework, test-framework-hunit

Dependencies removed: bytestring, dstring, mtl, pretty, text

Dependency ranges changed: base

Files

LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2009 Roel van Dijk, Bas van Dijk+Copyright © 2009—2011 Roel van Dijk, Bas van Dijk  All rights reserved.
− README 
@@ -1,65 +0,0 @@-Specialise-==========--This is a small note on the Specialise flag.--All the language definitions (Text.Numeral.Language.*) are polymorphic-in their stringlike type. For example:--> nl :: (IsString s, Joinable s) => NumConfig s--This allows the user to choose whatever stringlike type she wants.--If you turn on the Specialise flag then specialised versions of the-language definitions will be build:--> #ifdef DO_SPECIALISE-> import qualified Data.ByteString as B-> import qualified Data.DString    as DS->-> {-# SPECIALISE nl :: NumConfig String #-}-> {-# SPECIALISE nl :: NumConfig B.ByteString #-}-> {-# SPECIALISE nl :: NumConfig DS.DString #-}-> #endif--The idea is that user code which uses any of the specialised types-will become more efficient because the overloading overhead has been-removed. Of course if we specialise the library will take longer to-compile and will be bigger.--The following will discuss some actual numbers:--Without Specialise-==================--$ cabal configure--$ time cabal build-...-5.347s--$ du -b dist/build/libHSnumerals-0.1.a-605574	dist/build/libHSnumerals-0.1.a---With Specialise-===============--$ cabal configure --flags="Specialise"--$ time cabal build-...-14.779s--$ du -b dist/build/libHSnumerals-0.1.a-2064852	dist/build/libHSnumerals-0.1.a---Conclusion-=========--If we specialise then:-* compilation will take almost 3 times longer-* the library will be at least 3 times bigger--TODO: Check for peformance gains!
+ README.markdown view
@@ -0,0 +1,74 @@+Numerals+========++Convert numbers to number words in a number of languages. Each+language has its own module. The module name is based on one of the+ISO 639 Alpha codes. Each module contains one or more `cardinal`+functions and a `struct` function. The `cardinal` functions directly+convert cardinal numbers to a string-like representation of their+spoken form. The `struct` functions convert numbers to a polymorphic+representation of their grammatical structure. All language modules+are implemented using the @numerals-base@ package.++The use of this package is best understood with some examples. Because+the results of conversion are polymorphic we need to choose a specific+type. For these examples we'll use simple strings. But any type that+has instances for `Monoid` and `IsString` will work. First some+English number names, both British and US variants:++    >>> import qualified Text.Numeral.Language.EN as EN+    >>> EN.uk_cardinal 123 :: Maybe String+    Just "one hundred and twenty-three"+    >>> EN.us_cardinal (10^50 + 42) :: Maybe String+    Just "one hundred quindecillion forty-two"++French, which contains some traces of a base 20 system:++    >>> import qualified Text.Numeral.Language.FR as FR+    >>> FR.cardinal (-99) :: Maybe String+    Just "moins quatre-vingt-dix-neuf"++Conversions can fail. Alamblak, a language spoken by a few people in+Papua New Guinea, has no representation for negative numbers:++    >>> import qualified Text.Numeral.Language.AMP as AMP+    >>> AMP.cardinal (-3) :: Maybe String+    Nothing++Some languages have multiple scripts and methods for writing number+names. Take Chinese for example, which can be written using Han+characters or transcribed to the Latin script using Pinyin.++Traditional Chinese characters:++    >>> import qualified Text.Numeral.Language.ZH as ZH+    >>> ZH.trad_cardinal 123456 :: Maybe String+    Just "十二萬三千四百五十六"++Simplified characters for use in financial contexts:++    >>> ZH.finance_simpl_cardinal 123456 :: Maybe String+    Just "拾贰万参仟肆伯伍拾陆"++Transcribed using Pinyin:++    >>> ZH.pinyin_cardinal 123456 :: Maybe String+    Just "shíèrwàn sānqiān sìbǎi wǔshí liù"++Using the `struct` functions you can see the grammatical structure of+number names. Because the results of these functions are polymorphic+you need to specify a specific type.++    >>> import qualified Text.Numeral.Language.NL as NL+    >>> NL.struct 123 :: Maybe Integer+    Just 123+    >>> import Text.Numeral+    >>> NL.struct 123 :: Maybe Exp+    Just (Add (Lit 100) (Add (Lit 3) (Mul (Lit 2) (Lit 10))))++Compare with:++    >>> NL.cardinal 123 :: Maybe String+    Just "honderddrieëntwintig"++100 (honderd) + (3 (drie) + (ën) 2 (twin) * 10 (tig))
− TODO 
@@ -1,63 +0,0 @@-Also see: http://conway.rutgers.edu/~ccshan/wiki/blog/posts/WordNumbers1/--*** Features ***--Conversions between:-  - Numbers and linguistic numerals-  - Numbers and representations in numeral systems---*** Linguistic numerals ***--Cardinal numerals:-  How many items - one, two, three--Ordinal numerals:-  Position - first, second, third.-  en   1 = first-  en   2 = second-  en  32 = thirty-second-  nl   8 = achtste-  nl   9 = negende-  nl  89 = negenentachtigste--Partitive numerals:-  Expresses a fraction - half, third, quarter.-  en 1%2 = half-  en 2%3 = two thirds-  nl 2%3 = twee derden-  nl 3%4 = drie kwart--Decimals:-  Fractions of powers of ten-  en 0.7   = seven-tenths-  en 0.065 = sixty-five thousanths-  nl 0.28  = achtentwintig honderdsten--Multiplicative numerals:-  How many times - once, twice, thrice.-  en   1 = once-  en   2 = twice-  en   3 = thrice-  en [4..] = undefined - or use a convention like "four times,-             five times, etc."--Distributive numerals:-  Expresses a group of the number specified: In pairs, by the-  dozen. English does not have distributive numerals for these but-  other languages such as Georgian do.---*** Numeral systems ***--Positional systems:-  Binary, octal, decimal, hexadecimal, vigesimal etc.-  Also support floating point numbers.--Concatenative systems:-  Roman numerals---*** TODOS ***--Use a package which defines polynomials for the positional numeral systems stuff.
− Text/Numeral.hs 
@@ -1,166 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards   #-}--module Text.Numeral-    ( -- *Types-      NumConfig(..)-    , NumSymbol(..)-    , SymbolType(..)-    , SymbolContext(..)-    , Gender(..)--      -- *Cardinals-    , cardinal-    , findSym--      -- *Smart NumSymbol constructors-    , term, add, mul-    , termG, addG, mulG--      -- *Symbol representation helper functions-    , gender, genderN-    , tenForms, tenFormsG, tenForms', mulForms-    )-    where------------------------------------------------------------------------------------ Types----------------------------------------------------------------------------------data NumConfig s = NumConfig { ncCardinal :: Integer -> Maybe (NumSymbol s)-                             , ncNeg      :: s -> s-                             , ncOne      :: (Integer, s) -> s-                             , ncAdd      :: (Integer, s) -> (Integer, s) -> s-                             , ncMul      :: (Integer, s) -> (Integer, s) -> s-                             }--data NumSymbol s = NumSym { symType  :: SymbolType-                          , symVal   :: Integer-                          , symScope :: Integer-                          , symRepr  :: Gender -> SymbolContext -> s-                          }--data SymbolType = Terminal | Add | Mul deriving Show--data SymbolContext = EmptyContext-                   | LA Integer SymbolContext-                   | RA Integer SymbolContext-                   | LM Integer SymbolContext-                   | RM Integer SymbolContext-                     deriving Show---- | Grammatical gender-data Gender = Neuter | Masculine | Feminine deriving Show-------------------------------------------------------------------------------------------------------------------------------------------------------------------cardinal :: NumConfig s -> Gender -> Integer -> Maybe s-cardinal NumConfig {..} g x | x < 0     = fmap ncNeg $ go EmptyContext $ abs x-                            | x == 0    = fmap (\sym -> symRepr sym g EmptyContext) $ ncCardinal 0-                            | otherwise = go EmptyContext x-    where go ctx n = do (NumSym _ v _ rv) <- ncCardinal n-                        case n `divMod` v of-                          (1, 0) -> return $ ncOne (v, rv g ctx)-                          (1, r) -> do rs <- go (RA v ctx) r-                                       return $ (v, ncOne (v, rv g (LA r ctx))) `ncAdd` (r, rs)-                          (q, r) | q >= v    -> Nothing-                                 | otherwise -> do qs <- go (LM v ctx) q-                                                   if r == 0-                                                     then return $ (q, qs) `ncMul` (v, rv g (RM q ctx))-                                                     else do let qv = q * v-                                                             rs <- go (RA qv ctx) r-                                                             return $ (qv, (q, qs) `ncMul` (v, rv g (RM q (LA qv ctx)))) `ncAdd` (r, rs)-------------------------------------------------------------------------------------------------------------------------------------------------------------------findSym :: [NumSymbol s] -> Integer -> Maybe (NumSymbol s)-findSym []     _ = Nothing-findSym (e:es) n = go e e es-    where go :: NumSymbol s -> NumSymbol s -> [NumSymbol s] -> Maybe (NumSymbol s)-          go a m [] = stop a m-          go a m (x@(NumSym t v _ _) : xs)-              | v == n    = Just x-              | otherwise = case t of-                              Terminal        -> go a m xs-                              Add | v > n     -> stop a m-                                  | otherwise -> go x m xs-                              Mul | v > n     -> stop a m-                                  | otherwise -> go a x xs--          stop :: NumSymbol s -> NumSymbol s -> Maybe (NumSymbol s)-          stop a@(NumSym {..}) m | n < symVal + symScope = return a-                                 | otherwise             = return m------------------------------------------------------------------------------------ Smart NumSymbol constructors----------------------------------------------------------------------------------termG :: Integer -> (Gender -> SymbolContext -> s) -> NumSymbol s-termG val fs = NumSym Terminal val 1 fs--addG :: Integer -> Integer -> (Gender -> SymbolContext -> s) -> NumSymbol s-addG scope val fs = NumSym Add scope val fs--mulG :: Integer -> (Gender -> SymbolContext -> s) -> NumSymbol s-mulG val fs = NumSym Mul val val fs--term :: Integer -> (SymbolContext -> s) -> NumSymbol s-term val fs = termG val $ const fs--add :: Integer -> Integer -> (SymbolContext -> s) -> NumSymbol s-add scope val fs = addG scope val $ const fs--mul :: Integer -> (SymbolContext -> s) -> NumSymbol s-mul val fs = mulG val $ const fs------------------------------------------------------------------------------------ Symbol representation helper functions------------------------------------------------------------------------------------ Differentiate between masculine and feminine genders. Other genders--- default to masculine.-gender :: s -> s -> (Gender -> s)-gender _ f Feminine  = f-gender m _ _         = m---- Differentiate between neuter, masculine and feminine genders-genderN :: s -> s -> s -> (Gender -> s)-genderN n _ _ Neuter    = n-genderN _ m _ Masculine = m-genderN _ _ f Feminine  = f----- |Constructs a symbol representation based on the relation of the---  symbol with the number 10.---  The chosen representation depends on the context in which the---  symbol is used:---    d) default:        x---    a) additive:       10 + x---    m) multiplicative: x * 10-tenForms :: s -> s -> s -> (SymbolContext -> s)-tenForms _ a _ (RA 10 _) = a-tenForms _ _ m (LM 10 _) = m-tenForms d _ _ _         = d--tenFormsG :: (Gender -> s) -> (Gender -> s) -> (Gender -> s) -> (Gender -> SymbolContext -> s)-tenFormsG d a m g ctx = tenForms (d g) (a g) (m g) ctx---- |Constructs a symbol representation based on the relation of the---  symbol with the number 10.---  The chosen representation depends on the context in which the---  symbol is used:---    d)  default:        x---    a)  additive:       10 + x---    mt) multiplicative: x * 10---    mh) multiplicative: x * 100-tenForms' :: s -> s -> s -> s -> (SymbolContext -> s)-tenForms' _ a _  _  (RA 10  _) = a-tenForms' _ _ mt _  (LM 10  _) = mt-tenForms' _ _ _  mh (LM 100 _) = mh-tenForms' d _ _  _  _          = d--mulForms :: s -> s -> (SymbolContext -> s)-mulForms _ p (RM {}) = p-mulForms s _ _       = s
− Text/Numeral/Debug.hs 
@@ -1,166 +0,0 @@-{-# LANGUAGE OverloadedStrings    #-}-{-# LANGUAGE RecordWildCards      #-}-{-# LANGUAGE TypeSynonymInstances #-}--module Text.Numeral.Debug where--import Data.String-import Text.Numeral-import Text.Numeral.Joinable-import Text.Numeral.Misc (const2, withSnd)-import Text.Numeral.Language--import qualified Data.DString          as DS-import qualified Data.ByteString.Char8 as B-import qualified Data.Text             as T-import qualified Text.PrettyPrint      as PP-----------------------------------------------------------------------------------class Stringable s where-    toString :: s -> String--instance Stringable String where-    toString = id--instance Stringable B.ByteString where-    toString = B.unpack--instance Stringable T.Text where-    toString = T.unpack--instance Stringable ShowS where-    toString s = s []--instance Stringable DS.DString where-    toString = DS.toString--instance Stringable PP.Doc where-    toString = PP.render-----------------------------------------------------------------------------------type Test s = NumConfig s -> Gender -> [Integer] -> IO ()--test :: Stringable s => Test s-test nc g = mapM_ (putStrLn . pretty)-    where pretty n = show n ++ " == " ++ (maybe "-" id $ fmap toString $ cardinal nc g n)--testS :: Test String-testS = test--testBS :: Test B.ByteString-testBS = test--testT :: Test T.Text-testT = test--testSS :: Test ShowS-testSS = test--testDS :: Test DS.DString-testDS = test--testDoc :: Test PP.Doc-testDoc = test--testDocWithStyle :: PP.Style -> NumConfig PP.Doc -> Gender -> [Integer] -> IO ()-testDocWithStyle s nc g = mapM_ (putStrLn . pretty)-    where pretty n = show n ++ " == " ++ (maybe "-" id $ fmap (PP.renderStyle s) $ cardinal nc g n)------------------------------------------------------------------------------------- | @nummify@ transforms the given NumConfig to a numeric NumConfig--- such that 'prop_cardinal_nummify' holds.  @nummify@ is thus usefull--- as a testing aid.  @nummify@ is also usefull as a debugging aid--- when you use a suitable numeric type such as 'NS' which renders a--- numeric expression to a string representing the same expression.-nummify :: Num n => NumConfig s -> NumConfig n-nummify (NumConfig {..}) = NumConfig { ncCardinal = fmap transformSym . ncCardinal-                                     , ncNeg      = negate-                                     , ncOne      = snd-                                     , ncAdd      = withSnd (+)-                                     , ncMul      = withSnd (*)-                                     }-    where-      -- Create a new symbol who's representation is its value.-      transformSym :: (Num n) => NumSymbol s -> NumSymbol n-      transformSym sym = sym { symRepr = const2 . fromInteger . symVal $ sym}---- | 'prop_cardinal_nummify' specifies the correctness of 'cardinal'.-prop_cardinal_nummify :: NumConfig String -> Gender -> Integer -> Bool-prop_cardinal_nummify nc g n = maybe True (== n) $ cardinal (nummify nc) g n------------------------------------------------------------------------------------- | 'NS' is used-newtype NS s = NS {unNS :: Precedence -> s}--type Precedence = Int---- The following bogus Show and Eq instances are needed for Num :-(--instance Show (NS s) where-    show _ = "NS <function>"--instance Eq (NS s) where-    _ == _ = False--instance (IsString s, Joinable s) => Num (NS s) where-    fromInteger = NS . const . fromString . show--    (+) = bin "+" 6-    (-) = bin "-" 6-    (*) = bin "*" 7--    negate = un "negate"-    abs    = un "abs"-    signum = un "signum"--un :: (IsString s, Joinable s) => s -> (NS s -> NS s)-un sFun x = NS $ \p -> paren (p > precApp)-                             (sFun <+> unNS x (precApp+1))-    where-      precApp  = 10--bin :: (IsString s, Joinable s) => s -> Precedence -> (NS s -> NS s -> NS s)-bin sOp d x y = NS $ \p -> paren (p > d) $-                let p' = d + 1-                in unNS x p' <+> sOp <+> unNS y p'--paren :: (IsString s, Joinable s) => Bool -> s -> s-paren True  s = "(" <> s <> ")"-paren False s = s--instance Stringable s => Stringable (NS s) where-    toString (NS f) = toString $ f 0--testNSS :: Test (NS String)-testNSS = test--testNumS :: Test String-testNumS = testNSS . nummify-----------------------------------------------------------------------------------newtype Lst s = Lst {unLst :: [s]}--instance Joinable s => Joinable (Lst s) where-    x <>  y = Lst $ appendUnionWith (<>) (unLst x) (unLst y)-    x <+> y = Lst $ unLst x ++ unLst y---- | appendUnionWith f [a, b, c] [d, e, f] => [a, b, c `f` d, e, f]-appendUnionWith :: (a -> a -> a) -> [a] -> [a] -> [a]-appendUnionWith _ []     ys     = ys-appendUnionWith _ xs     []     = xs-appendUnionWith f [x]    (y:ys) = x `f` y : ys-appendUnionWith f (x:xs) ys     = x : appendUnionWith f xs ys--instance IsString s => IsString (Lst s) where-    fromString s = Lst [fromString s]--instance Stringable s => Stringable (Lst s) where-    toString = show . map toString . unLst--testLst :: Test (Lst String)-testLst = test
− Text/Numeral/Joinable.hs 
@@ -1,58 +0,0 @@-{-# LANGUAGE OverloadedStrings         #-}-{-# LANGUAGE TypeSynonymInstances      #-}--module Text.Numeral.Joinable where--import Data.Monoid-import Data.String--import qualified Data.DString          as DS-import qualified Data.ByteString.Char8 as B-import qualified Data.Text             as T-import qualified Text.PrettyPrint      as PP----- | Class of string-like types which can be joined.-class Joinable s where-    (<>)  :: s -> s -> s-    (<+>) :: s -> s -> s--infixr 5 <>, <+>, <->--(<->) :: (Joinable s, IsString s) => s -> s -> s-x <-> y = x <> "-" <> y--space :: (Joinable s, IsString s) => s -> s -> s-space x y = x <> " " <> y--instance Joinable String where-    (<>)  = mappend-    (<+>) = space--instance Joinable B.ByteString where-    (<>)  = mappend-    (<+>) = space--instance Joinable T.Text where-    (<>)  = mappend-    (<+>) = space--instance Joinable ShowS where-    (<>)  = mappend-    (<+>) = space--instance Joinable DS.DString where-    (<>)  = mappend-    (<+>) = space--instance Joinable PP.Doc where-    (<>)  = (PP.<>)-    (<+>) = (PP.<+>)-----------------------------------------------------------------------------------instance IsString ShowS where-    fromString = showString--instance IsString PP.Doc where-    fromString = PP.text
− Text/Numeral/Language.hs 
@@ -1,36 +0,0 @@-module Text.Numeral.Language-    ( -- *West Germanic-      module Text.Numeral.Language.NL-    , module Text.Numeral.Language.DE-    , module Text.Numeral.Language.EN-      -- *North Germanic-    , module Text.Numeral.Language.SV-    , module Text.Numeral.Language.NO-      -- *Romance-    , module Text.Numeral.Language.FR-    , module Text.Numeral.Language.IT-    , module Text.Numeral.Language.LA-    , module Text.Numeral.Language.PT-    , module Text.Numeral.Language.SP-      -- *Japonic-    , module Text.Numeral.Language.JA-      -- *Constructed-    , module Text.Numeral.Language.EO-    ) where--import Text.Numeral.Language.NL-import Text.Numeral.Language.DE-import Text.Numeral.Language.EN--import Text.Numeral.Language.SV-import Text.Numeral.Language.NO--import Text.Numeral.Language.FR-import Text.Numeral.Language.IT-import Text.Numeral.Language.LA-import Text.Numeral.Language.PT-import Text.Numeral.Language.SP--import Text.Numeral.Language.JA--import Text.Numeral.Language.EO
− Text/Numeral/Language/DE.hs 
@@ -1,60 +0,0 @@--- -*- coding: utf-8 -*---{-# LANGUAGE CPP, OverloadedStrings #-}--module Text.Numeral.Language.DE (de) where--import Data.String-import Text.Numeral-import Text.Numeral.Joinable-import Text.Numeral.Misc (d, withSnd)--#ifdef DO_SPECIALISE-import qualified Data.ByteString as B-import qualified Data.DString    as DS--{-# SPECIALISE de :: NumConfig String #-}-{-# SPECIALISE de :: NumConfig B.ByteString #-}-{-# SPECIALISE de :: NumConfig DS.DString #-}-#endif--de :: (IsString s, Joinable s) => NumConfig s-de = NumConfig { ncNeg      = ("minus" <+>)-               , ncOne      = deOne-               , ncAdd      = deAdd-               , ncMul      = withSnd (<>)-               , ncCardinal = findSym deTable-               }--deOne :: (IsString s, Joinable s) => (Integer, s) -> s-deOne (v, vs) | v >= (d 6) = "eine" <+> vs-              | v >= 100   = "ein"  <>  vs-              | otherwise  = vs--deAdd :: (IsString s, Joinable s) => (Integer, s) -> (Integer, s) -> s-deAdd (x, x') (y, y') | x < 20    = y' <> x'-                      | x < 100   = (if y == 1-                                     then "ein"-                                     else y') <> "und" <> x'-                      | otherwise = x' <> y'--deTable :: (IsString s, Joinable s) => [NumSymbol s]-deTable = [ term 0        $ const "null"-          , term 1        $ const "eins"-          , term 2        $ tenForms "zwei" "zwei" "zwan"-          , term 3        $ const "drei"-          , term 4        $ const "vier"-          , term 5        $ const "fünf"-          , term 6        $ const "sechs"-          , term 7        $ tenForms "sieben" "sieb" "sieb"-          , term 8        $ const "acht"-          , term 9        $ const "neun"-          , mul  10       $ mulForms "zehn" "zig"-          , term 11       $ const "elf"-          , term 12       $ const "zwölf"-          , add  30    10 $ const "dreißig"-          , mul  100      $ const "hundert"-          , mul  1000     $ const "tausend"-          , mul  (d 6)    $ const "million"-          , mul  (d 9)    $ const "milliarde"-          ]
− Text/Numeral/Language/EN.hs 
@@ -1,69 +0,0 @@-{-# LANGUAGE CPP, OverloadedStrings #-}--module Text.Numeral.Language.EN (enShort, enLong) where--import Data.String-import Text.Numeral-import Text.Numeral.Joinable-import Text.Numeral.Pelletier (shortScale, longScale)--#ifdef DO_SPECIALISE-import qualified Data.ByteString as B-import qualified Data.DString    as DS--{-# SPECIALISE enShort :: NumConfig String #-}-{-# SPECIALISE enShort :: NumConfig B.ByteString #-}-{-# SPECIALISE enShort :: NumConfig DS.DString #-}--{-# SPECIALISE enLong :: NumConfig String #-}-{-# SPECIALISE enLong :: NumConfig B.ByteString #-}-{-# SPECIALISE enLong :: NumConfig DS.DString #-}-#endif--enShort :: (IsString s, Joinable s) => NumConfig s-enShort = NumConfig { ncNeg      = enNeg-                    , ncOne      = enOne-                    , ncAdd      = enAdd-                    , ncMul      = enMul-                    , ncCardinal = findSym $ enTable ++ shortScale "illion"-                    }--enLong :: (IsString s, Joinable s) => NumConfig s-enLong = enShort { ncCardinal = findSym $ enTable ++ longScale "illion" "illiard"}--enNeg :: (IsString s, Joinable s) => s -> s-enNeg = ("minus" <+>)--enOne :: (IsString s, Joinable s) => (Integer, s) -> s-enOne (v,  vs) | v >= 100  = "one" <+> vs-               | otherwise = vs--enAdd :: (IsString s, Joinable s) => (Integer, s) -> (Integer, s) -> s-enAdd (x, x') (_, y') | x < 20    = y' <> x'-                      | x < 100   = x' <-> y'-                      | otherwise = x' <+> y'--enMul :: (IsString s, Joinable s) => (Integer, s) -> (Integer, s) -> s-enMul (_, x') (y, y') | y == 10   = x' <> y'-                      | otherwise = x' <+> y'--enTable :: (IsString s, Joinable s) => [NumSymbol s]-enTable = [ term 0    $ const "zero"-          , term 1    $ const "one"-          , term 2    $ tenForms "two"   "twen" "twen"-          , term 3    $ tenForms "three" "thir" "thir"-          , term 4    $ tenForms "four"  "four" "for"-          , term 5    $ tenForms "five"  "fif"  "fif"-          , term 6    $ const "six"-          , term 7    $ const "seven"-          , term 8    $ tenForms "eight" "eigh" "eigh"-          , term 9    $ const "nine"-          , mul  10   $ \ctx -> case ctx of-                                   LA {} -> "teen"-                                   RM {} -> "ty"-                                   _     -> "ten"-          , term 11   $ const "eleven"-          , term 12   $ const "twelve"-          , mul  100  $ const "hundred"-          , mul  1000 $ const "thousand"-          ]
− Text/Numeral/Language/EO.hs 
@@ -1,44 +0,0 @@--- -*- coding: utf-8 -*---{-# LANGUAGE CPP, OverloadedStrings #-}--module Text.Numeral.Language.EO (eo) where--import Data.String-import Text.Numeral-import Text.Numeral.Joinable-import Text.Numeral.Misc (d, withSnd)--#ifdef DO_SPECIALISE-import qualified Data.ByteString as B-import qualified Data.DString    as DS--{-# SPECIALISE eo :: NumConfig String #-}-{-# SPECIALISE eo :: NumConfig B.ByteString #-}-{-# SPECIALISE eo :: NumConfig DS.DString #-}-#endif--eo :: (IsString s, Joinable s) => NumConfig s-eo = NumConfig { ncNeg      = error "eoNeg: undefined"-               , ncOne      = snd-               , ncAdd      = withSnd (<+>)-               , ncMul      = withSnd (<>)-               , ncCardinal = findSym eoTable-               }--eoTable :: (IsString s, Joinable s) => [NumSymbol s]-eoTable = [ term 0    $ const "nulo"-          , term 1    $ const "unu"-          , term 2    $ const "du"-          , term 3    $ const "tri"-          , term 4    $ const "kvar"-          , term 5    $ const "kvin"-          , term 6    $ const "ses"-          , term 7    $ const "sep"-          , term 8    $ const "ok"-          , term 9    $ const "naŭ"-          , mul 10    $ const "dek"-          , mul 100   $ const "cent"-          , mul 1000  $ const "mil"-          , mul (d 6) $ const "miliono"-          ]
− Text/Numeral/Language/FR.hs 
@@ -1,71 +0,0 @@--- -*- coding: utf-8 -*---{-# LANGUAGE CPP, OverloadedStrings #-}--module Text.Numeral.Language.FR (fr) where--import Data.String-import Text.Numeral-import Text.Numeral.Joinable-import Text.Numeral.Pelletier (longScalePlural)--#ifdef DO_SPECIALISE-import qualified Data.ByteString as B-import qualified Data.DString    as DS--{-# SPECIALISE fr :: NumConfig String #-}-{-# SPECIALISE fr :: NumConfig B.ByteString #-}-{-# SPECIALISE fr :: NumConfig DS.DString #-}-#endif---- Sources:---  http://www.cliffsnotes.com/WileyCDA/CliffsReviewTopic/Numbers.topicArticleId-25559,articleId-25469.html--fr :: (IsString s, Joinable s) => NumConfig s-fr = NumConfig { ncNeg      = ("moins" <+>)-               , ncOne      = snd-               , ncAdd      = frAdd-               , ncMul      = frMul-               , ncCardinal = findSym frTable-               }--frAdd :: (IsString s, Joinable s) => (Integer, s) -> (Integer, s) -> s-frAdd (x, x') (y, y') | x == 10 && y < 7 = y' <> x'-                      | x < 80 && y == 1 = x' <+> "et" <+> y'-                      | x < 100          = x' <-> y'-                      | otherwise        = x' <+> y'--frMul :: (IsString s, Joinable s) => (Integer, s) -> (Integer, s) -> s-frMul (_, x') (y, y') | y == 10   = x' <> y'-                      | otherwise = x' <+> y'--frTable :: (IsString s, Joinable s) => [NumSymbol s]-frTable = [ term  0        $ const "zéro"-          , termG 1        $ tenFormsG (gender "un" "une") (const "on") (const "un")-          , term  2        $ tenForms "deux"   "deux"   "dou"-          , term  3        $ tenForms "trois"  "trei"   "tren"-          , term  4        $ tenForms "quatre" "quator" "quar"-          , term  5        $ tenForms "cinq"   "quin"   "cinqu"-          , term  6        $ tenForms "six"    "sei"    "soix"-          , term  7        $ const "sept"-          , term  8        $ const "huit"-          , term  9        $ const "neuf"-          , mul   10       $ \ctx -> case ctx of-                                        LA n _ | n < 7     -> "ze"-                                               | otherwise -> "dix"-                                        RM 3 _ -> "te"-                                        RM _ _ -> "ante"-                                        _      -> "dix"-          , add   20    10 $ const "vingt"-          , add   60    20 $ const "soixante"-          , term  71       $ const "soixante et onze"-          , term  80       $ const "quatre-vingts"-          , add   80    20 $ const "quatre-vingt"-          , mul   100      $ let c = "cent"-                             in \ctx -> case ctx of-                                          RM _ (LA _ _) -> c-                                          RM _ (LM _ _) -> c-                                          RM _ _        -> c <> "s"-                                          _             -> c-          , mul   1000     $ const "mille"-          ] ++ longScalePlural "illion" "illions" "illiard" "illiards"
− Text/Numeral/Language/IT.hs 
@@ -1,77 +0,0 @@--- -*- coding: utf-8 -*---{-# LANGUAGE CPP, OverloadedStrings #-}--module Text.Numeral.Language.IT (it) where--import Data.String-import Text.Numeral-import Text.Numeral.Joinable-import Text.Numeral.Misc (d)-import Text.Numeral.Pelletier (longScalePlural)--#ifdef DO_SPECIALISE-import qualified Data.ByteString as B-import qualified Data.DString    as DS--{-# SPECIALISE it :: NumConfig String #-}-{-# SPECIALISE it :: NumConfig B.ByteString #-}-{-# SPECIALISE it :: NumConfig DS.DString #-}-#endif---- Sources:---   http://italian.about.com/library/weekly/aa042600a.htm--it :: (IsString s, Joinable s) => NumConfig s-it = NumConfig { ncNeg      = error "itNeg: undefined"-               , ncOne      = snd-               , ncAdd      = itAdd-               , ncMul      = itMul-               , ncCardinal = findSym itTable-               }--itAdd :: (IsString s, Joinable s) => (Integer, s) -> (Integer, s) -> s-itAdd (x, x') (y, y') | x == 10 && y < 7 = y' <> x'-                      | y == 3    = x' <> "tré"-                      | otherwise = x' <> y'--itMul :: (IsString s, Joinable s) => (Integer, s) -> (Integer, s) -> s-itMul (_, x') (y, y') | y < d 6   = x' <> y'-                      | otherwise = x' <+> y'--itTable :: (IsString s, Joinable s) => [NumSymbol s]-itTable = [ term  0       $ const "zero"-          , termG 1       $ tenFormsG (gender "uno" "una") (const "un") (const "uno")-          , term  2       $ tenForms "due"     "do"      "due"-          , term  3       $ tenForms "tre"     "tre"     "ten"-          , term  4       $ tenForms "quattro" "quattor" "quar"-          , term  5       $ tenForms "cinque"  "quin"    "cinqu"-          , term  6       $ tenForms "sei"     "se"      "sess"-          , term  7       $ tenForms "sette"   "assette" "sett"-          , term  8       $ tenForms "otto"    "otto"    "ott"-          , term  9       $ tenForms "nove"    "annove"  "nove"-          , mul   10      $ \ctx -> case ctx of-                                       LA _ _ -> "dici"-                                       RM 3 _ -> "ta"-                                       RM _ _ -> "anta"-                                       _      -> "dieci"-          , add   20   10 $ const "venti"-          , term  21      $ const "ventuno"-          , term  28      $ const "ventotto"-          , term  31      $ const "trentuno"-          , term  38      $ const "trentotto"-          , term  41      $ const "quarantuno"-          , term  48      $ const "quarantotto"-          , term  51      $ const "cinquantuno"-          , term  58      $ const "cinquantotto"-          , term  61      $ const "sessantuno"-          , term  68      $ const "sessantotto"-          , term  71      $ const "settantuno"-          , term  78      $ const "settantotto"-          , term  81      $ const "ottantuno"-          , term  88      $ const "ottantotto"-          , term  91      $ const "novantuno"-          , term  98      $ const "novantotto"-          , mul   100     $ const "cento"-          , mul   1000    $ mulForms "mille" "mila"-          ] ++ longScalePlural "ilione" "ilioni" "iliardo" "iliardi"
− Text/Numeral/Language/JA.hs 
@@ -1,65 +0,0 @@--- -*- coding: utf-8 -*---{-# LANGUAGE CPP, OverloadedStrings #-}--module Text.Numeral.Language.JA (ja) where--import Data.String-import Text.Numeral-import Text.Numeral.Joinable-import Text.Numeral.Misc (d, withSnd)--#ifdef DO_SPECIALISE-import qualified Data.ByteString as B-import qualified Data.DString    as DS--{-# SPECIALISE ja :: NumConfig String #-}-{-# SPECIALISE ja :: NumConfig B.ByteString #-}-{-# SPECIALISE ja :: NumConfig DS.DString #-}-#endif--ja :: (IsString s, Joinable s) => NumConfig s-ja = NumConfig { ncNeg      = ("mainasu" <+>)-               , ncOne      = jaOne-               , ncAdd      = withSnd (<+>)-               , ncMul      = withSnd (<->)-               , ncCardinal = findSym jaTable-               }--jaOne :: (IsString s, Joinable s) => (Integer, s) -> s-jaOne (v, vs) | v < 100 || (300 >= v && v < 400) = vs-              | otherwise = "ichi" <-> vs--jaTable :: (IsString s, Joinable s) => [NumSymbol s]-jaTable = [ term 0         $ const "rei"-          , term 1         $ const "ichi"-          , term 2         $ const "ni"-          , term 3         $ const "san"-          , term 4         $ const "yon"-          , term 5         $ const "go"-          , term 6         $ const "roku"-          , term 7         $ const "nana"-          , term 8         $ const "hachi"-          , term 9         $ const "kyū"-          , mul 10         $ const "jū"-          , mul 100        $ const "hyaku"-          , add 300    100 $ const "san-byaku" -- rendaku-          , mul 1000       $ const "sen"-          , mul (d 4)      $ const "man"-          , mul (d 8)      $ const "oku"-          , mul (d 12)     $ const "chō"-          , mul (d 16)     $ const "kei"-          , mul (d 20)     $ const "gai"-          , mul (d 24)     $ const "jo"-          , mul (d 28)     $ const "jō"-          , mul (d 32)     $ const "kō"-          , mul (d 36)     $ const "kan"-          , mul (d 40)     $ const "sei"-          , mul (d 44)     $ const "sai"-          , mul (d 48)     $ const "goku"-          , mul (d 52)     $ const "gōgasha"-          , mul (d 56)     $ const "asōgi"-          , mul (d 60)     $ const "nayuta"-          , mul (d 64)     $ const "fukashigi"-          , mul (d 68)     $ const "muryōtaisū"-          ]
− Text/Numeral/Language/LA.hs 
@@ -1,75 +0,0 @@-{-# LANGUAGE CPP, OverloadedStrings #-}--module Text.Numeral.Language.LA (la) where--import Data.String-import Text.Numeral-import Text.Numeral.Joinable-import Text.Numeral.Misc (d)--#ifdef DO_SPECIALISE-import qualified Data.ByteString as B-import qualified Data.DString    as DS--{-# SPECIALISE la :: NumConfig String #-}-{-# SPECIALISE la :: NumConfig B.ByteString #-}-{-# SPECIALISE la :: NumConfig DS.DString #-}-#endif--la :: (IsString s, Joinable s) => NumConfig s-la = NumConfig { ncNeg      = error "laNeg: undefined"-               , ncOne      = snd-               , ncAdd      = laAdd-               , ncMul      = laMul-               , ncCardinal = findSym laTable-               }--laAdd :: (IsString s, Joinable s) => (Integer, s) -> (Integer, s) -> s-laAdd (x, x') (_, y') | x == 10   = y' <> x'-                      | otherwise = x' <+> y'--laMul :: (IsString s, Joinable s) => (Integer, s) -> (Integer, s) -> s-laMul (_, x') (y, y') | y < 1000  = x' <> y'-                      | otherwise = x' <+> y'--laTable :: (IsString s, Joinable s) => [NumSymbol s]-laTable = [ term 0     $ const "nulla"-          , term 1     $ tenForms  "unus"     "un"       "unus"-          , term 2     $ tenForms' "duo"      "duo"      "vi"      "du"-          , term 3     $ tenForms' "tres"     "tre"      "tri"     "tre"-          , term 4     $ tenForms' "quattuor" "quattuor" "quadra"  "quadri"-          , term 5     $ tenForms' "quinque"  "quin"     "quinqua" "quin"-          , term 6     $ tenForms' "sex"      "se"       "sexa"    "ses"-          , term 7     $ tenForms' "septem"   "septen"   "septua"  "septin"-          , term 8     $ const "octo"-          , term 9     $ tenForms' "novem"    "novem"    "nona"    "non"-          , mul  10    $ \ctx -> case ctx of-                                    LA _ _ -> "decim"-                                    RM 2 _ -> "ginti"-                                    RM _ _ -> "ginta"-                                    _      -> "decem"-          , term 18    $ const "duodeviginti"-          , term 19    $ const "undeviginti"-          , term 28    $ const "duodetriginta"-          , term 29    $ const "undetriginta"-          , term 38    $ const "duodequadraginta"-          , term 39    $ const "undequadraginta"-          , term 48    $ const "duodequinquaginta"-          , term 49    $ const "undequinquaginta"-          , term 58    $ const "duodesexaginta"-          , term 59    $ const "undesexaginta"-          , term 68    $ const "duodeseptuaginta"-          , term 69    $ const "undeseptuaginta"-          , term 78    $ const "duodeoctoginta"-          , term 79    $ const "undeoctoginta"-          , term 88    $ const "duodenonaginta"-          , term 89    $ const "undenonaginta"-          , term 98    $ const "duodecentum"-          , term 99    $ const "undecentum"-          , mul  100   $ \ctx -> case ctx of-                                    RM n _ | n `elem` [2, 3, 6] -> "centi"-                                           | otherwise          -> "genti"-                                    _                           -> "centum"-          , mul  1000  $ mulForms "mille" "millia"-          , term (d 6) $ const "decies centena milia"-          ]
− Text/Numeral/Language/NL.hs 
@@ -1,59 +0,0 @@--- -*- coding: utf-8 -*---{-# LANGUAGE CPP, OverloadedStrings #-}--module Text.Numeral.Language.NL (nl) where--import Data.String-import Text.Numeral-import Text.Numeral.Joinable-import Text.Numeral.Pelletier (longScale)--#ifdef DO_SPECIALISE-import qualified Data.ByteString as B-import qualified Data.DString    as DS--{-# SPECIALISE nl :: NumConfig String #-}-{-# SPECIALISE nl :: NumConfig B.ByteString #-}-{-# SPECIALISE nl :: NumConfig DS.DString #-}-#endif--nl :: (IsString s, Joinable s) => NumConfig s-nl = NumConfig { ncNeg      = ("min" <+>)-               , ncOne      = snd-               , ncAdd      = nlAdd-               , ncMul      = nlMul-               , ncCardinal = findSym nlTable-               }--nlAdd :: (IsString s, Joinable s) => (Integer, s) -> (Integer, s) -> s-nlAdd (x, x') (y, y') | x < 20    = y' <> x'-                      | x < 100   = y' <> (if y == 2 || y == 3-                                           then "ën"-                                           else "en")-                                       <> x'-                      | otherwise = x' <+> y'--nlMul :: (IsString s, Joinable s) => (Integer, s) -> (Integer, s) -> s-nlMul (_, x') (y, y') | y <= 10   = x' <> y'-                      | otherwise = x' <+> y'--nlTable :: (IsString s, Joinable s) => [NumSymbol s]-nlTable = [ term 0    $ const "nul"-          , term 1    $ const "één"-          , term 2    $ tenForms "twee" "twin" "twin"-          , term 3    $ tenForms "drie" "der"  "der"-          , term 4    $ tenForms "vier" "veer" "veer"-          , term 5    $ const "vijf"-          , term 6    $ const "zes"-          , term 7    $ const "zeven"-          , term 8    $ tenForms "acht" "tach" "acht"-          , term 9    $ const "negen"-          , mul  10   $ \ctx -> case ctx of-                                   RM {} -> "tig"-                                   _     -> "tien"-          , term 11   $ const "elf"-          , term 12   $ const "twaalf"-          , mul  100  $ const "honderd"-          , mul  1000 $ const "duizend"-          ] ++ (longScale "iljoen" "iljard")
− Text/Numeral/Language/NO.hs 
@@ -1,63 +0,0 @@--- -*- coding: utf-8 -*---{-# LANGUAGE CPP, OverloadedStrings #-}--module Text.Numeral.Language.NO (no) where--import Data.String-import Text.Numeral-import Text.Numeral.Joinable-import Text.Numeral.Misc (d, withSnd)--#ifdef DO_SPECIALISE-import qualified Data.ByteString as B-import qualified Data.DString    as DS--{-# SPECIALISE no :: NumConfig String #-}-{-# SPECIALISE no :: NumConfig B.ByteString #-}-{-# SPECIALISE no :: NumConfig DS.DString #-}-#endif---- Sources:---   http://en.wikibooks.org/wiki/Norwegian_Numbers--no :: (IsString s, Joinable s) => NumConfig s-no = NumConfig { ncNeg      = error "noNeg: undefined"-               , ncOne      = noOne-               , ncAdd      = noAdd-               , ncMul      = withSnd (<>)-               , ncCardinal = findSym noTable-               }--noOne :: (IsString s, Joinable s) => (Integer, s) -> s-noOne (v, vs) | v >= (d 6) = "én" <+> vs-              | otherwise  = vs---- TODO: What are the rules for conjunction in Norse? When do you put--- "og" between numbers?-noAdd :: (IsString s, Joinable s) => (Integer, s) -> (Integer, s) -> s-noAdd (x, x') (_, y') | x < 20    = y' <> x'-                      | otherwise = x' <> y'--noTable :: (IsString s, Joinable s) => [NumSymbol s]-noTable = [ term 0        $ const "null"-          , term 1        $ const "én"-          , term 2        $ const "to"-          , term 3        $ tenForms "tre"  "tret" "tret"-          , term 4        $ tenForms "fire" "fjor" "før"-          , term 5        $ const "fem"-          , term 6        $ const "seks"-          , term 7        $ tenForms "sju"  "syt" "syt"-          , term 8        $ tenForms "åtte" "at"  "åt"-          , term 9        $ tenForms "ni"   "nit" "nit"-          , mul  10       $ \ctx -> case ctx of-                                       LA {} -> "ten"-                                       _     -> "ti"-          , term 11       $ const "elleve"-          , term 12       $ const "tolv"-          , add  20    10 $ const "tjue"-          , mul  100      $ const "hundre"-          , mul  (d 3)    $ const "tusen"-          , mul  (d 6)    $ mulForms "million"  "millioner"-          , mul  (d 9)    $ mulForms "milliard" "milliarder"-          ]
− Text/Numeral/Language/PT.hs 
@@ -1,75 +0,0 @@--- -*- coding: utf-8 -*---{-# LANGUAGE CPP, OverloadedStrings #-}--module Text.Numeral.Language.PT (pt) where--import Data.String-import Text.Numeral-import Text.Numeral.Joinable-import Text.Numeral.Pelletier (shortScalePlural)--#ifdef DO_SPECIALISE-import qualified Data.ByteString as B-import qualified Data.DString    as DS--{-# SPECIALISE pt :: NumConfig String #-}-{-# SPECIALISE pt :: NumConfig B.ByteString #-}-{-# SPECIALISE pt :: NumConfig DS.DString #-}-#endif---- Sources:---   http://www.sonia-portuguese.com/text/numerals.htm---   http://www.smartphrase.com/Portuguese/po_numbers_voc.shtml--pt :: (IsString s, Joinable s) => NumConfig s-pt = NumConfig { ncNeg      = error "ptNeg: undefined"-               , ncOne      = ptOne-               , ncAdd      = ptAdd-               , ncMul      = ptMul-               , ncCardinal = findSym ptTable-               }--ptOne :: (IsString s, Joinable s) => (Integer, s) -> s-ptOne (x, x') | x <= 1000 = x'-              | otherwise = "um" <+> x'---- TODO: When to use "e" is still unclear.-ptAdd :: (IsString s, Joinable s) => (Integer, s) -> (Integer, s) -> s-ptAdd (x, x') (_, y') | x == 10   = y' <> x'-                      | otherwise = x' <+> "e" <+> y'--ptMul :: (IsString s, Joinable s) => (Integer, s) -> (Integer, s) -> s-ptMul (_, x') (y, y') | y < 1000  = x' <> y'-                      | otherwise = x' <+> y'--ptTable :: (IsString s, Joinable s) => [NumSymbol s]-ptTable = [ term 0         $ const "zero"-          , term 1         $ tenForms "um"     "on"    "um"-          , term 2         $ tenForms "dois"   "do"    "dois"-          , term 3         $ tenForms "três"   "tre"   "trin"-          , term 4         $ tenForms "quatro" "cator" "quar"-          , term 5         $ tenForms "cinco"  "quin"  "cinqü"-          , term 6         $ tenForms "seis"   "seis"  "sess"-          , term 7         $ tenForms "sete"   "sete"  "set"-          , term 8         $ tenForms "oito"   "oito"  "oit"-          , term 9         $ tenForms "nove"   "nove"  "nov"-          , mul  10        $ \ctx -> case ctx of-                                        LA _ _ -> "ze"-                                        RM 3 _ -> "ta"-                                        RM _ _ -> "enta"-                                        _      -> "dez"-          , term 16        $ const "dezesseis"-          , term 17        $ const "dezessete"-          , term 18        $ const "dezoito"-          , term 19        $ const "dezenove"-          , add  20    10  $ const "vinte"-          , mul  100       $ \ctx -> case ctx of-                                        RM _ _ -> "centos"-                                        LA _ _ -> "cento"-                                        _      -> "cem"-          , add  200   100 $ const "duzentos"-          , add  300   100 $ const "trezentos"-          , add  500   100 $ const "quinhentos"-          , mul  1000      $ const "mil"-          ] ++ shortScalePlural "ilhão" "ilhões"
− Text/Numeral/Language/SP.hs 
@@ -1,80 +0,0 @@--- -*- coding: utf-8 -*---{-# LANGUAGE CPP, OverloadedStrings #-}--module Text.Numeral.Language.SP (sp) where--import Data.String-import Text.Numeral-import Text.Numeral.Joinable-import Text.Numeral.Misc (d)--#ifdef DO_SPECIALISE-import qualified Data.ByteString as B-import qualified Data.DString    as DS--{-# SPECIALISE sp :: NumConfig String #-}-{-# SPECIALISE sp :: NumConfig B.ByteString #-}-{-# SPECIALISE sp :: NumConfig DS.DString #-}-#endif---- Sources:---   http://spanish.about.com/cs/forbeginners/a/cardinalnum_beg.htm---   http://www.learn-spanish-help.com/count-in-spanish.html---   http://www.donquijote.org/spanishlanguage/numbers/numbers1.asp--sp :: (IsString s, Joinable s) => NumConfig s-sp = NumConfig { ncNeg      = error "spNeg: undefined"-               , ncOne      = snd-               , ncAdd      = spAdd-               , ncMul      = spMul-               , ncCardinal = findSym spTable-               }--spAdd :: (IsString s, Joinable s) => (Integer, s) -> (Integer, s) -> s-spAdd (x, x') (y, y') | x == 10 && y < 6 = y' <> x'-                      | x == 10    = x' <> y'-                      | x < 30     = x' <>  "i" <>  y'-                      | x < 100    = x' <+> "y" <+> y'-                      | otherwise  = x' <+> y'--spMul :: (IsString s, Joinable s) => (Integer, s) -> (Integer, s) -> s-spMul (_, x') (y, y') | y < 1000  = x' <> y'-                      | otherwise = x' <+> y'--spTable :: (IsString s, Joinable s) => [NumSymbol s]-spTable = [ term  0         $ const "cero"-          , termG 1         $ tenFormsG (genderN "uno" "un" "una") (const "on") (const "uno")-          , term  2         $ \ctx -> case ctx of-                                         RA 10 _ -> "do"-                                         RA 20 _ -> "dós"-                                         _       -> "dos"-          , term  3         $ \ctx -> case ctx of-                                         RA n _ | n == 10 -> "tre"-                                                | n < 100 -> "trés"-                                         LM 10 _ -> "trein"-                                         _       -> "tres"-          , term  4         $ tenForms "cuatro" "cator" "cuaren"-          , term  5         $ tenForms "cinco"  "quin"  "cincuen"-          , term  6         $ \ctx -> case ctx of-                                         RA n _ | n <= 20 -> "séis"-                                         LM 10 _ -> "sesen"-                                         _       -> "seis"-          , term  7         $ tenForms' "siete" "siete" "seten" "sete"-          , term  8         $ tenForms  "ocho"  "ocho"  "ochen"-          , term  9         $ tenForms' "nueve" "nueve" "noven" "novo"-          , mul   10        $ \ctx -> case ctx of-                                         LA n _ | n < 6     -> "ce"-                                                | otherwise -> "dieci"-                                         RM _ _ -> "ta"-                                         _      -> "diez"-          , add   20    10  $ const "veint"-          , mul   100       $ \ctx -> case ctx of-                                         RM _ _ -> "cientos"-                                         LA _ _ -> "ciento"-                                         _      -> "cien"-          , add   500   100 $ const "quinientos"-          , mul   1000      $ const "mil"-          , mul   (d 6)     $ mulForms "millón" "millones"-          , mul   (d 12)    $ mulForms "billón" "billones"-          ]
− Text/Numeral/Language/SV.hs 
@@ -1,74 +0,0 @@--- -*- coding: utf-8 -*---{-# LANGUAGE CPP, OverloadedStrings #-}--module Text.Numeral.Language.SV (sv) where--import Data.String-import Text.Numeral-import Text.Numeral.Joinable-import Text.Numeral.Misc (d, withSnd)--#ifdef DO_SPECIALISE-import qualified Data.ByteString as B-import qualified Data.DString    as DS--{-# SPECIALISE sv :: NumConfig String #-}-{-# SPECIALISE sv :: NumConfig B.ByteString #-}-{-# SPECIALISE sv :: NumConfig DS.DString #-}-#endif---- Sources:---   http://www.lysator.liu.se/language/Languages/Swedish/Grammar.html---   http://en.wikibooks.org/wiki/Swedish/Numerals---   http://longstrom.com/swedishtoenglish.htm#numbers----   http://www.cs.chalmers.se/~aarne/GF/---   http://www.cs.chalmers.se/~aarne/GF/lib/resource/norwegian/NumeralNor.gf--sv :: (IsString s, Joinable s) => NumConfig s-sv = NumConfig { ncNeg      = ("minus" <+>)-               , ncOne      = svOne-               , ncAdd      = svAdd-               , ncMul      = withSnd (<>)-               , ncCardinal = findSym svTable-               }--svOne :: (IsString s, Joinable s) => (Integer, s) -> s-svOne (v, vs) | v >= 100   = "ett" <> vs-              | otherwise  = vs--svAdd :: (IsString s, Joinable s) => (Integer, s) -> (Integer, s) -> s-svAdd (x, x') (_, y') | x < 20    = y' <> x'-                      | otherwise = x' <> y'--svTable :: (IsString s, Joinable s) => [NumSymbol s]-svTable = [ term 0        $ const "noll"-          , term 1        $ const "ett"-          , term 2        $ const "två"-          , term 3        $ tenForms "tre"  "tret" "tret"-          , term 4        $ tenForms "fyra" "fjor" "fyr"-          , term 5        $ const "fem"-          , term 6        $ const "sex"-          , term 7        $ tenForms "sju"  "sjut" "sjut"-          , term 8        $ tenForms "åtta" "ar"   "åt"-          , term 9        $ tenForms "nio"  "nit"  "nit"-          , mul  10       $ \ctx -> case ctx of-                                       LA {} -> "ton"-                                       _     -> "tio"-          , term 11       $ const "elva"-          , term 12       $ const "tolv"-          , add  20    10 $ const "tjugo"-          , mul  100      $ const "hundra"-          , mul  (d 3)    $ const "tusen"-          , mul  (d 6)    $ mulForms "miljon"       "miljoner"-          , mul  (d 9)    $ mulForms "miljard"      "miljarder"-          , mul  (d 12)   $ mulForms "biljon"       "biljoner"-          , mul  (d 15)   $ mulForms "biljard"      "biljarder"-          , mul  (d 18)   $ mulForms "triljon"      "triljoner"-          , mul  (d 21)   $ mulForms "triljard"     "triljarder"-          , mul  (d 24)   $ mulForms "kvadriljon"   "kvadriljoner"-          , mul  (d 27)   $ mulForms "kvadriljard"  "kvadriljarder"-          , mul  (d 30)   $ mulForms "kvintriljon"  "kvintriljoner"-          , mul  (d 33)   $ mulForms "kvintriljard" "kvintriljarder"-          ]
− Text/Numeral/Misc.hs 
@@ -1,20 +0,0 @@-module Text.Numeral.Misc where---withSnd :: (a -> b -> c) -> (d, a) -> (e, b) -> c-withSnd f (_, x) (_, y) = f x y--d :: Integer -> Integer-d = (10 ^)--const2 :: a -> b -> c -> a-const2 = const . const--weave :: [a] -> [a] -> [a]-weave []     ys = ys-weave (x:xs) ys = x : weave ys xs--untilNothing :: [Maybe a] -> [a]-untilNothing []             = []-untilNothing (Just x  : xs) = x : untilNothing xs-untilNothing (Nothing : _)  = []
− Text/Numeral/Pelletier.hs 
@@ -1,74 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Text.Numeral.Pelletier-    ( longScale-    , longScalePlural-    , shortScale-    , shortScalePlural-    ) where--import Data.String-import Text.Numeral-import Text.Numeral.Joinable-import Text.Numeral.Misc (d, untilNothing, weave, withSnd)---longScale :: (IsString s, Joinable s) => s -> s -> [NumSymbol s]-longScale a b = longScalePlural a a b b--longScalePlural :: (IsString s, Joinable s) => s -> s -> s -> s -> [NumSymbol s]-longScalePlural a as b bs = untilNothing $ weave (map illion [1..]) (map illiard [1..])-    where illion  n = fmap (\s -> mul (d 6 ^ n)       $ mulForms (s <> a) (s <> as)) $ bigCardinal n-          illiard n = fmap (\s -> mul (d 6 ^ n * d 3) $ mulForms (s <> b) (s <> bs)) $ bigCardinal n--shortScale :: (IsString s, Joinable s) => s -> [NumSymbol s]-shortScale a = shortScalePlural a a--shortScalePlural :: (IsString s, Joinable s) => s -> s -> [NumSymbol s]-shortScalePlural a as = untilNothing $ map illion [1..]-    where illion n = fmap (\s -> mul (d 3 * (d 3 ^ n)) $ mulForms (s <> a) (s <> as)) $ bigCardinal n--bigCardinal :: (IsString s, Joinable s) => Integer -> Maybe s-bigCardinal = cardinal bigNum Masculine------------------------------------------------------------------------------------- Big Num 'language'----------------------------------------------------------------------------------bigNum :: (IsString s, Joinable s) => NumConfig s-bigNum = NumConfig { ncNeg      = error "bigNumNeg: undefined"-                   , ncOne      = snd-                   , ncAdd      = withSnd . flip $ (<>)-                   , ncMul      = withSnd (<>)-                   , ncCardinal = findSym bigNumTable-                   }--bigNumTable :: (IsString s, Joinable s) => [NumSymbol s]-bigNumTable = [ term 0     $ const "nulla"-              , term 1     $ forms "m"     "un"       "un"       "mi"      "mi"-              , term 2     $ forms "b"     "duo"      "duo"      "vi"      "du"-              , term 3     $ forms "tr"    "tre"      "tres"     "tri"     "tre"-              , term 4     $ forms "quadr" "quattuor" "quattuor" "quadra"  "quadrin"-              , term 5     $ forms "quint" "quin"     "quinqua"  "quinqua" "quin"-              , term 6     $ forms "sext"  "sex"      "ses"      "sexa"    "ses"-              , term 7     $ forms "sept"  "septen"   "septem"   "septua"  "septin"-              , term 8     $ forms "oct"   "octo"     "octo"     "octo"    "octin"-              , term 9     $ forms "non"   "novem"    "novem"    "nona"    "non"-              , mul  10    $ \ctx -> case ctx of-                                        RM {} -> "gint"-                                        _     -> "dec"-              , mul  100   $ \ctx -> case ctx of-                                        RM n _ | n `elem` [2, 3, 6] -> "cent"-                                               | otherwise          -> "gent"-                                        _                           -> "cent"-              , mul  1000  $ const "mill"-              , mul  10000 $ const "myr"-              ]-    where forms d a1 a2 m1 m2 ctx = case ctx of-                                      RA 10  _ -> a1-                                      RA _   _ -> a2-                                      LM 100 _ -> m2-                                      LM _   _ -> m1-                                      _        -> d-
− Text/Numeral/Positional.hs 
@@ -1,97 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE BangPatterns      #-}--module Text.Numeral.Positional-    ( toPositional-    , digitSymbol--      -- *Positional numeral systems-    , binary-    , negabinary-    , ternary-    , octal-    , decimal-    , negadecimal-    , hexadecimal-    ) where--import qualified Data.List as L-import Data.Monoid-import Data.String------------------------------------------------------------------------------------toPolynomial :: Integer -> Integer -> [Integer]-toPolynomial b n | n == 0    = [0]-                 | b == 0    = error "toPolynomial: base 0"-                 | b == (-1) = case n of-                                 (-1) -> [0, 1]-                                 1    -> [1]-                                 _    -> error "toPolynomial: base (-1)"-                 | b == 1    = L.genericReplicate (abs n) (signum n)-                 | otherwise = toPolynomial_b $ n-      where toPolynomial_b 0 = []-            toPolynomial_b n = let (q, r) = n `qr` b-                         in r : toPolynomial_b q--            qr | b > 0     = quotRem-               | otherwise = quotRem'--            quotRem' :: Integral a => a -> a -> (a, a)-            quotRem' n d = let qr@(q, r) = n `quotRem` d-                           in if r < 0-                              then (q + 1, r - d)-                              else qr--fromPolynomial :: Integer -> [Integer] -> Integer-fromPolynomial b = sum' . zipWith (*) (iterate (* b) 1)-    where sum' = L.foldl' (+) 0--prop_polynomial :: Integer -> Integer -> Bool-prop_polynomial b n | b == 0    && n /= 0    = True-                    | b == (-1) && abs n > 1 = True-                    | otherwise              = n == (fromPolynomial b $ toPolynomial b n)-----------------------------------------------------------------------------------toPositional :: (IsString s, Monoid s) => (Integer -> s) -> Integer -> Integer -> Maybe s-toPositional f b n | b == 0         = Nothing-                   | n < 0 && b > 0 = fmap (mappend "-") $ repr (abs n)-                   | otherwise      = repr n-    where repr x = fmap mconcat . mapM f' . reverse . toPolynomial b $ x-          f' n | n >= abs b = Nothing-               | otherwise  = Just $ f n------------------------------------------------------------------------------------- Digit symbols up to base 62.--- TODO: array for faster lookup-digitSymbols :: IsString s => [s]-digitSymbols = map (\x -> fromString [x]) $ ['0'..'9'] ++ ['A'..'Z'] ++ ['a'..'z']--digitSymbol :: IsString s => Integer -> s-digitSymbol = (digitSymbols `L.genericIndex`)-----------------------------------------------------------------------------------binary :: (Monoid s, IsString s) => Integer -> Maybe s-binary = toPositional digitSymbol 2--negabinary :: (Monoid s, IsString s) => Integer -> Maybe s-negabinary = toPositional digitSymbol (-2)--ternary :: (Monoid s, IsString s) => Integer -> Maybe s-ternary = toPositional digitSymbol 3--octal :: (Monoid s, IsString s) => Integer -> Maybe s-octal = toPositional digitSymbol 8--decimal :: (Monoid s, IsString s) => Integer -> Maybe s-decimal = toPositional digitSymbol 10--negadecimal :: (Monoid s, IsString s) => Integer -> Maybe s-negadecimal = toPositional digitSymbol (-10)--hexadecimal ::(Monoid s, IsString s) => Integer -> Maybe s-hexadecimal = toPositional digitSymbol 16
− Text/Numeral/Roman.hs 
@@ -1,216 +0,0 @@-{-# LANGUAGE FlexibleContexts  #-}-{-# LANGUAGE OverloadedStrings #-}--{-| Parsing and pretty printing of Roman numerals.--  This module provides functions for parsing and pretty printing Roman-  numerals. Because the notation of Roman numerals has varied through-  the centuries this package allows for some customisation using a-  configuration that is passed to the conversion functions. Exceptions-  are dealt with by wrapping the results of conversions in the error-  monad.--}-module Text.Numeral.Roman-  ( -- * Types-    NumeralConfig(..)-    -- * Sample configurations-  , modernRoman-  , simpleRoman-    -- * Pretty printing-  , convertTo-  , unsafeConvertTo-  , toRoman-  , unsafeToRoman-    -- * Parsing-  , convertFrom-  , fromRoman-  , unsafeConvertFrom-  , unsafeFromRoman-  ) where--import Control.Monad.Error-import qualified Data.ByteString as BS-import qualified Data.List as L-import Data.Monoid-import Data.String-import Prelude hiding (null)-import qualified Prelude as P------------------------------------------------------------------------------------ Types------------------------------------------------------------------------------------ |A configuration with which the 'convertTo' and 'convertFrom'---  functions can be parameterized.-data NumeralConfig s n = NC { -- |The largest value that can be-                              -- represented using this configuration.-                              ncMax :: n-                              -- |Symbol to represent the value 0. The-                              --  Romans did not have a symbol for-                              --  zero. If set to Nothing a-                              --  'convertFrom' 0 will throw an error.-                            , ncZero :: Maybe s-                              -- |A table of symbols and their-                              --  numerical values. The table must be-                              --  ordered with the largest symbols-                              --  appearing first. If any symbol is-                              --  the empty string then 'convertFrom'-                              --  will be undefined. If any symbol in-                              --  this table is associated with the-                              --  value 0 both the convertTo and-                              --  'convertFrom' function will be-                              --  undefined.-                            , ncTable :: [(s, n)]-                            }------------------------------------------------------------------------------------ Default tables------------------------------------------------------------------------------------ |Configuration for Roman numerals as they are commonly used---  today. The value 0 is represented by the empty string. It can be---  interpreted as not writing down a number. This configuration is---  limited to the range [1..3999]. Larger numbers can be represented---  using Roman numerals but you will need notations that are hard or---  impossible to express using strings.-modernRoman :: (IsString s, Ord n, Num n) => NumeralConfig s n-modernRoman = NC { ncMax      = 3999-                 , ncZero     = Just ""-                 , ncTable    = [ ("M",  1000)-                                , ("CM",  900)-                                , ("D",   500)-                                , ("CD",  400)-                                , ("C",   100)-                                , ("XC",   90)-                                , ("L",    50)-                                , ("XL",   40)-                                , ("X",    10)-                                , ("IX",    9)-                                , ("V",     5)-                                , ("IV",    4)-                                , ("I",     1)-                                ]-                 }---- |Configuration for Roman numerals that do not use the rule that a---  lower rank symbol can be placed before a higher rank symbol to---  denote the difference between them. Thus a numeral like "IV" will---  not be accepted or generated by this configuration.-simpleRoman :: (IsString s, Ord n, Num n) => NumeralConfig s n-simpleRoman = NC { ncMax      = 3999-                 , ncZero     = Just ""-                 , ncTable    = [ ("M", 1000)-                                , ("D",  500)-                                , ("C",  100)-                                , ("L",   50)-                                , ("X",   10)-                                , ("V",    5)-                                , ("I",    1)-                                ]-                 }------------------------------------------------------------------------------------ Pretty printing------------------------------------------------------------------------------------ |Converts a number to a Roman numeral according to the given---  configuration. Numbers which are out of bounds will cause---  exceptions to be thrown. An exception will also be raised if no---  representation is possible with the given configuration. If the---  value of any symbol in the configuration is equal to 0 or a symbol---  is the empty string this function is undefined.-convertTo :: (Monoid s, Ord n, Num n, MonadError String m)-          => NumeralConfig s n -> n -> m s-convertTo nc n | n < 0     = throwError "Roman.convertTo: can't represent negative numbers"-               | n > maxN  = throwError $ "Roman.convertTo: too large (max = " ++ (show maxN) ++ ")"-               | n == 0    = maybe (throwError "Roman.convertTo: no symbol for zero")-                                   return-                                   $ ncZero nc-               | otherwise = go n $ ncTable nc-    where maxN = ncMax nc-          go 0 _  = return mempty-          go _ [] = throwError "Roman.convertTo: out of symbols"-          go n tab@(~(sym, val) : ts) | n >= val  = liftM2 mappend (return sym) $ go (n - val) tab-                                      | otherwise = go n ts---- |Like 'convertTo', but exceptions are promoted to errors.-unsafeConvertTo :: (Monoid s, Ord n, Num n) => NumeralConfig s n -> n -> s-unsafeConvertTo nc = either error id . convertTo nc---- |Converts a number to a modern Roman numeral. See 'convertTo' for---  possible exceptions.-toRoman :: (IsString s, Monoid s, Ord n, Num n, MonadError String m) => n -> m s-toRoman = convertTo modernRoman---- |Like 'toRoman', but exceptions are promoted to errors.-unsafeToRoman :: (IsString s, Monoid s, Ord n, Num n) => n  -> s-unsafeToRoman = unsafeConvertTo modernRoman------------------------------------------------------------------------------------ Parsing------------------------------------------------------------------------------------ |Class used to overload the input of the parsing functions.-class StripPrefix s where-    null        :: s -> Bool-    stripPrefix :: s -> s -> Maybe s--instance Eq a => StripPrefix [a] where-    null        = P.null-    stripPrefix = L.stripPrefix--instance StripPrefix BS.ByteString where-    null = BS.null-    stripPrefix p s = let (h, t) = BS.breakSubstring p s-                      in if null h-                         then Just $ BS.drop (BS.length p) t-                         else Nothing---- |Parses a string as a Roman numeral according to the given---  configuration. An exception will be raised if the input is not a---  valid numeral.-convertFrom :: (Monoid s, StripPrefix s, Eq s, Ord n, Num n, MonadError String m)-            => NumeralConfig s n -> s -> m n-convertFrom nc s | maybe False (== s) (ncZero nc) = return 0-                 | otherwise = do n  <- (go 0 (ncTable nc) s)-                                  s' <- convertTo nc n-                                  if s == s'-                                    then return n-                                    else throwError "Roman.convertFrom: invalid Roman numeral"-    where go n _  s | null s = return n-          go _ [] s  = throwError $ "Roman.convertFrom: can't parse"-          go n tab@((sym, val) : ts) s = maybe (go n ts s)-                                               (go (n + val) tab)-                                               $ stripPrefix sym s---- |Like 'convertFrom', but exceptions are promoted to errors.-unsafeConvertFrom :: (Monoid s, StripPrefix s, Eq s, Ord n, Num n)-                  => NumeralConfig s n -> s -> n-unsafeConvertFrom nc = either error id . convertFrom nc---- |Parses a string as a modern Roman numeral. See 'convertFrom' for---  possible exceptions.-fromRoman :: (IsString s, Monoid s, StripPrefix s, Eq s, Ord n, Num n, MonadError String m)-          => s -> m n-fromRoman = convertFrom modernRoman---- |Like 'fromRoman', but exceptions are promoted to errors.-unsafeFromRoman :: (IsString s, Monoid s, StripPrefix s, Eq s, Ord n, Num n)-                => s -> n-unsafeFromRoman = unsafeConvertFrom modernRoman------------------------------------------------------------------------------------ Properties----------------------------------------------------------------------------------prop_printParseIsId :: NumeralConfig String Integer -> String -> Bool-prop_printParseIsId nc xs = either (const True) id-                                   $ do n   <- convertFrom nc xs-                                        xs' <- convertTo   nc n-                                        return $ xs' == xs--prop_parsePrintIsId :: NumeralConfig String Integer -> Integer -> Bool-prop_parsePrintIsId nc n = either (const True) id-                                  $ do xs <- convertTo   nc n-                                       n' <- convertFrom nc xs-                                       return $ n' == n
numerals.cabal view
@@ -1,60 +1,177 @@ name:          numerals-version:       0.1-cabal-version: >= 1.6+version:       0.3+cabal-version: >= 1.8 build-type:    Simple stability:     experimental author:        Roel van Dijk <vandijk.roel@gmail.com>, Bas van Dijk <v.dijk.bas@gmail.com>-maintainer:    Roel van Dijk <vandijk.roel@gmail.com>, Bas van Dijk <v.dijk.bas@gmail.com>-copyright:     (c) 2009 Roel van Dijk, Bas van Dijk+maintainer:    Roel van Dijk <vandijk.roel@gmail.com>+copyright:     2009–2011 Roel van Dijk, Bas van Dijk license:       BSD3 license-file:  LICENSE+homepage:      https://github.com/roelvandijk/numerals+bug-reports:   https://github.com/roelvandijk/numerals/issues category:      Natural Language Processing, Numerical, Text-synopsis:      Utilities for working with numerals-description:+synopsis:      Convert numbers to number words+description:   +  Convert numbers to number words in a number of languages. Each+  language has its own module. The module name is based on one of the+  ISO 639 Alpha codes. Each module contains one or more 'cardinal'+  functions and a 'struct' function. The 'cardinal' functions directly+  convert cardinal numbers to a string-like representation of their+  spoken form. The 'struct' functions convert numbers to a polymorphic+  representation of their grammatical structure. All language modules+  are implemented using the @numerals-base@ package.+  .+  The use of this package is best understood with some+  examples. Because the results of conversion are polymorphic we need+  to choose a specific type. For these examples we'll use simple+  strings. But any type that has instances for 'Monoid' and 'IsString'+  will work. First some English number names, both British and US+  variants:+  .+  >>> import qualified Text.Numeral.Language.EN as EN+  >>> EN.uk_cardinal 123 :: Maybe String+  Just "one hundred and twenty-three"+  >>> EN.us_cardinal (10^50 + 42) :: Maybe String+  Just "one hundred quindecillion forty-two"+  .+  French, which contains some traces of a base 20 system:+  .+  >>> import qualified Text.Numeral.Language.FR as FR+  >>> FR.cardinal (-99) :: Maybe String+  Just "moins quatre-vingt-dix-neuf"+  .+  Conversions can fail. Alamblak, a language spoken by a few people in+  Papua New Guinea, has no representation for negative numbers:+  .+  >>> import qualified Text.Numeral.Language.AMP as AMP+  >>> AMP.cardinal (-3) :: Maybe String+  Nothing+  .+  Some languages have multiple scripts and methods for writing number+  names. Take Chinese for example, which can be written using Han+  characters or transcribed to the Latin script using Pinyin.+  .+  Traditional Chinese characters:+  .+  >>> import qualified Text.Numeral.Language.ZH as ZH+  >>> ZH.trad_cardinal 123456 :: Maybe String+  Just "十二萬三千四百五十六"+  .+  Simplified characters for use in financial contexts:+  .+  >>> ZH.finance_simpl_cardinal 123456 :: Maybe String+  Just "拾贰万参仟肆伯伍拾陆"+  .+  Transcribed using Pinyin:+  .+  >>> ZH.pinyin_cardinal 123456 :: Maybe String+  Just "shíèrwàn sānqiān sìbǎi wǔshí liù"+  .+  Using the 'struct' functions you can see the grammatical structure+  of number names. Because the results of these functions are+  polymorphic you need to specify a specific type.+  .+  >>> import qualified Text.Numeral.Language.NL as NL+  >>> NL.struct 123 :: Maybe Integer+  Just 123+  >>> import Text.Numeral+  >>> NL.struct 123 :: Maybe Exp+  Just (Add (Lit 100) (Add (Lit 3) (Mul (Lit 2) (Lit 10))))+  .+  Compare with:+  .+  >>> NL.cardinal 123 :: Maybe String+  Just "honderddrieëntwintig"+  .+  100 (honderd) + (3 (drie) + (ën) 2 (twin) * 10 (tig)) -extra-source-files: ./TODO-                  , ./README-                  , ./LICENSE-                  , ./Text/Numeral/Debug.hs+extra-source-files: ./README.markdown -flag specialise-  description: Specialise the polymorphic language definitions to some-               often used types (String, ByteString, DString). Note-               that this increases compilation time and the size of-               the object files significantly.-               Also see README-  default: False+------------------------------------------------------------------------------- +source-repository head+  Type: git+  Location: git://github.com/roelvandijk/numerals.git++-------------------------------------------------------------------------------+ library-  if flag(specialise)-    CPP-Options: -DDO_SPECIALISE+  hs-source-dirs: src+  ghc-options: -Wall -  GHC-Options: -O2+  build-depends: base                       >= 3.0.3.1 && < 4.4+               , base-unicode-symbols       >= 0.1.1   && < 0.3+               , containers                 >= 0.4     && < 0.5+               , containers-unicode-symbols >= 0.3     && < 0.4+               , numerals-base              >= 0.3     && < 0.4 -  build-depends: base >=2-               , mtl ==1.1.*-               , dstring <0.3-               , pretty >=1 && <1.1-               , text >=0.1 && <0.2-               , bytestring >=0.9 && <1+  exposed-modules: Text.Numeral.Language.AMP+                 , Text.Numeral.Language.CHN+                 , Text.Numeral.Language.DE+                 , Text.Numeral.Language.EN+                 , Text.Numeral.Language.EO+                 , Text.Numeral.Language.ES+                 , Text.Numeral.Language.FR+                 , Text.Numeral.Language.GV+                 , Text.Numeral.Language.IT+                 , Text.Numeral.Language.JA+                 , Text.Numeral.Language.LA+                 , Text.Numeral.Language.MG+                 , Text.Numeral.Language.NL+                 , Text.Numeral.Language.NO+                 , Text.Numeral.Language.NQM+                 , Text.Numeral.Language.OJ+              -- , Text.Numeral.Language.PAA+                 , Text.Numeral.Language.PT+                 , Text.Numeral.Language.RU+                 , Text.Numeral.Language.SCO+                 , Text.Numeral.Language.SV+                 , Text.Numeral.Language.TR+                 , Text.Numeral.Language.WO+                 , Text.Numeral.Language.YOR+                 , Text.Numeral.Language.ZH -  exposed-modules: Text.Numeral-                   , Text.Numeral.Language-                     , Text.Numeral.Language.NL-                     , Text.Numeral.Language.DE-                     , Text.Numeral.Language.EN-                     , Text.Numeral.Language.SV-                     , Text.Numeral.Language.NO-                     , Text.Numeral.Language.FR-                     , Text.Numeral.Language.IT-                     , Text.Numeral.Language.LA-                     , Text.Numeral.Language.PT-                     , Text.Numeral.Language.SP-                     , Text.Numeral.Language.JA-                     , Text.Numeral.Language.EO-                   , Text.Numeral.Pelletier-                   , Text.Numeral.Positional-                   , Text.Numeral.Roman-                   , Text.Numeral.Joinable-                   , Text.Numeral.Misc-                   -- , Text.Numeral.Debug+-------------------------------------------------------------------------------++test-suite test-numerals+  type: exitcode-stdio-1.0+  main-is: test.hs+  hs-source-dirs: src, test++  other-modules: Text.Numeral.Language.CHN.TestData+               , Text.Numeral.Language.AMP.TestData+               , Text.Numeral.Language.DE.TestData+               , Text.Numeral.Language.EN.TestData+               , Text.Numeral.Language.EO.TestData+               , Text.Numeral.Language.ES.TestData+               , Text.Numeral.Language.FR.TestData+               , Text.Numeral.Language.GV.TestData+               , Text.Numeral.Language.IT.TestData+               , Text.Numeral.Language.JA.TestData+               , Text.Numeral.Language.LA.TestData+               , Text.Numeral.Language.MG.TestData+               , Text.Numeral.Language.NL.TestData+               , Text.Numeral.Language.NO.TestData+               , Text.Numeral.Language.NQM.TestData+               , Text.Numeral.Language.OJ.TestData+            -- , Text.Numeral.Language.PAA.TestData+               , Text.Numeral.Language.PT.TestData+               , Text.Numeral.Language.RU.TestData+               , Text.Numeral.Language.SCO.TestData+               , Text.Numeral.Language.SV.TestData+               , Text.Numeral.Language.TR.TestData+               , Text.Numeral.Language.WO.TestData+               , Text.Numeral.Language.YOR.TestData+               , Text.Numeral.Language.ZH.TestData+  ghc-options: -Wall++  build-depends: base                       >= 3.0.3.1 && < 4.4+               , base-unicode-symbols       >= 0.1.1   && < 0.3+               , containers                 >= 0.4     && < 0.5+               , containers-unicode-symbols >= 0.3     && < 0.4+               , numerals-base              >= 0.3     && < 0.4+               , HUnit                      >= 1.2.2   && < 1.3+               , test-framework             >= 0.3.3   && < 0.5+               , test-framework-hunit       >= 0.2.6   && < 0.3+
+ src/Text/Numeral/Language/AMP.hs view
@@ -0,0 +1,88 @@+{-# LANGUAGE NoImplicitPrelude+           , OverloadedStrings+           , PackageImports+           , UnicodeSyntax+  #-}++{-|+[@ISO639-1@]        -++[@ISO639-2@]        -++[@ISO639-3@]        amp++[@Native name@]     -++[@English name@]    Alamblak+-}++module Text.Numeral.Language.AMP+    ( cardinal+    , struct+    ) where+++-------------------------------------------------------------------------------+-- Imports+-------------------------------------------------------------------------------++import "base" Data.Function ( ($), const, fix )+import "base" Data.Maybe    ( Maybe(Just) )+import "base" Data.Monoid   ( Monoid )+import "base" Data.String   ( IsString )+import "base" Prelude       ( Integral )+import "base-unicode-symbols" Data.Function.Unicode ( (∘) )+import qualified "containers" Data.Map as M ( fromList, lookup )+import "numerals-base" Text.Numeral+import qualified "numerals-base" Text.Numeral.Exp.Classes as C+++-------------------------------------------------------------------------------+-- AMP+-------------------------------------------------------------------------------++{-+Sources:+  http://www.sf.airnet.ne.jp/~ts/language/number/alamblak.html+-}++cardinal ∷ (Integral α, Monoid s, IsString s) ⇒ α → Maybe s+cardinal = cardinalRepr ∘ struct++struct ∷ (Integral α, C.Unknown β, C.Lit β, C.Add β, C.Mul β) ⇒ α → β+struct = checkPos+       $ fix+       $ findRule ( 1, lit       )+                [ ( 3, add  2 R  )+                , ( 5, lit       )+                , ( 6, add  5 R  )+                , (10, mul  5 R R)+                , (20, lit       )+                , (21, add 20 R  )+                , (40, mul 20 R R)+                ]+                  399++cardinalRepr ∷ (Monoid s, IsString s) ⇒ Exp → Maybe s+cardinalRepr = render defaultRepr+               { reprValue = \n → M.lookup n syms+               , reprAdd   = Just (⊞)+               , reprMul   = Just $ \_ _ _ → " "+               }+    where+      (Lit 2 ⊞ Lit _) _ = "i"+      (_     ⊞ _    ) _ = "i "++      syms =+          M.fromList+          [ (1,  const "rpat")+          , (2,  const "hosf")+          , (5,  \c → case c of+                        CtxMul L _ _ → "tir"+                        _            → "tir yohtt"+            )+          , (20, \c → case c of+                        CtxMul L _ _ → "yima"+                        _            → "yima yohtt"+            )+          ]
+ src/Text/Numeral/Language/CHN.hs view
@@ -0,0 +1,76 @@+{-# LANGUAGE NoImplicitPrelude+           , OverloadedStrings+           , PackageImports+           , UnicodeSyntax+  #-}++{-|+[@ISO639-1@]        -++[@ISO639-2B@]       chn++[@ISO639-3@]        chn++[@Native name@]     -++[@English name@]    Chinook Jargon+-}++module Text.Numeral.Language.CHN+    ( cardinal+    , struct+    ) where+++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++import "base" Data.Function ( ($), const, fix )+import "base" Data.Maybe    ( Maybe(Just) )+import "base" Data.Monoid   ( Monoid )+import "base" Data.String   ( IsString )+import "base" Prelude       ( Integral )+import "base-unicode-symbols" Data.Function.Unicode ( (∘) )+import qualified "containers" Data.Map as M ( fromList, lookup )+import "numerals-base" Text.Numeral+import qualified "numerals-base" Text.Numeral.Exp.Classes as C+++--------------------------------------------------------------------------------+-- CHN+--------------------------------------------------------------------------------++cardinal ∷ (Integral α, Monoid s, IsString s) ⇒ α → Maybe s+cardinal = cardinalRepr ∘ struct++struct ∷ (Integral α, C.Unknown β, C.Lit β, C.Add β, C.Mul β) ⇒ α → β+struct = checkPos+       $ fix+       $ findRule (  0, lit           )+                [ ( 11, step 10 10 R L)+                , (100, lit           )+                ]+                   100++cardinalRepr ∷ (Monoid s, IsString s) ⇒ Exp → Maybe s+cardinalRepr = render defaultRepr+               { reprValue = \n → M.lookup n syms+               , reprAdd   = Just $ \_ _ _ → " pe "+               , reprMul   = Just $ \_ _ _ → " "+               }+    where+      syms =+          M.fromList+          [ (1, const "ikt")+          , (2, const "mokst")+          , (3, const "klone")+          , (4, const "lakit")+          , (5, const "kwinnum")+          , (6, const "taghum")+          , (7, const "sinamokst")+          , (8, const "stotekin")+          , (9, const "kwaist")+          , (10, const "tahtlum")+          , (100, const "tukamonuk")+          ]
+ src/Text/Numeral/Language/DE.hs view
@@ -0,0 +1,142 @@+{-# LANGUAGE NoImplicitPrelude+           , OverloadedStrings+           , PackageImports+           , UnicodeSyntax+  #-}++{-|+[@ISO639-1@]        de++[@ISO639-2B@]       ger++[@ISO639-3@]        deu++[@Native name@]     Deutsch++[@English name@]    German+-}++module Text.Numeral.Language.DE+    ( cardinal+    , struct+    ) where+++-------------------------------------------------------------------------------+-- Imports+-------------------------------------------------------------------------------++import "base" Data.Bool     ( otherwise )+import "base" Data.Function ( ($), const, fix )+import "base" Data.Maybe    ( Maybe(Just) )+import "base" Data.Monoid   ( Monoid )+import "base" Data.String   ( IsString )+import "base" Prelude       ( Integral, (-), Integer )+import "base-unicode-symbols" Data.Function.Unicode ( (∘) )+import "base-unicode-symbols" Data.List.Unicode     ( (∈) )+import "base-unicode-symbols" Data.Ord.Unicode      ( (≥) )+import qualified "containers" Data.Map as M ( fromList, lookup )+import           "numerals-base" Text.Numeral+import           "numerals-base" Text.Numeral.Misc ( dec )+import qualified "numerals-base" Text.Numeral.BigNum      as BN+import qualified "numerals-base" Text.Numeral.Exp.Classes as C+++-------------------------------------------------------------------------------+-- DE+-------------------------------------------------------------------------------++{-+Sources:+  http://de.wikipedia.org/wiki/Zahlennamen+-}++cardinal ∷ (Integral α, C.Scale α, Monoid s, IsString s) ⇒ α → Maybe s+cardinal = cardinalRepr ∘ struct++struct ∷ ( Integral α, C.Scale α+         , C.Unknown β, C.Lit β, C.Neg β, C.Add β, C.Mul β, C.Scale β+         )+       ⇒ α → β+struct = pos $ fix $ rule `combine` pelletierScale R L BN.rule+    where+      rule = findRule (   0, lit       )+                    [ (  13, add 10 L  )+                    , (  20, mul 10 L L)+                    , ( 100, step1 100   10 R L)+                    , (1000, step 1000 1000 R L)+                    ]+                      (dec 6 - 1)++cardinalRepr ∷ (Monoid s, IsString s) ⇒ Exp → Maybe s+cardinalRepr = render defaultRepr+               { reprValue = \n → M.lookup n syms+               , reprScale = pelletierRepr+               , reprAdd   = Just (⊞)+               , reprMul   = Just $ \_ _ _ → ""+               , reprNeg   = Just $ \_ _   → "minus "+               }+    where+      (_ ⊞ (_ `Mul` Lit 10)) _ = "und"+      (_ ⊞ _               ) _ = ""++      syms =+          M.fromList+          [ (0, const "null")+          , (1, \c → case c of+                       CtxAdd {}        → "ein"+                       CtxMul _ (Lit n) _+                           | n ≥ dec 6  → "eine"+                           | n ≥ 100    → "ein"+                       _                → "eins"+            )+          , (2, \c → case c of+                       CtxMul _ (Lit 10) _ → "zwan"+                       _                   → "zwei"+            )+          , (3, const "drei")+          , (4, const "vier")+          , (5, const "fünf")+          , (6, \c → case c of+                       CtxAdd _ (Lit 10) _ → "sech"+                       CtxMul _ (Lit 10) _ → "sech"+                       _                   → "sechs"+            )+          , (7, \c → case c of+                       CtxAdd _ (Lit 10) _ → "sieb"+                       CtxMul _ (Lit 10) _ → "sieb"+                       _                   → "sieben"+            )+          , (8, const "acht")+          , (9, const "neun")+          , (10, \c → case c of+                        CtxMul _ (Lit 3) _ → "ßig"+                        CtxMul _ (Lit _) _ → "zig"+                        _                  → "zehn"+            )+          , (11, const "elf")+          , (12, const "zwölf")+          , (100, const "hundert")+          , (1000, const "tausend")+          ]++pelletierRepr ∷ (IsString s, Monoid s)+              ⇒ Integer → Integer → Exp → Ctx Exp → Maybe s+pelletierRepr =+    BN.pelletierRepr+      "illion"   "illion"+      "illiarde" "illiarde"+      [ (8, BN.forms "okt" "okto" "okto" "okto" "oktin")+      , (10, \c → case c of+                    CtxAdd _ (Lit 100) _              → "dezi"+                    CtxMul _ _ (CtxAdd _ (Lit 100) _) → "ginta"+                    CtxMul {}                         → "gint"+                    _                                 → "dez"+        )+      , (100, \c → case c of+                     CtxMul _ (Lit n) _+                         | n ∈ [2,3,6] → "zent"+                         | otherwise   → "gent"+                     _                 → "zent"+        )+      ]
+ src/Text/Numeral/Language/EN.hs view
@@ -0,0 +1,146 @@+{-# LANGUAGE NoImplicitPrelude+           , OverloadedStrings+           , PackageImports+           , UnicodeSyntax+  #-}++{-|+[@ISO639-1@]        en++[@ISO639-2B@]       eng++[@ISO639-3@]        eng++[@Native name@]     English++[@English name@]    English+-}++module Text.Numeral.Language.EN+    ( uk_cardinal+    , ukPelletier_cardinal+    , us_cardinal+    , shortScaleStruct+    , longScaleStruct+    , pelletierScaleStruct+    ) where++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++import "base" Data.Bool     ( otherwise )+import "base" Data.Function ( ($), const, fix )+import "base" Data.Maybe    ( Maybe(Just) )+import "base" Data.Monoid   ( Monoid )+import "base" Data.Ord      ( (<) )+import "base" Data.String   ( IsString )+import "base" Prelude       ( Integral, (-), Integer )+import "base-unicode-symbols" Data.Function.Unicode ( (∘) ) +import qualified "containers" Data.Map as M ( fromList, lookup )+import           "numerals-base" Text.Numeral+import           "numerals-base" Text.Numeral.Misc ( dec )+import qualified "numerals-base" Text.Numeral.Exp.Classes as C+import qualified "numerals-base" Text.Numeral.BigNum as BN ( rule, scaleRepr, pelletierRepr )+++--------------------------------------------------------------------------------+-- EN+--------------------------------------------------------------------------------++uk_cardinal ∷ (Integral α, C.Scale α, Monoid s, IsString s) ⇒ α → Maybe s+uk_cardinal = render uk_cardinalRepr' ∘ shortScaleStruct++ukPelletier_cardinal ∷ (Integral α, C.Scale α, Monoid s, IsString s)+                     ⇒ α → Maybe s+ukPelletier_cardinal = render uk_cardinalRepr' { reprScale = pelletierRepr }+                     ∘ pelletierScaleStruct+  where+    pelletierRepr = BN.pelletierRepr "illion"  "illion"+                                     "illiard" "illiard"+                                     []++us_cardinal ∷ (Integral α, C.Scale α, Monoid s, IsString s) ⇒ α → Maybe s+us_cardinal = render (cardinalRepr (⊞)) ∘ shortScaleStruct+  where+    ((_ `Mul` Lit 10) ⊞ _) _ = "-"+    ((_ `Mul` _     ) ⊞ _) _ = " "+    (_                ⊞ _) _ = ""++shortScaleStruct ∷ ( Integral α, C.Scale α+                   , C.Unknown β, C.Lit β, C.Neg β, C.Add β, C.Mul β, C.Scale β+                   )+                 ⇒ α → β+shortScaleStruct = pos $ fix $ rule `combine` shortScale1 R L BN.rule++longScaleStruct ∷ ( Integral α, C.Scale α+                  , C.Unknown β, C.Lit β, C.Neg β, C.Add β, C.Mul β, C.Scale β+                  )+                ⇒ α → β+longScaleStruct = pos $ fix $ rule `combine` longScale1 R L BN.rule++pelletierScaleStruct ∷ ( Integral α, C.Scale α+                       , C.Unknown β, C.Lit β, C.Neg β, C.Add β, C.Mul β, C.Scale β+                       )+                     ⇒ α → β+pelletierScaleStruct = pos $ fix $ rule `combine` pelletierScale1 R L BN.rule++rule ∷ (Integral α, C.Unknown β, C.Lit β, C.Add β, C.Mul β) ⇒ Rule α β+rule = findRule (   0, lit       )+              [ (  13, add 10 L  )+              , (  20, mul 10 R L)+              , ( 100, step1  100   10 R L)+              , (1000, step1 1000 1000 R L)+              ]+                (dec 6 - 1)++uk_cardinalRepr' ∷ (Monoid s, IsString s) ⇒ Repr s+uk_cardinalRepr' = cardinalRepr (⊞)+  where+    ((_ `Mul` Lit 10) ⊞ _) _       = "-"+    ((_ `Mul` _     ) ⊞ x) _+        | eval x < (100 ∷ Integer) = " and "+        | otherwise                = " "+    (_                ⊞ _) _       = ""++cardinalRepr ∷ (Monoid s, IsString s) ⇒ (Exp → Exp → Ctx Exp → s) → Repr s+cardinalRepr f =+    defaultRepr+    { reprValue = \n → M.lookup n syms+    , reprScale = BN.scaleRepr "illion" "illion" []+    , reprAdd   = Just f+    , reprMul   = Just (⊞)+    , reprNeg   = Just $ \_ _ → "minus "+    }+    where+      (_ ⊞ Lit 10) _ = ""+      (_ ⊞ _     ) _ = " "++      syms =+          M.fromList+          [ (0, const "zero")+          , (1, const "one")+          , (2, ten   "two"   "two"  "twen")+          , (3, ten   "three" "thir" "thir")+          , (4, ten   "four"  "four" "for")+          , (5, ten   "five"  "fif"  "fif")+          , (6, const "six")+          , (7, const "seven")+          , (8, ten   "eight" "eigh" "eigh")+          , (9, const "nine")+          , (10, \c → case c of+                        CtxAdd _ (Lit _) _ → "teen"+                        CtxMul R _       _ → "ty"+                        _                  → "ten"+            )+          , (11,   const "eleven")+          , (12,   const "twelve")+          , (100,  const "hundred")+          , (1000, const "thousand")+          ]++      ten ∷ s → s → s → Ctx Exp → s+      ten n a m = \c → case c of+                         CtxAdd _ (Lit 10) _ → a+                         CtxMul _ (Lit 10) _ → m+                         _                   → n
+ src/Text/Numeral/Language/EO.hs view
@@ -0,0 +1,78 @@+{-# LANGUAGE NoImplicitPrelude+           , OverloadedStrings+           , PackageImports+           , UnicodeSyntax+  #-}++{-|+[@ISO639-1@]        eo++[@ISO639-2B@]       epo++[@ISO639-3@]        epo++[@Native name@]     Esperanto++[@English name@]    Esperanto+-}++module Text.Numeral.Language.EO+    ( cardinal+    , struct+    ) where+++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++import "base" Data.Function ( ($), const, fix )+import "base" Data.Maybe    ( Maybe(Just) )+import "base" Data.Monoid   ( Monoid )+import "base" Data.String   ( IsString )+import "base" Prelude       ( Integral )+import "base-unicode-symbols" Data.Function.Unicode ( (∘) )+import qualified "containers" Data.Map as M ( fromList, lookup )+import           "numerals-base" Text.Numeral+import qualified "numerals-base" Text.Numeral.Exp.Classes as C+++--------------------------------------------------------------------------------+-- EO+--------------------------------------------------------------------------------++cardinal ∷ (Integral α, Monoid s, IsString s) ⇒ α → Maybe s+cardinal = cardinalRepr ∘ struct++struct ∷ (Integral α, C.Unknown β, C.Lit β, C.Add β, C.Mul β) ⇒ α → β+struct = checkPos+       $ fix+       $ findRule (  0, lit            )+                [ ( 11, step 10  10 R L)+                , (100, step 100 10 R L)+                ]+                  1000++cardinalRepr ∷ (Monoid s, IsString s) ⇒ Exp → Maybe s+cardinalRepr = render defaultRepr+               { reprValue = \n → M.lookup n syms+               , reprAdd   = Just $ \_ _ _ → " "+               , reprMul   = Just $ \_ _ _ → ""+               }+    where+      syms =+          M.fromList+          [ (0, const "nul")+          , (1, const "unu")+          , (2, const "du")+          , (3, const "tri")+          , (4, const "kvar")+          , (5, const "kvin")+          , (6, const "ses")+          , (7, const "sep")+          , (8, const "ok")+          , (9, const "naŭ")+          , (10, const "dek")+          , (100, const "cent")+          , (1000, const "mil")+          ]
+ src/Text/Numeral/Language/ES.hs view
@@ -0,0 +1,167 @@+{-# LANGUAGE NoImplicitPrelude+           , OverloadedStrings+           , PackageImports+           , UnicodeSyntax+  #-}++{-|+[@ISO639-1@]        es++[@ISO639-2B@]       spa++[@ISO639-3@]        spa++[@Native name@]     Español++[@English name@]    Spanish+-}++module Text.Numeral.Language.ES+    ( cardinal+    , struct+    ) where++-------------------------------------------------------------------------------+-- Imports+-------------------------------------------------------------------------------++import "base" Data.Function ( ($), const, fix )+import "base" Data.Maybe    ( Maybe(Just) )+import "base" Data.Monoid   ( Monoid )+import "base" Data.Ord      ( (<) )+import "base" Data.String   ( IsString )+import "base" Prelude       ( Integral, (-), Integer )+import "base-unicode-symbols" Data.Function.Unicode ( (∘) )+import qualified "containers" Data.Map as M ( fromList, lookup )+import           "numerals-base" Text.Numeral+import           "numerals-base" Text.Numeral.Misc ( dec )+import qualified "numerals-base" Text.Numeral.BigNum      as BN+import qualified "numerals-base" Text.Numeral.Exp.Classes as C+++-------------------------------------------------------------------------------+-- ES+-------------------------------------------------------------------------------++-- Sources:+--   http://www.sf.airnet.ne.jp/~ts/language/number/spanish.html+--   http://spanish.about.com/cs/forbeginners/a/cardinalnum_beg.htm+--   http://www.learn-spanish-help.com/count-in-spanish.html+--   http://www.donquijote.org/spanishlanguage/numbers/numbers1.asp+--   http://en.wiktionary.org/wiki/Appendix:Spanish_numerals++cardinal ∷ (Integral α, C.Scale α, Monoid s, IsString s) ⇒ α → Maybe s+cardinal = cardinalRepr ∘ struct++struct ∷ ( Integral α, C.Scale α+         , C.Unknown β, C.Lit β, C.Neg β, C.Add β, C.Mul β, C.Scale β+         )+       ⇒ α → β+struct = pos (fix $ rule `combine` longScale R L BN.rule)+    where+      rule = findRule (   0, lit       )+                    [ (  11, add 10 L  )+                    , (  16, add 10 R  )+                    , (  20, lit       )+                    , (  21, add 20 R  )+                    , (  30, mul 10 R L)+                    , ( 100, step  100   10 R L)+                    , (1000, step 1000 1000 R L)+                    ]+                    (dec 6 - 1)++cardinalRepr ∷ (Monoid s, IsString s) ⇒ Exp → Maybe s+cardinalRepr = render defaultRepr+               { reprValue = \n → M.lookup n syms+               , reprScale = longScaleRepr+               , reprAdd   = Just (⊞)+               , reprMul   = Just (⊡)+               , reprNeg   = Just $ \_ _ → "menos "+               }+    where+      (_                    ⊞ Lit 10) _ = ""+      (Lit 10               ⊞ _     ) _ = ""+      (Lit 20               ⊞ _     ) _ = ""+      ((Lit _ `Mul` Lit 10) ⊞ _     ) _ = " y "+      (_                    ⊞ _     ) _ = " "++      (_ ⊡ Lit n) _ | n < 1000 = ""+      (_ ⊡ _    ) _            = " "++      syms =+          M.fromList+          [ (0, const "cero")+          , (1, \c → case c of+                       CtxAdd _ (Lit 10)  _ → "on"+                       _                    → "uno"+            )+          , (2, \c → case c of+                       CtxAdd _ (Lit 10)  _ → "do"+                       CtxAdd _ (Lit 20)  _ → "dós"+                       _                    → "dos"+            )+          , (3, \c → case c of+                       CtxAdd _ (Lit 10)  _ → "tre"+                       CtxAdd _ (Lit 20)  _ → "trés"+                       CtxMul _ (Lit 10)  _ → "trein"+                       _                    → "tres"+            )+          , (4, \c → case c of+                       CtxAdd _ (Lit 10)  _ → "cator"+                       CtxMul _ (Lit 10)  _ → "cuaren"+                       _                    → "cuatro"+            )+          , (5, \c → case c of+                       CtxAdd _ (Lit 10)  _ → "quin"+                       CtxMul _ (Lit 10)  _ → "cincuen"+                       CtxMul _ (Lit 100) _ → "quin"+                       _                    → "cinco"+            )+          , (6, \c → case c of+                       CtxAdd _ (Lit 10)  _ → "séis"+                       CtxAdd _ (Lit 20)  _ → "séis"+                       CtxMul _ (Lit 10)  _ → "sesen"+                       _                    → "seis"+            )+          , (7, \c → case c of+                       CtxMul _ (Lit 10)  _ → "seten"+                       CtxMul _ (Lit 100) _ → "sete"+                       _                    → "siete"+            )+          , (8, \c → case c of+                       CtxMul _ (Lit 10)  _ → "ochen"+                       _                    → "ocho"+            )+          , (9, \c → case c of+                       CtxMul _ (Lit 10)  _ → "noven"+                       CtxMul _ (Lit 100) _ → "nove"+                       _                    → "nueve"+            )+          , (10, \c → case c of+                        CtxAdd R (Lit _)  _ → "ce"+                        CtxAdd L (Lit _)  _ → "dieci"+                        CtxMul R _        _ → "ta"+                        _                   → "diez"+            )+          , (20, \c → case c of+                        CtxAdd _ (Lit _)  _ → "veinti"+                        _                   → "veinte"+            )+          , (100, \c → case c of+                         CtxEmpty           → "cien"+                         CtxAdd {}          → "ciento"+                         CtxMul _ (Lit 5) _ → "ientos"+                         CtxMul L _       _ → "cien"+                         _                  → "cientos"+            )+          , (1000, const "mil")+          ]++longScaleRepr ∷ (IsString s, Monoid s)+              ⇒ Integer → Integer → Exp → Ctx Exp → Maybe s+longScaleRepr =+    BN.scaleRepr "illón" "illones"+                 [ (4, BN.forms "cuatr" "cuator" "cuator" "cuatra" "cuatri")+                 , (9, BN.forms "non"   "noven"  "noven"  "nona"   "non")+                 ]+
+ src/Text/Numeral/Language/FR.hs view
@@ -0,0 +1,148 @@+{-# LANGUAGE NoImplicitPrelude+           , OverloadedStrings+           , PackageImports+           , UnicodeSyntax+  #-}++{-|+[@ISO639-1@]        fr++[@ISO639-2B@]       fre++[@ISO639-3@]        fra++[@Native name@]     Français++[@English name@]    French+-}++module Text.Numeral.Language.FR+    ( cardinal+    , struct+    ) where+++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++import "base" Data.Bool     ( otherwise )+import "base" Data.Function ( ($), const, fix )+import "base" Data.Maybe    ( Maybe(Just) )+import "base" Data.Monoid   ( Monoid )+import "base" Data.Ord      ( (<) )+import "base" Data.String   ( IsString )+import "base" Prelude       ( Integral, (-), Integer )+import "base-unicode-symbols" Data.Function.Unicode ( (∘) )+import "base-unicode-symbols" Data.Ord.Unicode ( (≤), (≥) )+import qualified "containers" Data.Map as M ( fromList, lookup )+import           "numerals-base" Text.Numeral+import           "numerals-base" Text.Numeral.Misc ( dec )+import qualified "numerals-base" Text.Numeral.BigNum      as BN+import qualified "numerals-base" Text.Numeral.Exp.Classes as C+++--------------------------------------------------------------------------------+-- FR+--------------------------------------------------------------------------------++{-+Sources:+  http://www.sf.airnet.ne.jp/~ts/language/number/french.html+  http://www.french-linguistics.co.uk/tutorials/numbers/+-}++cardinal ∷ (Integral α, C.Scale α, Monoid s, IsString s) ⇒ α → Maybe s+cardinal = cardinalRepr ∘ struct++struct ∷ ( Integral α, C.Scale α+         , C.Unknown β, C.Lit β, C.Neg β, C.Add β, C.Mul β, C.Scale β+         )+       ⇒ α → β+struct = pos $ fix $ rule `combine` pelletierScale1 R L BN.rule+    where+      rule = findRule (   0, lit         )+                    [ (  11, add   10 L  )+                    , (  17, add   10 R  )+                    , (  20, lit         )+                    , (  21, add   20 R  )+                    , (  30, mul   10 R L)+                    , (  70, add   60 R  )+                    , (  80, mul   20 R L)+                    , (  89, add   80 R  )+                    , ( 100, step  100   10 R L)+                    , (1000, step 1000 1000 R L)+                    ]+                      (dec 6 - 1)++cardinalRepr ∷ (Monoid s, IsString s) ⇒ Exp → Maybe s+cardinalRepr = render defaultRepr+               { reprValue = \n → M.lookup n syms+               , reprScale = pelletierRepr+               , reprAdd   = Just (⊞)+               , reprMul   = Just (⊡)+               , reprNeg   = Just $ \_ _ → "moins "+               }+    where+      (Lit n                ⊞ Lit 10) _       | n ≤ 6 = ""+      (Lit 10               ⊞ Lit n ) _       | n ≥ 7 = "-"+      ((Lit 4 `Mul` Lit 20) ⊞ _     ) _               = "-"+      (_                    ⊞ (Lit 1 `Add` Lit 10)) _ = " et "+      (_                    ⊞ Lit 1               ) _ = " et "+      ((Lit _ `Mul` Lit 10) ⊞ _                   ) _ = "-"+      (Lit 20               ⊞ _                   ) _ = "-"+      (_                    ⊞ _                   ) _ = " "++      (_ ⊡ Lit 10) _ = ""+      (_ ⊡ Lit 20) _ = "-"+      (_ ⊡ _     ) _ = " "++      syms =+          M.fromList+          [ (0, const "zéro")+          , (1, ten   "un"     "on"     "un")+          , (2, ten   "deux"   "dou"    "deux")+          , (3, ten   "trois"  "trei"   "tren")+          , (4, ten   "quatre" "quator" "quar")+          , (5, ten   "cinq"   "quin"   "cinqu")+          , (6, ten   "six"    "sei"    "soix")+          , (7, const "sept")+          , (8, const "huit")+          , (9, const "neuf")+          , (10, \c → case c of+                        CtxAdd _ (Lit n) _ | n < 7     → "ze"+                                           | otherwise → "dix"+                        CtxMul _ (Lit 3) _             → "te"+                        CtxMul R _       _             → "ante"+                        _                              → "dix"+            )+          , (20, \c → case c of+                        CtxMul _ _ CtxEmpty → "vingts"+                        _                   → "vingt"+            )+          , (100, \c → case c of+                         CtxMul R _ CtxEmpty → "cents"+                         _                   → "cent"+            )+          , (1000, const "mille")+          ]++      ten n a m ctx = case ctx of+                        CtxAdd _ (Lit 10) _ → a+                        CtxMul _ (Lit 10) _ → m+                        _                   → n++pelletierRepr ∷ (IsString s, Monoid s)+              ⇒ Integer → Integer → Exp → Ctx Exp → Maybe s+pelletierRepr = BN.pelletierRepr+                  "illion" "illions"+                  "illiard" "illiards"+                  [ (1, BN.forms "m"  "uno" "uno"  ""    "")+                  , (3, BN.forms "tr" "tré" "tres" "tri" "tre")+                  , (10, \c → case c of+                                CtxAdd _ (Lit 100) _              → "deci"+                                CtxMul _ _ (CtxAdd _ (Lit 100) _) → "ginta"+                                CtxMul {}                         → "gint"+                                _                                 → "déc"+                    )+                  ]
+ src/Text/Numeral/Language/GV.hs view
@@ -0,0 +1,108 @@+{-# LANGUAGE NoImplicitPrelude+           , OverloadedStrings+           , PackageImports+           , UnicodeSyntax+  #-}++{-|+[@ISO639-1@]        gv++[@ISO639-2@]        glv++[@ISO639-3@]        glv++[@Native name@]     Gaelg++[@English name@]    Manx+-}++module Text.Numeral.Language.GV+    ( cardinal+    , struct+    ) where+++-------------------------------------------------------------------------------+-- Imports+-------------------------------------------------------------------------------++import "base" Data.Function ( ($), const, fix )+import "base" Data.Maybe    ( Maybe(Just) )+import "base" Data.Monoid   ( Monoid )+import "base" Data.String   ( IsString )+import "base" Prelude       ( Integral )+import "base-unicode-symbols" Data.Function.Unicode ( (∘) )+import qualified "containers" Data.Map as M ( fromList, lookup )+import           "numerals-base" Text.Numeral+import qualified "numerals-base" Text.Numeral.Exp.Classes as C+++-------------------------------------------------------------------------------+-- GV+-------------------------------------------------------------------------------++{-+Sources:+  http://www.sf.airnet.ne.jp/~ts/language/number/manx.html+  http://www.gaelg.iofm.net/LESSONS/P/P19.html+  http://www.gaelg.iofm.net/LESSONS/mona/Lessons.pdf+-}++cardinal ∷ (Integral α, Monoid s, IsString s) ⇒ α → Maybe s+cardinal = cardinalRepr ∘ struct++struct ∷ (Integral α, C.Unknown β, C.Lit β, C.Add β, C.Mul β) ⇒ α → β+struct = checkPos+       $ fix+       $ findRule (   1, lit       )+                [ (  11, add 10 L  )+                , (  20, lit       )+                , (  21, add 20 L  )+                , (  40, lit       )+                , (  41, add 40 L  )+                , (  60, mul 20 R L)+                , ( 100, step 100 10 R L)+                , (1000, lit)+                ]+                   1000++cardinalRepr ∷ (Monoid s, IsString s) ⇒ Exp → Maybe s+cardinalRepr = render defaultRepr+               { reprValue = \n → M.lookup n syms+               , reprAdd   = Just (⊞)+               , reprMul   = Just $ \_ _ _ → " "+               }+    where+      ((Lit _ `Mul` Lit 20) ⊞ Lit 10) _ = " as "+      (_                    ⊞ Lit 10) _ = "-"+      (_                    ⊞ _     ) _ = " as "++      syms =+          M.fromList+          [ (1, const "nane")+          , (2, \c → case c of+                       CtxAdd _ (Lit 10) _ → "daa"+                       CtxMul {}           → "daa"+                       _                   → "jees"+            )+          , (3, const "tree")+          , (4, const "kiare")+          , (5, const "queig")+          , (6, const "shey")+          , (7, const "shiaght")+          , (8, const "hoght")+          , (9, const "nuy")+          , (10, \c → case c of+                        CtxAdd _ (Lit 2)              _ → "yeig"+                        CtxAdd _ (Lit _ `Mul` Lit 20) _ → "jeih"+                        CtxAdd R _                    _ → "jeig"+                        _                               → "jeih"+            )+          , (20, const "feed")+          , (40, const "daeed")+          , (100, \c → case c of+                         CtxMul {} → "cheead"+                         _         → "keead"+            )+          , (1000, const "thousane")+          ]
+ src/Text/Numeral/Language/IT.hs view
@@ -0,0 +1,173 @@+{-# LANGUAGE NoImplicitPrelude+           , OverloadedStrings+           , PackageImports+           , UnicodeSyntax+  #-}++{-|+[@ISO639-1@]        it++[@ISO639-2B@]       ita++[@ISO639-3@]        ita++[@Native name@]     Italiano++[@English name@]    Italian+-}++module Text.Numeral.Language.IT+    ( cardinal+    , struct+    ) where+++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++import "base" Data.Function ( ($), const, fix )+import "base" Data.Maybe    ( Maybe(Just) )+import "base" Data.Monoid   ( Monoid )+import "base" Data.String   ( IsString )+import "base" Prelude       ( Integral, (-), Integer )+import "base-unicode-symbols" Data.Function.Unicode ( (∘) )+import "base-unicode-symbols" Data.List.Unicode     ( (∈) )+import "base-unicode-symbols" Data.Ord.Unicode      ( (≥) )+import qualified "containers" Data.Map as M ( fromList, lookup )+import           "numerals-base" Text.Numeral+import           "numerals-base" Text.Numeral.Misc ( dec )+import qualified "numerals-base" Text.Numeral.BigNum      as BN+import qualified "numerals-base" Text.Numeral.Exp.Classes as C+++--------------------------------------------------------------------------------+-- IT+--------------------------------------------------------------------------------++-- Sources:+--   http://www.sf.airnet.ne.jp/~ts/language/number/italian.html+--   http://www.orbilat.com/Languages/Italian/Grammar/Italian-Numerals.html+--   http://italian.about.com/library/weekly/aa042600a.htm+--   http://www.suite101.com/content/how-to-count-in-italian-a146487++cardinal ∷ (Integral α, C.Scale α, Monoid s, IsString s) ⇒ α → Maybe s+cardinal = cardinalRepr ∘ struct++struct ∷ ( Integral α, C.Scale α+         , C.Unknown β, C.Lit β, C.Neg β, C.Add β, C.Mul β, C.Scale β+         )+       ⇒ α → β+struct = pos $ fix $ rule `combine` pelletierScale R L BN.rule+    where+      rule = findRule (   0, lit         )+                    [ (  11, add   10 L  )+                    , (  17, add   10 R  )+                    , (  20, lit         )+                    , (  21, add   20 R  )+                    , (  30, mul   10 R L)+                    , ( 100, step  100   10 R L)+                    , (1000, step 1000 1000 R L)+                    ]+                      (dec 6 - 1)++cardinalRepr ∷ (Monoid s, IsString s) ⇒ Exp → Maybe s+cardinalRepr = render defaultRepr+               { reprValue = \n → M.lookup n syms+               , reprScale = pelletierRepr+               , reprAdd   = Just (⊞)+               , reprMul   = Just (⊡)+               , reprNeg   = Just $ \_ _ → "meno "+               }+    where+      (Lit 10                ⊞ Lit 7) _ = "as"+      (Lit 10                ⊞ Lit 9) _ = "an"+      ((_ `Mul` Scale _ _ _) ⊞ _    ) _ = " "+      (_                     ⊞ _    ) _ = ""+++      (Lit n ⊡ Lit 10) _ | n ≥ 4 = "an"+      (_     ⊡ Scale _ _ _) _ = " "+      (_     ⊡ _          ) _ = ""++      syms =+          M.fromList+          [ (0, const "zero")+          , (1, \c → case c of+                       CtxAdd _ (Lit 10) _ → "un"+                       _                   → "uno"+            )+          , (2, \c → case c of+                       CtxAdd _ (Lit 10) _ → "do"+                       _                   → "due"+            )+          , (3, \c → case c of+                       CtxAdd R _        _ → "tré"+                       CtxMul _ (Lit 10) _ → "tren"+                       _                   → "tre"+            )+          , (4, \c → case c of+                       CtxAdd _ (Lit 10) _ → "quattor"+                       CtxMul _ (Lit 10) _ → "quar"+                       _                   → "quattro"+            )+          , (5, \c → case c of+                       CtxAdd _ (Lit 10) _ → "quin"+                       CtxMul _ (Lit 10) _ → "cinqu"+                       _                   → "cinque"+            )+          , (6, \c → case c of+                       CtxAdd _ (Lit 10) _ → "se"+                       CtxMul _ (Lit 10) _ → "sess"+                       _                   → "sei"+            )+          , (7, \c → case c of+                       CtxMul _ (Lit 10) _ → "sett"+                       _                   → "sette"+            )+          , (8, \c → case c of+                       CtxMul _ (Lit 10) _ → "ott"+                       _                   → "otto"+            )+          , (9, \c → case c of+                       CtxMul _ (Lit 10) _ → "nov"+                       _                   → "nove"+            )+          , (10, \c → case c of+                        CtxAdd _ (Lit _) _ → "dici"+                        -- Last vowel removed because of a+                        -- phonetic rule:+                        CtxMul _ (Lit _) (CtxAdd _ (Lit n) _)+                            | n ∈ [1,8]    → "t"+                        CtxMul R (Lit _) _ → "ta"+                        _                  → "dieci"+            )+          , (20, \c → case c of+                        CtxAdd _ (Lit n) _+                            | n ∈ [1,8]   → "vent"+                        _                 → "venti"+            )+          , ( 100+            , let f c = case c of+                          CtxAdd _ (Lit 8)                      _  → "cent"+                          CtxAdd _ (Lit 8 `Mul` Lit 10)         _  → "cent"+                          CtxAdd _ (Lit 8 `Mul` Lit 10 `Add` _) _  → "cent"+                          CtxMul _ (Lit _) c2 → f c2+                          _ → "cento"+              in f+            )+          , (1000, \c → case c of+                          CtxMul {} → "mila"+                          _         → "mille"+            )+          ]++pelletierRepr ∷ (IsString s, Monoid s)+              ⇒ Integer → Integer → Exp → Ctx Exp → Maybe s+pelletierRepr = BN.pelletierRepr+                  "ilione"  "ilioni"+                  "iliardo" "iliardi"+                  [ (6, BN.forms "sest" "sex"    "ses"    "sexa"   "ses")+                  , (7, BN.forms "sett" "septen" "septem" "septua" "septin")+                  , (8, BN.forms "ott"  "otto"   "otto"   "otto"   "ottin")+                  ]
+ src/Text/Numeral/Language/JA.hs view
@@ -0,0 +1,223 @@+{-# LANGUAGE NoImplicitPrelude+           , OverloadedStrings+           , PackageImports+           , UnicodeSyntax+  #-}++{-|+[@ISO639-1@]        ja++[@ISO639-2B@]       jpn++[@ISO639-3@]        jpn++[@Native name@]     日本語++[@English name@]    Japanese+-}++module Text.Numeral.Language.JA+    ( struct+    , kanji_cardinal+    , daiji_cardinal+    , on'yomi_cardinal+    , preferred_cardinal+    ) where+++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++import "base" Data.Function ( ($), const, fix )+import "base" Data.List     ( map )+import "base" Data.Maybe    ( Maybe(Just) )+import "base" Data.Monoid   ( Monoid )+import "base" Data.String   ( IsString )+import "base" Prelude       ( Num, Integral, (-) )+import "base-unicode-symbols" Data.Function.Unicode ( (∘) )+import "base-unicode-symbols" Data.Monoid.Unicode   ( (⊕) )+import qualified "containers" Data.Map as M ( fromList, lookup )+import           "numerals-base" Text.Numeral+import           "numerals-base" Text.Numeral.Misc  ( dec )+import qualified "numerals-base" Text.Numeral.Exp.Classes as C+++--------------------------------------------------------------------------------+-- JA+--------------------------------------------------------------------------------++{-+Sources:+  http://en.wikipedia.org/wiki/Japanese_numerals+  http://www.guidetojapanese.org/numbers.html+-}++struct ∷ (Integral α, C.Unknown β, C.Lit β, C.Neg β, C.Add β, C.Mul β) ⇒ α → β+struct = pos+       $ fix+       $ findRule (   0, lit             )+              ( [ (  11, add    10    R  )+                , (  20, mul    10    R L)+                , ( 100, step  100 10 R L)+                , (1000, step 1000 10 R L)+                ]+              ⊕ [ (n, step1 n (dec 4) R L) | n ← map dec [4,8..68] ]+              )+             (dec 72 - 1)+++--------------------------------------------------------------------------------+-- Kanji+--------------------------------------------------------------------------------++kanji_cardinal ∷ (Integral α, Monoid s, IsString s) ⇒ α → Maybe s+kanji_cardinal = kanji_cardinal_repr ∘ struct++kanji_cardinal_repr ∷ (Monoid s, IsString s) ⇒ Exp → Maybe s+kanji_cardinal_repr = render defaultRepr+                      { reprValue = \n → M.lookup n syms+                      , reprAdd   = Just $ \_ _ _ → ""+                      , reprMul   = Just $ \_ _ _ → ""+                      , reprNeg   = Just $ \_ _   → "マイナス"+                      }+    where+      syms =+          M.fromList+          [ (0, const "零") -- alternatives:"ゼロ" or "マル"+          , (1, const "一")+          , (2, const "二")+          , (3, const "三")+          , (4, const "四")+          , (5, const "五")+          , (6, const "六")+          , (7, const "七")+          , (8, const "八")+          , (9, const "九")+          , (10, const "十")+          , (100, const "百")+          , (dec 3, const "千")+          , (dec 4, const "万")+          , (dec 8, const "億")+          , (dec 12, const "兆")+          , (dec 16, const "京")+          , (dec 20, const "垓")+          , (dec 24, const "𥝱") -- or 秭?+          , (dec 28, const "穣")+          , (dec 32, const "溝")+          , (dec 36, const "澗")+          , (dec 40, const "正")+          , (dec 44, const "載")+          , (dec 48, const "極")+          , (dec 52, const "恒河沙")+          , (dec 56, const "阿僧祇")+          , (dec 60, const "那由他/那由多")+          , (dec 64, const "不可思議")+          , (dec 68, const "無量大数")+          ]+++--------------------------------------------------------------------------------+-- Daiji+--------------------------------------------------------------------------------++daiji_cardinal ∷ (Integral α, Monoid s, IsString s) ⇒ α → Maybe s+daiji_cardinal = daiji_cardinal_repr ∘ struct++daiji_cardinal_repr ∷ (Monoid s, IsString s) ⇒ Exp → Maybe s+daiji_cardinal_repr = render defaultRepr+                      { reprValue = \n → M.lookup n syms+                      , reprAdd   = Just $ \_ _ _ → ""+                      , reprMul   = Just $ \_ _ _ → ""+                      , reprNeg   = Just $ \_ _   → "マイナス"+                      }+    where+      syms =+          M.fromList+          [ (0, const "零") -- alternatives:"ゼロ" or "マル"+          , (1, const "壱")+          , (2, const "弐")+          , (3, const "参")+          , (4, const "四")+          , (5, const "五")+          , (6, const "六")+          , (7, const "七")+          , (8, const "八")+          , (9, const "九")+          , (10, const "拾")+          , (100, const "百")+          , (dec 3, const "千")+          , (dec 4, const "万")+          ]+++--------------------------------------------------------------------------------+-- Generic reading+--------------------------------------------------------------------------------++generic_repr ∷ (Monoid s, IsString s) ⇒ s → s → Repr s+generic_repr four seven = defaultRepr+                          { reprValue = \n → M.lookup n syms+                          , reprAdd   = Just $ \_ _ _ → " "+                          , reprMul   = Just $ \_ _ _ → ""+                          , reprNeg   = Just $ \_ _   → "mainasu "+                          }+    where+      syms =+          M.fromList+          [ (0, const "rei")+          , (1, const "ichi")+          , (2, const "ni")+          , (3, const "san")+          , (4, const four)+          , (5, const "go")+          , (6, const "roku")+          , (7, const seven)+          , (8, const "hachi")+          , (9, const "kyū")+          , (10, const "jū")+          , (100, \c → case c of+                         (CtxMul _ (Lit 3) _) → "byaku" -- rendaku+                         _                    → "hyaku"+            )+          , (dec 3, const "sen")+          , (dec 4, const "man")+          , (dec 8, const "oku")+          , (dec 12, const "chō")+          , (dec 16, const "kei")+          , (dec 20, const "gai")+          , (dec 24, const "jo")+          , (dec 28, const "jō")+          , (dec 32, const "kō")+          , (dec 36, const "kan")+          , (dec 40, const "sei")+          , (dec 44, const "sai")+          , (dec 48, const "goku")+          , (dec 52, const "gōgasha")+          , (dec 56, const "asōgi")+          , (dec 60, const "nayuta")+          , (dec 64, const "fukashigi")+          , (dec 68, const "muryōtaisū")+          ]+++--------------------------------------------------------------------------------+-- On'yomi+--------------------------------------------------------------------------------++on'yomi_cardinal ∷ (Integral α, Monoid s, IsString s) ⇒ α → Maybe s+on'yomi_cardinal = on'yomi_cardinal_repr ∘ struct++on'yomi_cardinal_repr ∷ (Monoid s, IsString s) ⇒ Exp → Maybe s+on'yomi_cardinal_repr = render $ generic_repr "shi" "shichi"+++--------------------------------------------------------------------------------+-- Preferred reading+--------------------------------------------------------------------------------++preferred_cardinal ∷ (Integral α, Monoid s, IsString s) ⇒ α → Maybe s+preferred_cardinal = preferred_cardinal_repr ∘ struct++preferred_cardinal_repr ∷ (Monoid s, IsString s) ⇒ Exp → Maybe s+preferred_cardinal_repr = render $ generic_repr "yon" "nana"
+ src/Text/Numeral/Language/LA.hs view
@@ -0,0 +1,158 @@+{-# LANGUAGE NoImplicitPrelude+           , OverloadedStrings+           , PackageImports+           , UnicodeSyntax+  #-}++{-|+[@ISO639-1@]        la++[@ISO639-2B@]       lat++[@ISO639-3@]        lat++[@Native name@]     Latine++[@English name@]    Latin+-}++module Text.Numeral.Language.LA+    ( cardinal+    , struct+    ) where+++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++import "base" Data.Bool     ( otherwise )+import "base" Data.Function ( ($), const, fix )+import "base" Data.List     ( concat )+import "base" Data.Maybe    ( Maybe(Just) )+import "base" Data.Monoid   ( Monoid )+import "base" Data.String   ( IsString )+import "base" Prelude       ( Integral, Num, (+) )+import "base-unicode-symbols" Data.Function.Unicode ( (∘) )+import "base-unicode-symbols" Data.List.Unicode     ( (∈) )+import "base-unicode-symbols" Data.Ord.Unicode      ( (≤) )+import "base-unicode-symbols" Data.Monoid.Unicode   ( (⊕) )+import qualified "containers" Data.Map as M ( fromList, lookup )+import           "numerals-base" Text.Numeral+import qualified "numerals-base" Text.Numeral.Exp.Classes as C+++--------------------------------------------------------------------------------+-- LA+--------------------------------------------------------------------------------++{-+Sources:+  http://www.informalmusic.com/latinsoc/latnum.html+  http://www.sf.airnet.ne.jp/~ts/language/number/latin.html+-}++cardinal ∷ (Integral α, Monoid s, IsString s) ⇒ α → Maybe s+cardinal = cardinalRepr ∘ struct++struct ∷ (Integral α, C.Unknown β, C.Lit β, C.Add β, C.Sub β, C.Mul β) ⇒ α → β+struct = checkPos+       $ fix+       $ findRule ( 0, lit)+                  ( [ (11, add 10 L)+                    , (18, sub 20)+                    ]+                  ⊕ concat [ [ (n,   mul 10 R L)+                             , (n+8, sub $ n+10)+                             ]+                           | n ← [20,30..90]+                           ]+                  ⊕ [ ( 100, step 100 10 R L)+                    , (1000, lit)+                    ]+                  )+                  1000++cardinalRepr ∷ (Monoid s, IsString s) ⇒ Exp → Maybe s+cardinalRepr = render defaultRepr+               { reprValue = \n → M.lookup n syms+               , reprAdd   = Just (⊞)+               , reprMul   = Just (⊡)+               , reprSub   = Just $ \_ _ _ → "dē"+               , reprNeg   = Just $ \_ _   → "minus "+               }+    where+      ((_ `Mul` Lit _) ⊞ _) _ = " "+      (_               ⊞ _) _ = ""++      (_ ⊡ Lit n) _ | n ≤ 100 = ""+      (_ ⊡ _    ) _           = " "++      syms =+          M.fromList+          [ (0, const "nihil")+          , (1, \c → case c of+                       CtxAdd _ (Lit 10)  _ → "ūn"+                       CtxSub _ _         _ → "ūn"+                       _                    → "ūnus"+            )+          , (2, \c → case c of+                       CtxMul _ (Lit 10)  _ → "vī"+                       CtxMul _ (Lit 100) _ → "du"+                       _                    → "duo"+            )+          , (3, \c → case c of+                       CtxAdd _ (Lit 10)  _ → "trē"+                       CtxMul _ (Lit 10)  _ → "trī"+                       CtxMul _ (Lit 100) _ → "tre"+                       _                    → "trēs"+            )+          , (4, \c → case c of+                       CtxMul _ (Lit 10)  _ → "quadrā"+                       CtxMul _ (Lit 100) _ → "quadrin"+                       _                    → "quattuor"+            )+          , (5, \c → case c of+                       CtxAdd _ (Lit 10)  _ → "quīn"+                       CtxMul _ (Lit 10)  _ → "quīnquā"+                       CtxMul _ (Lit 100) _ → "quīn"+                       _                    → "quīnque"+            )+          , (6, \c → case c of+                       CtxAdd _ (Lit 10)  _ → "sē"+                       CtxMul _ (Lit 10)  _ → "sexā"+                       CtxMul _ (Lit 100) _ → "ses"+                       _                    → "sex"+            )+          , (7, \c → case c of+                       CtxAdd _ (Lit 10)  _ → "septen"+                       CtxMul _ (Lit 10)  _ → "septuā"+                       CtxMul _ (Lit 100) _ → "septin"+                       _                    → "septem"+            )+          , (8, \c → case c of+                       CtxMul _ (Lit 100) _ → "octin"+                       _                    → "octō"+            )+          , (9, \c → case c of+                       CtxMul _ (Lit 10)  _ → "nōnā"+                       CtxMul _ (Lit 100) _ → "nōn"+                       _                    → "novem"+            )+          , (10, \c → case c of+                        CtxAdd {}           → "decim"+                        CtxMul _ (Lit 2)  _ → "gintī"+                        CtxMul {}           → "gintā"+                        _                   → "decem"+            )+          , (100, \c → case c of+                         CtxMul _ (Lit n) _+                             | n ∈ [2,3,6] → "centī"+                             | otherwise   → "gentī"+                         _                 → "centum"+            )+          , (1000, \c → case c of+                          CtxMul {} → "milia"+                          _         → "mīlle"+            )+          ]
+ src/Text/Numeral/Language/MG.hs view
@@ -0,0 +1,111 @@+{-# LANGUAGE NoImplicitPrelude+           , OverloadedStrings+           , PackageImports+           , UnicodeSyntax+  #-}++{-|+[@ISO639-1@]        mg++[@ISO639-2@]        mlg++[@ISO639-3@]        mlg++[@Native name@]     -++[@English name@]    Malagasy+-}++module Text.Numeral.Language.MG+    ( cardinal+    , struct+    ) where+++-------------------------------------------------------------------------------+-- Imports+-------------------------------------------------------------------------------++import "base" Data.Function ( ($), const, fix )+import "base" Data.List     ( map )+import "base" Data.Maybe    ( Maybe(Just) )+import "base" Data.Monoid   ( Monoid )+import "base" Data.Ord      ( (<) )+import "base" Data.String   ( IsString )+import "base" Prelude       ( Integral, (-) )+import "base-unicode-symbols" Data.Function.Unicode ( (∘) )+import qualified "containers" Data.Map as M ( fromList, lookup )+import           "numerals-base" Text.Numeral+import           "numerals-base" Text.Numeral.Misc ( dec )+import qualified "numerals-base" Text.Numeral.Exp.Classes as C+++-------------------------------------------------------------------------------+-- MG+-------------------------------------------------------------------------------++{-+Sources:+  http://en.wikipedia.org/wiki/Malagasy_language+  http://www.sf.airnet.ne.jp/~ts/language/number/malagasy.html+-}++cardinal ∷ (Integral α, Monoid s, IsString s) ⇒ α → Maybe s+cardinal = cardinalRepr ∘ struct++struct ∷ (Integral α, C.Unknown β, C.Lit β, C.Add β, C.Mul β) ⇒ α → β+struct = checkPos+       $ fix+       $ findRule (0, lit)+                  [(n, step n 10 L L) | n ← map dec [1..6]]+                  (dec 7 - 1)++cardinalRepr ∷ (Monoid s, IsString s) ⇒ Exp → Maybe s+cardinalRepr = render defaultRepr+               { reprValue = \n → M.lookup n syms+               , reprAdd   = Just (⊞)+               , reprMul   = Just (⊡)+               }+    where+      (_ ⊞              Lit 10 ) _ = " ambin'ny "+      (_ ⊞ (Lit _ `Mul` Lit 10)) _ = " amby "+      (_ ⊞ _                   ) _ = " sy "++      (_ ⊡ Lit 10 ) _ = ""+      (_ ⊡ Lit 100) _ = ""+      (_ ⊡ _      ) _ = " "++      syms =+          M.fromList+          [ (0, const "haotra")+          , (1, \c → case c of+                       CtxAdd {} → "iraika"+                       _         → "iray"+            )+          , (2, mulForms "roa"    "roa"   "roan")+          , (3, mulForms "telo"   "telo"  "telon")+          , (4, mulForms "efatra" "efa"   "efa"  )+          , (5, mulForms "dimy"   "dimam" "diman")+          , (6, mulForms "enina"  "enim"  "enin" )+          , (7, mulForms "fito"   "fito"  "fiton")+          , (8, mulForms "valo"   "valo"  "valon")+          , (9, mulForms "sivy"   "sivi"  "sivin")+          , (10, \c → case c of+                        CtxMul _ (Lit n) _+                            | n < 9 → "polo"+                        _           → "folo"+            )+          , (100, \c → case c of+                         CtxMul {} → "jato"+                         _         → "zato"+            )+          , (1000, const "arivo")+          , (dec 4, const "alina")+          , (dec 5, const "hetsy")+          , (dec 6, const "tapitrisa")+          ]++      mulForms o t h = \c → case c of+                              CtxMul _ (Lit 10)  _ → t+                              CtxMul _ (Lit 100) _ → h+                              _                    → o
+ src/Text/Numeral/Language/NL.hs view
@@ -0,0 +1,112 @@+{-# LANGUAGE NoImplicitPrelude+           , OverloadedStrings+           , PackageImports+           , UnicodeSyntax+  #-}++{-|+[@ISO639-1@]        nl++[@ISO639-2B@]       dut++[@ISO639-3@]        nld++[@Native name@]     Nederlands++[@English name@]    Dutch+-}++module Text.Numeral.Language.NL+    ( cardinal+    , struct+    ) where++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++import "base" Data.Bool     ( otherwise )+import "base" Data.Function ( ($), const, fix )+import "base" Data.Maybe    ( Maybe(Just) )+import "base" Data.Monoid   ( Monoid )+import "base" Data.Ord      ( (<) )+import "base" Data.String   ( IsString )+import "base" Prelude       ( Integral, (-) )+import "base-unicode-symbols" Data.Function.Unicode ( (∘) )+import "base-unicode-symbols" Data.List.Unicode     ( (∈) )+import qualified "containers" Data.Map as M ( fromList, lookup )+import           "numerals-base" Text.Numeral+import           "numerals-base" Text.Numeral.Misc ( dec )+import qualified "numerals-base" Text.Numeral.Exp.Classes as C+import qualified "numerals-base" Text.Numeral.BigNum as BN ( rule, pelletierRepr )+++--------------------------------------------------------------------------------+-- NL+--------------------------------------------------------------------------------++cardinal ∷ (Integral α, C.Scale α, Monoid s, IsString s) ⇒ α → Maybe s+cardinal = cardinalRepr ∘ struct++struct ∷ ( Integral α, C.Scale α+         , C.Unknown β, C.Lit β, C.Neg β, C.Add β, C.Mul β, C.Scale β+         )+       ⇒ α → β+struct = pos $ fix $ rule `combine` pelletierScale R L BN.rule++rule ∷ (Integral α, C.Unknown β, C.Lit β, C.Add β, C.Mul β) ⇒ Rule α β+rule = findRule (   0, lit               )+              [ (  13, add    10      L  )+              , (  20, mul    10      L L)+              , ( 100, step  100   10 R L)+              , (1000, step 1000 1000 R L)+              ]+                (dec 6 - 1)++cardinalRepr ∷ (Monoid s, IsString s) ⇒ Exp → Maybe s+cardinalRepr = render defaultRepr+               { reprValue = \n → M.lookup n syms+               , reprScale = BN.pelletierRepr "iljoen" "iljoen"+                                              "iljard" "iljard"+                                              []+               , reprAdd   = Just (⊞)+               , reprMul   = Just $ \_ _ _ → ""+               , reprNeg   = Just $ \_ _   → "min "+               }+    where+      (_     ⊞ Lit 10) _         = ""+      (Lit n ⊞ _) _ | n ∈ [2,3]  = "ën"+                    | n < 10     = "en"+                    | otherwise  = ""+      (_     ⊞ _) _              = ""++      syms =+          M.fromList+          [ (0, const "nul")+          , (1, const "een")+          , (2, tenForms "twee" "twin")+          , (3, tenForms "drie" "der")+          , (4, tenForms "vier" "veer")+          , (5, const "vijf")+          , (6, const "zes")+          , (7, const "zeven")+          , (8, \c → case c of+                       CtxMul _ (Lit 10) _ → "tach"+                       CtxAdd _ (Lit _)  _ → "ach"+                       _                   → "acht"+            )+          , (9, const "negen")+          , (10, \c → case c of+                        CtxMul R _ _ → "tig"+                        _            → "tien"+            )+          , (11, const "elf")+          , (12, const "twaalf")+          , (100, const "honderd")+          , (1000, const "duizend")+          ]++      tenForms n t ctx = case ctx of+                           CtxMul _ (Lit 10) _ → t+                           CtxAdd _ (Lit _)  _ → t+                           _                   → n
+ src/Text/Numeral/Language/NO.hs view
@@ -0,0 +1,96 @@+{-# LANGUAGE NoImplicitPrelude+           , OverloadedStrings+           , PackageImports+           , UnicodeSyntax+  #-}++{-|+[@ISO639-1@]        nb++[@ISO639-2B@]       nob++[@ISO639-3@]        nob++[@Native name@]     Bokmål++[@English name@]    Norwegian Bokmål+-}++module Text.Numeral.Language.NO+    ( cardinal+    , struct+    ) where++-------------------------------------------------------------------------------+-- Imports+-------------------------------------------------------------------------------++import "base" Data.Function ( ($), const, fix )+import "base" Data.Maybe    ( Maybe(Just) )+import "base" Data.Monoid   ( Monoid )+import "base" Data.String   ( IsString )+import "base" Prelude       ( Integral )+import "base-unicode-symbols" Data.Function.Unicode ( (∘) )+import qualified "containers" Data.Map as M ( fromList, lookup )+import           "numerals-base" Text.Numeral+import qualified "numerals-base" Text.Numeral.Exp.Classes as C+++-------------------------------------------------------------------------------+-- NO+-------------------------------------------------------------------------------++-- Sources:+--   http://en.wikibooks.org/wiki/Norwegian_Numbers+--   http://www.sf.airnet.ne.jp/~ts/language/number/norwegian.html++cardinal ∷ (Integral α, Monoid s, IsString s) ⇒ α → Maybe s+cardinal = cardinalRepr ∘ struct++struct ∷ (Integral α, C.Unknown β, C.Lit β, C.Neg β, C.Add β, C.Mul β) ⇒ α → β+struct = pos+       $ fix+       $ findRule (  0, lit            )+                [ ( 13, add   10    L  )+                , ( 20, lit            )+                , ( 21, add   20    R  )+                , ( 30, mul   10    R L)+                , (100, step 100 10 R L)+                ]+                  1000++cardinalRepr ∷ (Monoid s, IsString s) ⇒ Exp → Maybe s+cardinalRepr = render defaultRepr+               { reprValue = \n → M.lookup n syms+               , reprAdd   = Just $ \_ _ _ → ""+               , reprMul   = Just $ \_ _ _ → ""+               , reprNeg   = Just $ \_ _   → "minus "+               }+    where+      syms =+          M.fromList+          [ (0,  const "null")+          , (1,  const "en")+          , (2,  const "to")+          , (3,  ten   "tre"  "tret" "tret")+          , (4,  ten   "fire" "fjor" "før")+          , (5,  const "fem")+          , (6,  const "seks")+          , (7,  ten   "syv"  "syt"  "syt")+          , (8,  ten   "åtte" "at"   "åt")+          , (9,  ten   "ni"   "nit"  "nit")+          , (10, \c → case c of+                        CtxAdd {} → "ten"+                        _         → "ti"+            )+          , (11, const "elleve")+          , (12, const "tolv")+          , (20, const "tjue")+          , (100, const "hundre")+          , (1000, const "tusen")+          ]++      ten n a m = \c → case c of+                         CtxAdd _ (Lit 10) _ → a+                         CtxMul {}           → m+                         _                   → n
+ src/Text/Numeral/Language/NQM.hs view
@@ -0,0 +1,81 @@+{-# LANGUAGE NoImplicitPrelude+           , OverloadedStrings+           , PackageImports+           , UnicodeSyntax+  #-}++{-|+[@ISO639-1@]        -++[@ISO639-2B@]       -++[@ISO639-3@]        nqm++[@Native name@]     -++[@English name@]    Ndom+-}++module Text.Numeral.Language.NQM+    ( cardinal+    , struct+    ) where+++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++import "base" Data.Function ( ($), const, fix )+import "base" Data.Maybe    ( Maybe(Just) )+import "base" Data.Monoid   ( Monoid )+import "base" Data.String   ( IsString )+import "base" Prelude       ( Integral )+import "base-unicode-symbols" Data.Function.Unicode ( (∘) )+import qualified "containers" Data.Map as M ( fromList, lookup )+import           "numerals-base" Text.Numeral+import qualified "numerals-base" Text.Numeral.Exp.Classes as C+++--------------------------------------------------------------------------------+-- NQM+--------------------------------------------------------------------------------++cardinal ∷ (Integral α, Monoid s, IsString s) ⇒ α → Maybe s+cardinal = cardinalRepr ∘ struct++struct ∷ (Integral α, C.Unknown β, C.Lit β, C.Add β, C.Mul β) ⇒ α → β+struct = checkPos+       $ fix+       $ findRule (  1, lit       )+                [ (  7, add  6 R  )+                , ( 12, mul  6 R R)+                , ( 18, lit       )+                , ( 19, add 18 R  )+                , ( 36, lit       )+                , ( 37, add 36 R  )+                , ( 72, mul 36 R R)+                ]+                   107++cardinalRepr ∷ (Monoid s, IsString s) ⇒ Exp → Maybe s+cardinalRepr = render defaultRepr+               { reprValue = \n → M.lookup n syms+               , reprAdd   = Just $ \_ _ _ → " abo "+               , reprMul   = Just (⊡)+               }+    where+      (Lit 36 ⊡ _) _ = " "+      (_      ⊡ _) _ = " an "++      syms =+          M.fromList+          [ ( 1, const "sas")+          , ( 2, const "thef")+          , ( 3, const "ithin")+          , ( 4, const "thonith")+          , ( 5, const "meregh")+          , ( 6, const "mer")+          , (18, const "tondor")+          , (36, const "nif")+          ]
+ src/Text/Numeral/Language/OJ.hs view
@@ -0,0 +1,97 @@+{-# LANGUAGE NoImplicitPrelude+           , OverloadedStrings+           , PackageImports+           , UnicodeSyntax+  #-}++{-|+[@ISO639-1@]        oj++[@ISO639-2@]        oji++[@ISO639-3@]        oji++[@Native name@]     ᐊᓂᔑᓈᐯᒧᐎᓐ (Anishinaabemowin)++[@English name@]    Ojibwe+-}++module Text.Numeral.Language.OJ+    ( cardinal+    , struct+    ) where++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++import "base" Data.Function ( ($), const, fix )+import "base" Data.Maybe    ( Maybe(Just) )+import "base" Data.Monoid   ( Monoid )+import "base" Data.String   ( IsString )+import "base" Prelude       ( Integral )+import "base-unicode-symbols" Data.Function.Unicode ( (∘) )+import qualified "containers" Data.Map as M ( fromList, lookup )+import           "numerals-base" Text.Numeral+import qualified "numerals-base" Text.Numeral.Exp.Classes as C+++--------------------------------------------------------------------------------+-- OJ+--------------------------------------------------------------------------------++{-+Sources:+  http://www.sf.airnet.ne.jp/~ts/language/number/ojibwa.html+  http://www.languagesandnumbers.com/how-to-count-in-ojibwa/en/oji/+-}++cardinal ∷ (Integral α, Monoid s, IsString s) ⇒ α → Maybe s+cardinal = cardinalRepr ∘ struct++struct ∷ (Integral α, C.Unknown β, C.Lit β, C.Add β, C.Mul β)+       ⇒ α → β+struct = checkPos+       $ fix+       $ findRule (   1, lit             )+                [ (  11, step   10 10 R L)+                , ( 100, step  100 10 R L)+                , (1000, step 1000  2 R L)+                ]+                   1999++cardinalRepr ∷ (Monoid s, IsString s) ⇒ Exp → Maybe s+cardinalRepr = render defaultRepr+               { reprValue = \n → M.lookup n syms+               , reprAdd   = Just $ \_ _ _ → " shaa "+               , reprMul   = Just $ \_ _ _ → ""+               }+    where+      syms =+          M.fromList+          [ (0, const "kaagego"                              )+          , (1, const "bezhik"                               )+          , (2, const "niizh"                                )+          , (3, forms "nswi"        "nsim"        "ns"       )+          , (4, forms "niiwin"      "niim"        "nii"      )+          , (5, forms "naanan"      "naanmi"      "naan"     )+          , (6, forms "ngodwaaswi"  "ngodwaasmi"  "ngodwaas" )+          , (7, forms "niizhwaaswi" "niizhwaasmi" "niizhwaas")+          , (8, forms "nshwaaswi"   "nshwaasmi"   "nshwaas"  )+          , (9, forms "zhaangswi"   "zhaangsmi"   "zhaangs"  )+          , (10, \c → case c of+                        CtxMul {} → "taana"+                        _         → "mdaaswi"+            )+          , (100, \c → case c of+                         CtxMul {} → "waak"+                         _         → "ngodwaak"+            )+          , (1000, const "mdaaswaak")+          ]++      forms ∷ s → s → s → Ctx Exp → s+      forms o t h = \c → case c of+                           CtxMul _ (Lit 10)  _ → t+                           CtxMul _ (Lit 100) _ → h+                           _                    → o
+ src/Text/Numeral/Language/PT.hs view
@@ -0,0 +1,159 @@+{-# LANGUAGE NoImplicitPrelude+           , OverloadedStrings+           , PackageImports+           , UnicodeSyntax+  #-}++{-|+[@ISO639-1@]        pt++[@ISO639-2@]        por++[@ISO639-3@]        por++[@Native name@]     Português++[@English name@]    Portuguese+-}++module Text.Numeral.Language.PT+    ( cardinal+    , struct+    ) where++-------------------------------------------------------------------------------+-- Imports+-------------------------------------------------------------------------------++import "base" Data.Bool     ( otherwise )+import "base" Data.Function ( ($), const, fix )+import "base" Data.Maybe    ( Maybe(Just) )+import "base" Data.Monoid   ( Monoid )+import "base" Data.Ord      ( (<) )+import "base" Data.String   ( IsString )+import "base" Prelude       ( Integral, (-), Integer )+import "base-unicode-symbols" Data.Eq.Unicode       ( (≡) )+import "base-unicode-symbols" Data.Function.Unicode ( (∘) )+import "base-unicode-symbols" Data.Ord.Unicode      ( (≤) )+import qualified "containers" Data.Map as M ( fromList, lookup )+import           "numerals-base" Text.Numeral+import           "numerals-base" Text.Numeral.Misc ( dec )+import qualified "numerals-base" Text.Numeral.BigNum      as BN+import qualified "numerals-base" Text.Numeral.Exp.Classes as C+++-------------------------------------------------------------------------------+-- PT+-------------------------------------------------------------------------------++-- Sources:+--   http://www.sonia-portuguese.com/text/numerals.htm+--   http://www.smartphrase.com/Portuguese/po_numbers_voc.shtml++cardinal ∷ (Integral α, C.Scale α, Monoid s, IsString s) ⇒ α → Maybe s+cardinal = cardinalRepr ∘ struct++struct ∷ ( Integral α, C.Scale α+         , C.Unknown β, C.Lit β, C.Neg β, C.Add β, C.Mul β, C.Scale β+         )+       ⇒ α → β+struct = pos $ fix $ rule `combine` shortScale R L BN.rule+    where+      rule = findRule (   0, lit       )+                    [ (  11, add 10 L  )+                    , (  16, add 10 R  )+                    , (  20, mul 10 R L)+                    , ( 100, step  100   10 R L)+                    , (1000, step 1000 1000 R L)+                    ]+                    (dec 6 - 1)++cardinalRepr ∷ (Monoid s, IsString s) ⇒ Exp → Maybe s+cardinalRepr = render defaultRepr+               { reprValue = \n → M.lookup n syms+               , reprScale = shortScaleRepr+               , reprAdd   = Just (⊞)+               , reprMul   = Just (⊡)+               , reprNeg   = Just $ \_ _ → "menos "+               }+    where+      (Lit 10 ⊞ Lit n ) _ | n < 8     = "as"+                          | n ≡ 8     = ""+                          | otherwise = "a"+      (Lit _  ⊞ Lit 10) _             = ""+      (_      ⊞ _     ) _             = " e "+++      (_ ⊡ Lit 10 ) _ = ""+      (_ ⊡ Lit 100) _ = ""+      (_ ⊡ _      ) _ = " "++      syms =+          M.fromList+          [ (0, const "zero")+          , (1, \c → case c of+                       CtxAdd _ (Lit 10) _ → "on"+                       _                   → "um"+            )+          , (2, \c → case c of+                       CtxAdd _ (Lit 10)  _ → "do"+                       CtxMul _ (Lit 10)  _ → "vin"+                       CtxMul _ (Lit 100) _ → "duz"+                       _                    → "dois"+            )+          , (3, \c → case c of+                       CtxAdd _ (Lit 10)  _ → "tre"+                       CtxMul _ (Lit 10)  _ → "trin"+                       CtxMul _ (Lit 100) _ → "trez"+                       _                    → "três"+            )+          , (4, \c → case c of+                       CtxAdd _ (Lit 10)  _ → "cator"+                       CtxMul _ (Lit 10)  _ → "quaren"+                       _                    → "quatro"+            )+          , (5, \c → case c of+                       CtxAdd _ (Lit 10)  _ → "quin"+                       CtxMul _ (Lit 10)  _ → "cinquen"+                       CtxMul _ (Lit 100) _ → "quin"+                       _                    → "cinco"+            )+          , (6, \c → case c of+                       CtxMul _ (Lit 10) _ → "sessen"+                       _                   → "seis"+            )+          , (7, \c → case c of+                       CtxMul _ (Lit 10) _ → "seten"+                       _                   → "sete"+            )+          , (8, \c → case c of+                       CtxMul _ (Lit 10) _ → "oiten"+                       _                   → "oito"+            )+          , (9, \c → case c of+                       CtxMul _ (Lit 10) _ → "noven"+                       _                   → "nove"+            )+          , (10, \c → case c of+                        CtxAdd R (Lit _) _ → "ze"+                        CtxMul R (Lit 2) _ → "te"+                        CtxMul R (Lit _) _ → "ta"+                        _                  → "dez"+            )+          , (100, \c → case c of+                         CtxAdd {}       → "cento"+                         CtxMul _ (Lit n) _+                             | n ≤ 3     → "entos"+                             | n ≡ 4     → "centos"+                             | n ≡ 5     → "hentos"+                             | otherwise → "centos"+                         _               → "cem"+            )+          , (1000, const "mil")+          ]++shortScaleRepr ∷ (IsString s, Monoid s)+               ⇒ Integer → Integer → Exp → Ctx Exp → Maybe s+shortScaleRepr =+    BN.scaleRepr "ilhão" "ilhões"+                 [(4, BN.forms "quatr" "quator" "quator" "quatra" "quatri")]
+ src/Text/Numeral/Language/RU.hs view
@@ -0,0 +1,155 @@+{-# LANGUAGE NoImplicitPrelude+           , OverloadedStrings+           , PackageImports+           , UnicodeSyntax+  #-}++{-|+[@ISO639-1@]        ru++[@ISO639-2@]        rus++[@ISO639-3@]        rus++[@Native name@]     Русский язык++[@English name@]    Russian+-}++module Text.Numeral.Language.RU+    ( cardinal+    , struct+    ) where+++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++import "base" Data.Function ( ($), const, fix )+import "base" Data.Maybe    ( Maybe(Just) )+import "base" Data.Monoid   ( Monoid )+import "base" Data.Ord      ( (<), (>) )+import "base" Data.String   ( IsString )+import "base" Prelude       ( Integral, (-) )+import "base-unicode-symbols" Data.Eq.Unicode       ( (≡) )+import "base-unicode-symbols" Data.Function.Unicode ( (∘) )+import "base-unicode-symbols" Data.Ord.Unicode      ( (≤), (≥) )+import qualified "containers" Data.Map as M ( fromList, lookup )+import           "numerals-base" Text.Numeral+import           "numerals-base" Text.Numeral.Misc ( dec )+import qualified "numerals-base" Text.Numeral.Exp.Classes as C+++--------------------------------------------------------------------------------+-- RU+--------------------------------------------------------------------------------++{-+Sources:+  http://en.wikibooks.org/wiki/Russian/Numbers+  http://russian.speak7.com/russian_numbers.htm+  http://learningrussian.net/games_verbs_grammar3.php+  http://www.waytorussia.net/WhatIsRussia/Russian/Part1a.html+-}++cardinal ∷ (Integral α, Monoid s, IsString s) ⇒ α → Maybe s+cardinal = cardinalRepr ∘ struct++struct ∷ (Integral α, C.Unknown β, C.Lit β, C.Neg β, C.Add β, C.Mul β) ⇒ α → β+struct = pos +       $ fix +       $ findRule (   0, lit               )+                [ (  11, add 10 L          )+                , (  20, mul 10 R L        )+                , (  40, lit               )+                , (  41, add 40 R          )+                , (  50, mul 10 R L        )+                , ( 100, step  100   10 R L)+                , (1000, step 1000 1000 R L)+                ]+                  (dec 6 - 1)++cardinalRepr ∷ (Monoid s, IsString s) ⇒ Exp → Maybe s+cardinalRepr = render defaultRepr+               { reprValue = \n → M.lookup n syms+               , reprAdd   = Just (⊞)+               , reprMul   = Just (⊡)+               , reprNeg   = Just $ \_ _ → "минус "+               }+    where+      (Lit n ⊞ Lit 10) _ | n < 10 = "на"+      (_     ⊞ _     ) _          = " "++      (_ ⊡ Lit n) _ | n ≤ 100 = ""+      (_ ⊡ _    ) _           = " "++      syms =+          M.fromList+          [ (0, const "ноль")+          , (1, \c → case c of+                       CtxAdd _ (Lit 40)    (CtxMul {}) → "одна"+                       CtxAdd _ (_ `Mul` _) (CtxMul {}) → "одна"+                       _                                → "один"+            )+          , (2, \c → case c of+                       CtxAdd _ (Lit 10)    _           → "две"+                       CtxAdd _ (Lit 40)    (CtxMul {}) → "две"+                       CtxAdd _ (_ `Mul` _) (CtxMul {}) → "две"+                       CtxMul _ (Lit n)     _ | n > 10  → "две"+                       _                                → "два"+            )+          , (3, const "три")+          , (4, \c → case c of+                       CtxAdd _ (Lit 10) _ → "четыр"+                       _                   → "четыре"+            )+          , (5, \c → case c of+                       CtxAdd _ (Lit 10) _ → "пят"+                       _                   → "пять"+            )+          , (6, \c → case c of+                       CtxAdd _ (Lit 10) _ → "шест"+                       _                   → "шесть"+            )+          , (7, \c → case c of+                       CtxAdd _ (Lit 10) _ → "сем"+                       _                   → "семь"+            )+          , (8, \c → case c of+                       CtxAdd _ (Lit 10) _ → "восем"+                       _                   → "восемь"+            )+          , (9, \c → case c of+                       CtxAdd _ (Lit 10) _ → "девят"+                       CtxMul _ (Lit 10) _ → "девя"+                       _                   → "девять"+            )+          , (10, \c → case c of+                        CtxAdd _ (Lit n) _ | n ≤ 9 → "дцать"+                        CtxMul _ (Lit n) _ | n < 4 → "дцать"+                                           | n < 9 → "десят"+                                           | n ≡ 9 → "носто"+                        _                          → "десять"+            )+          , (40, const "сорок")+          , (100, \c → case c of+                         CtxMul _ (Lit n) _ | n ≡ 2 → "сти"+                                            | n ≤ 4 → "ста"+                                            | n ≤ 9 → "сот"+                         _                          → "сто"+            )+          , (1000, \c → case c of+                          CtxMul _ (Lit 40    `Add` Lit n) _ | n ≡ 1 → "тысяча"+                                                             | n ≤ 4 → "тысячи"+                                                             | n ≥ 5 → "тысяч"+                          CtxMul _ (_ `Mul` _ `Add` Lit n) _ | n ≡ 1 → "тысяча"+                                                             | n ≤ 4 → "тысячи"+                                                             | n ≥ 5 → "тысяч"+                          CtxMul _ (Lit n) _ | n ≤ 4 → "тысячи"+                          CtxMul {}                  → "тысяч"+                          _                          → "тысяча"+            )+          , (dec 6, const "миллион")+          , (dec 9, const "миллиард")+          ]
+ src/Text/Numeral/Language/SCO.hs view
@@ -0,0 +1,97 @@+{-# LANGUAGE NoImplicitPrelude+           , OverloadedStrings+           , PackageImports+           , UnicodeSyntax+  #-}++{-|+[@ISO639-1@]        -++[@ISO639-2@]        sco++[@ISO639-3@]        sco++[@Native name@]     Scots++[@English name@]    Scots+-}++module Text.Numeral.Language.SCO+    ( cardinal+    , struct+    ) where+++-------------------------------------------------------------------------------+-- Imports+-------------------------------------------------------------------------------++import "base" Data.Function ( ($), const, fix )+import "base" Data.Maybe    ( Maybe(Just) )+import "base" Data.Monoid   ( Monoid )+import "base" Data.String   ( IsString )+import "base" Prelude       ( Integral )+import "base-unicode-symbols" Data.Function.Unicode ( (∘) )+import qualified "containers" Data.Map as M ( fromList, lookup )+import           "numerals-base" Text.Numeral+import qualified "numerals-base" Text.Numeral.Exp.Classes as C+++-------------------------------------------------------------------------------+-- SCO+-------------------------------------------------------------------------------++{-+Sources:+  http://www.sf.airnet.ne.jp/~ts/language/number/scots.html+-}++cardinal ∷ (Integral α, Monoid s, IsString s) ⇒ α → Maybe s+cardinal = cardinalRepr ∘ struct++struct ∷ (Integral α, C.Unknown β, C.Lit β, C.Add β, C.Mul β) ⇒ α → β+struct = checkPos+       $ fix+       $ findRule (  1, lit       )+                [ ( 13, add 10 L  )+                , ( 20, mul 10 R L)+                , (100, lit       )+                ]+                   100++cardinalRepr ∷ (Monoid s, IsString s) ⇒ Exp → Maybe s+cardinalRepr = render defaultRepr+               { reprValue = \n → M.lookup n syms+               , reprAdd   = Just (⊞)+               , reprMul   = Just $ \_ _ _ → ""+               }+    where+      ((_ `Mul` _) ⊞ _) _ = " "+      (_           ⊞ _) _ = ""++      syms =+          M.fromList+          [ (1, const    "ane"                     )+          , (2, tenForms "twa"    "twa"    "twin"  )+          , (3, tenForms "three"  "ther"   "ther"  )+          , (4, const    "fower"                   )+          , (5, tenForms "five"   "feif"   "fuf"   )+          , (6, const    "sax"                     )+          , (7, tenForms "seeven" "seiven" "seeven")+          , (8, tenForms "echt"   "ech"    "ech"   )+          , (9, tenForms "nine"   "nin"    "nin"   )+          , (10, \c → case c of+                        CtxAdd {} → "teen"+                        CtxMul {} → "tie"+                        _         → "ten"+            )+          , (11, const "aleeven")+          , (12, const "twal")+          , (100, const "hunner")+          , (1000, const "thousant")+          ]++      tenForms o a m = \c → case c of+                              CtxAdd L _ _ → a+                              CtxMul {}    → m+                              _            → o
+ src/Text/Numeral/Language/SV.hs view
@@ -0,0 +1,111 @@+{-# LANGUAGE NoImplicitPrelude+           , OverloadedStrings+           , PackageImports+           , UnicodeSyntax+  #-}++{-|+[@ISO639-1@]        sv++[@ISO639-2B@]       swe++[@ISO639-3@]        swe++[@Native name@]     svenska++[@English name@]    Swedish+-}++module Text.Numeral.Language.SV+    ( cardinal+    , struct+    ) where+++-------------------------------------------------------------------------------+-- Imports+-------------------------------------------------------------------------------++import "base" Data.Function ( ($), const, fix )+import "base" Data.Maybe    ( Maybe(Just) )+import "base" Data.Monoid   ( Monoid )+import "base" Data.String   ( IsString )+import "base" Prelude       ( Integral, (-), Integer )+import "base-unicode-symbols" Data.Function.Unicode ( (∘) )+import qualified "containers" Data.Map as M ( fromList, lookup )+import           "numerals-base" Text.Numeral+import           "numerals-base" Text.Numeral.Misc ( dec )+import qualified "numerals-base" Text.Numeral.BigNum      as BN+import qualified "numerals-base" Text.Numeral.Exp.Classes as C+++-------------------------------------------------------------------------------+-- SV+-------------------------------------------------------------------------------++cardinal ∷ (Integral α, C.Scale α, Monoid s, IsString s) ⇒ α → Maybe s+cardinal = cardinalRepr ∘ struct++struct ∷ ( Integral α, C.Scale α+         , C.Unknown β, C.Lit β, C.Neg β, C.Add β, C.Mul β, C.Scale β+         )+       ⇒ α → β+struct = pos $ fix $ rule `combine` pelletierScale R L BN.rule+    where+      rule = findRule (   0, lit       )+                    [ (  13, add 10 L  )+                    , (  20, lit       )+                    , (  21, add 20 R  )+                    , (  30, mul 10 R L)+                    , ( 100, step  100   10 R L)+                    , (1000, step 1000 1000 R L)+                    ]+                      (dec 6 - 1)++cardinalRepr ∷ (Monoid s, IsString s) ⇒ Exp → Maybe s+cardinalRepr = render defaultRepr+               { reprValue = \n → M.lookup n syms+               , reprScale = pelletierRepr+               , reprAdd   = Just $ \_ _ _ → ""+               , reprMul   = Just $ \_ _ _ → ""+               , reprNeg   = Just $ \_ _   → "minus "+               }+    where+      syms =+          M.fromList+          [ (0,  const "noll")+          , (1,  const "ett")+          , (2,  const "två")+          , (3,  ten   "tre"  "tret" "tret")+          , (4,  ten   "fyra" "fjor" "fyr")+          , (5,  const "fem")+          , (6,  const "sex")+          , (7,  ten   "sju"  "sjut" "sjut")+          , (8,  ten   "åtta" "ar"   "åt")+          , (9,  ten   "nio"  "nit"  "nit")+          , (10, \c → case c of+                        CtxAdd {} → "ton"+                        _         → "tio"+            )+          , (11, const "elva")+          , (12, const "tolv")+          , (20, const "tjugo")+          , (100, const "hundra")+          , (1000, const "tusen")+          ]++      ten n a m = \c → case c of+                         CtxAdd _ (Lit 10) _ → a+                         CtxMul _ (Lit 10) _ → m+                         _                   → n++pelletierRepr ∷ (IsString s, Monoid s)+              ⇒ Integer → Integer → Exp → Ctx Exp → Maybe s+pelletierRepr =+    BN.pelletierRepr+      "iljon"  "iljon"+      "iljard" "iljard"+      [ (4, BN.forms "kvadr" "kvattuor" "kvattuor" "kvadra"  "kvadri")+      , (5, BN.forms "kvint" "kvin"     "kvinkva"  "kvinkva" "kvin")+      , (8, BN.forms "okt"   "okto"     "okto"     "okto"    "oktin")+      ]
+ src/Text/Numeral/Language/TR.hs view
@@ -0,0 +1,156 @@+{-# LANGUAGE NoImplicitPrelude+           , OverloadedStrings+           , PackageImports+           , UnicodeSyntax+  #-}++{-|+[@ISO639-1@]        tr++[@ISO639-2@]        tur++[@ISO639-3@]        tur++[@Native name@]     Türkçe++[@English name@]    Turkish+-}++module Text.Numeral.Language.TR+    ( cardinal+    , struct+    ) where+++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++import "base" Data.Bool           ( otherwise )+import "base" Data.Function       ( ($), const, fix )+import "base" Data.Maybe          ( Maybe(Just) )+import "base" Data.Monoid         ( Monoid )+import "base" Data.String         ( IsString )+import "base" Prelude             ( Integral, (-), divMod, Integer )+import "base-unicode-symbols" Data.Eq.Unicode       ( (≡) )+import "base-unicode-symbols" Data.Function.Unicode ( (∘) )+import "base-unicode-symbols" Data.List.Unicode     ( (∉) )+import "base-unicode-symbols" Prelude.Unicode       ( (⋅) )+import qualified "containers" Data.Map as M ( fromList, lookup )+import           "numerals-base" Text.Numeral+import           "numerals-base" Text.Numeral.Misc ( dec )+import qualified "numerals-base" Text.Numeral.Exp.Classes as C+import qualified "numerals-base" Text.Numeral.BigNum as BN ( rule, scaleRepr, forms )+++--------------------------------------------------------------------------------+-- TR+--------------------------------------------------------------------------------++{-++Sources:+  http://www.languagesandnumbers.com/how-to-count-in-turkish/en/tur/+  http://www.sf.airnet.ne.jp/~ts/language/number/turkish.html+  http://www.turkishlanguage.co.uk/seasons.htm#article_15+  http://www.turkeytravelplanner.com/details/LanguageGuide/100words_lessons/100Words_10.html+  http://en.wikibooks.org/wiki/Turkish/Numbers+  http://tr.wikipedia.org/wiki/B%C3%BCy%C3%BCk_say%C4%B1lar%C4%B1n_adlar%C4%B1+-}++cardinal ∷ (Integral α, C.Scale α, Monoid s, IsString s) ⇒ α → Maybe s+cardinal = cardinalRepr ∘ struct++struct ∷ (Integral α, C.Scale α, C.Unknown β, C.Lit β, C.Add β, C.Mul β, C.Scale β)+       ⇒ α → β+struct = checkPos $ fix $ rule `combine` shortScale1 R L BN.rule++rule ∷ (Integral α, C.Unknown β, C.Lit β, C.Add β, C.Mul β) ⇒ Rule α β+rule = findRule (   0, lit               )+              [ (  11, addToTens         )+              , ( 100, step  100   10 R L)+              , (1000, step 1000 1000 R L)+              ]+                (dec 6 - 1)++addToTens ∷ (Integral α, C.Lit β, C.Add β) ⇒ Rule α β+addToTens f n = let (m, r) = n `divMod` 10+                    tens   = m ⋅ 10+                in if r ≡ 0+                   then lit f tens+                   else f tens `C.add` f r++cardinalRepr ∷ (Monoid s, IsString s) ⇒ Exp → Maybe s+cardinalRepr = render defaultRepr+               { reprValue = \n → M.lookup n syms+               , reprScale = scaleRepr+               , reprAdd   = Just (⊞)+               , reprMul   = Just $ \_ _ _ → " "+               }+    where+      (Lit 10 ⊞ _) (CtxMul {}) = ""+      (_      ⊞ _) _           = " "++      syms =+          M.fromList+          [ (0, const "sıfır")+          , (1, const "bir")+          , (2, const "iki")+          , (3, \c → case c of+                       CtxEmpty → "üç"+                       _        → "uç"+            )+          , (4, const "dört")+          , (5, const "beş")+          , (6, const "altı")+          , (7, const "yedi")+          , (8, const "sekiz")+          , (9, const "dokuz")+          , (10, const "on")+          , (20, const "yirmi")+          , (30, const "otuz")+          , (40, const "kırk")+          , (50, const "elli")+          , (60, const "altmış")+          , (70, const "yetmiş")+          , (80, const "seksen")+          , (90, const "doksan")+          , (100, const "yüz")+          , (1000, const "bin")+          ]++scaleRepr ∷ (IsString s, Monoid s)+              ⇒ Integer → Integer → Exp → Ctx Exp → Maybe s+scaleRepr = BN.scaleRepr+              "ilyon" "ilyon"+              [ (1, BN.forms "m"     "an"     "an"     ""       "")+              , (2, BN.forms "b"     "do"     "do"     "vi"     "du")+              , (3, \c → case c of+                           CtxAdd _ (Lit 10)  _ → "tre"+                           CtxAdd _ (Lit 100) _ → "tre"+                           CtxAdd {}            → "tres"+                           CtxMul _ (Lit 100) _ → "tre"+                           CtxMul {}            → "tri"+                           _                    → "tr"+                )+              , (4, BN.forms "katr"  "kator"  "kator"  "katra"  "katrin")+              , (5, BN.forms "kent"  "ken"    "kenka"  "kenka"  "ken")+              , (6, BN.forms "sekst" "seks"   "ses"    "seksa"  "se")+              , (7, BN.forms "sept"  "septen" "septem" "septe"  "septin")+              , (8, BN.forms "okt"   "okto"   "okto"   "okto"   "oktin")+              , (10, \c → case c of+                            CtxAdd _ (Lit 100) _              → "desi"+                            CtxAdd _ (Lit 1) (CtxAdd {})      → "desi"+                            CtxMul _ (Lit n) (CtxAdd L (Lit 100) _)+                                       | n ≡ 2     → "ginti"+                                       | otherwise → "ginta"+                            CtxMul _ (Lit _) (CtxAdd _ _ CtxEmpty) → "gint"+                            CtxMul _ (Lit _) CtxEmpty         → "gint"+                            CtxMul {}                         → "ginti"+                            _                                 → "des"+                )+              , (100, \c → case c of+                             CtxMul _ (Lit n) _ | n ∉ [2,3,6] → "gent"+                             _                                → "sent"+                )+              ]
+ src/Text/Numeral/Language/WO.hs view
@@ -0,0 +1,99 @@+{-# LANGUAGE NoImplicitPrelude+           , OverloadedStrings+           , PackageImports+           , UnicodeSyntax+  #-}++{-|+[@ISO639-1@]        wo++[@ISO639-2@]        wo1++[@ISO639-3@]        wo1++[@Native name@]     Wolof++[@English name@]    Wolof+-}++module Text.Numeral.Language.WO+    ( cardinal+    , struct+    ) where++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++{-+Sources:+  http://en.wikipedia.org/wiki/Wolof_language#Numerals+  http://www.sf.airnet.ne.jp/~ts/language/number/wolof.html+-}++import "base" Data.Function ( ($), const, fix )+import "base" Data.Maybe    ( Maybe(Just) )+import "base" Data.Monoid   ( Monoid )+import "base" Data.String   ( IsString )+import "base" Prelude       ( Integral )+import "base-unicode-symbols" Data.Function.Unicode ( (∘) )+import "base-unicode-symbols" Data.Monoid.Unicode   ( (⊕) )+import "base-unicode-symbols" Data.Ord.Unicode      ( (≥) )+import qualified "containers" Data.Map as M ( fromList, lookup )+import           "numerals-base" Text.Numeral+import           "numerals-base" Text.Numeral.Misc ( dec )+import qualified "numerals-base" Text.Numeral.Exp.Classes as C+++--------------------------------------------------------------------------------+-- WO+--------------------------------------------------------------------------------++cardinal ∷ (Integral α, C.Scale α, Monoid s, IsString s) ⇒ α → Maybe s+cardinal = cardinalRepr ∘ struct++struct ∷ (Integral α, C.Unknown β, C.Lit β, C.Add β, C.Mul β) ⇒ α → β+struct = checkPos+       $ fix+       $ findRule (  0, lit        )+                [ (  6, add 5 R    )+                , ( 10, lit        )+                , ( 11, add 10 R   )+                , ( 20, mul 10 R L )+                , (100,  step 100 10 R L)+                , (1000, step 1000 1000 R L)+                , (dec 6, lit)+                ]+                  (dec 6)++cardinalRepr ∷ (Monoid s, IsString s) ⇒ Exp → Maybe s+cardinalRepr = render defaultRepr+               { reprValue = \n → M.lookup n syms+               , reprAdd   = Just (⊞)+               , reprMul   = Just (⊡)+               }+    where+      (Lit 5 ⊞ _) _ = "-"+      (_     ⊞ _) _ = " ak "++      (_ ⊡ Lit 10) _ = "-"+      (_ ⊡ _     ) _ = " "++      syms =+          M.fromList+          [ (0, const "tus")+          , (1, i "benn")+          , (2, i "ñaar")+          , (3, i "ñett")+          , (4, i "ñeent")+          , (5, i "juróom")+          , (10, i "fukk")+          , (100, i "téeméer")+          , (1000, const "junni")+          , (dec 6, const "tamndareet")+          ]++      i s = \c → s ⊕ case c of+                       CtxMul _ (Lit n) _ | n ≥ 100 → "i"+                       CtxAdd R _ (CtxMul _ (Lit n) _) | n ≥ 100 → "i"+                       _ → ""
+ src/Text/Numeral/Language/YOR.hs view
@@ -0,0 +1,149 @@+{-# LANGUAGE NoImplicitPrelude+           , OverloadedStrings+           , PackageImports+           , UnicodeSyntax+  #-}++{-|+[@ISO639-1@]        yo++[@ISO639-2@]        yor++[@ISO639-3@]        yor++[@Native name@]     èdè Yorùbá++[@English name@]    Yoruba+-}++module Text.Numeral.Language.YOR+    ( cardinal+    , struct+    ) where+++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++import "base" Data.Bool     ( otherwise )+import "base" Data.Function ( ($), const, fix )+import "base" Data.Maybe    ( Maybe(Just) )+import "base" Data.Monoid   ( Monoid )+import "base" Data.String   ( IsString )+import "base" Prelude       ( Integral )+import "base-unicode-symbols" Data.Eq.Unicode       ( (≡) )+import "base-unicode-symbols" Data.Function.Unicode ( (∘) )+import "base-unicode-symbols" Data.Monoid.Unicode   ( (⊕) )+import qualified "containers" Data.Map as M ( fromList, lookup )+import           "numerals-base" Text.Numeral+import qualified "numerals-base" Text.Numeral.Exp.Classes as C+++--------------------------------------------------------------------------------+-- YOR+--------------------------------------------------------------------------------++{-+TODO: multiple sources make me suspect that this definition is not correct++It may also be the case that numbers have multiple possible deriviations.++ 45 = (20*3) - 10 - 5+ 50 = (20*3) - 10+108 = (20*6) - 10 - 2+300 = 20 * (20 - 5)+318 = 400 - (20*4) - 2+525 = (200*3) - (20*4) + 5+-}++cardinal ∷ (Integral α, Monoid s, IsString s) ⇒ α → Maybe s+cardinal = cardinalRepr ∘ struct++struct ∷ (Integral α, C.Unknown β, C.Lit β, C.Add β, C.Sub β, C.Mul β) ⇒ α → β+struct = checkPos+       $ fix+       $ conditional (≡ -5) lit+       $ findRule (   1, lit        )+                [ (  11, add 10  L  )+                , (  15, add 20  L  )+                , (  16, sub 20     )+                , (  20, lit        )+                , (  21, add 20  L  )+                , (  25, add 30  L  )+                , (  26, sub 30     )+                , (  30, lit        )+                , (  31, add 30  L  )+                , (  35, sub 40     )+                , (  40, mul 20  L R)+                , (  45, sub 50     )+                , (  50, lit        )+                , (  51, add 50  L  )+                , (  55, sub 60     )+                , (  60, mul 20  L R)+                , (  65, sub 70     )+                , (  70, lit        )+                , (  71, add 70  L  )+                , (  75, sub 80     )+                , (  80, mul 20  L R)+                , (  85, sub 90     )+                , (  90, lit        )+                , (  91, add 90  L  )+                , (  95, sub 100    )+                , ( 100, mul 20  L R)+                , ( 200, mul 100 L R)+                , (1000, lit        )+                ]+                   1000++cardinalRepr ∷ (Monoid s, IsString s) ⇒ Exp → Maybe s+cardinalRepr = render defaultRepr+               { reprValue = \n → M.lookup n syms+               , reprAdd   = Just (⊞)+               , reprMul   = Just (⊡)+               , reprSub   = Just $ \_ _ _ → "dil"+               }+    where+      (_     ⊞ Lit 10) _         = ""+      (Lit n ⊞ _) _  | n ≡ -5    = ""+                     | otherwise = "lel"+      (_     ⊞ _) _              = ""++      ((Lit 20 `Mul` Lit 5) ⊡ _) _ = " "+      (_                    ⊡ _) _ = ""++      syms =+          M.fromList+          [ (-5, const "med")+          , ( 1, \c → case c of+                        CtxAdd {} → "mokan"+                        CtxSub {} → "mokan"+                        _         → "ikan"+            )+          , ( 2, twentyForm "me" "go" "ji")+          , ( 3, twentyForm "me" "go" "ta")+          , ( 4, twentyForm "me" "go" "rin")+          , ( 5, twentyForm "ma" "go" "run")+          , ( 6, const    $ "me"  ⊕   "fa")+          , ( 7, const    $ "me"  ⊕   "je")+          , ( 8, const    $ "me"  ⊕   "jo")+          , ( 9, const    $ "me"  ⊕   "san")+          , (10, \c → case c of+                        CtxAdd {} → "la"+                        _         → "mewa"+            )+          , (20, \c → case c of+                        CtxMul {} → "o"+                        _         → "ogun"+            )+          , (30, const "ogbon")+          , (50, const "adota")+          , (70, const "adorin")+          , (90, const "adorun")+          , (1000, const "egberun")+          ]++      twentyForm c m s = \ctx → case ctx of+                                  CtxMul _ (Lit 20) _ → m+                                  _                   → c+                                ⊕ s
+ src/Text/Numeral/Language/ZH.hs view
@@ -0,0 +1,290 @@+{-# LANGUAGE NoImplicitPrelude+           , OverloadedStrings+           , PackageImports+           , UnicodeSyntax+  #-}++{-|+[@ISO639-1@]        zh++[@ISO639-2B@]       chi++[@ISO639-2T@]       zho++[@ISO639-3@]        cmn++[@Native name@]     官話++[@English name@]    Chinese+-}++module Text.Numeral.Language.ZH+    ( struct+    , trad_cardinal+    , simpl_cardinal+    , finance_trad_cardinal+    , finance_simpl_cardinal+    , pinyin_cardinal+    ) where+++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++import "base" Data.Bool     ( otherwise )+import "base" Data.Function ( id, const, fix, flip, ($) )+import "base" Data.Maybe    ( Maybe(Just) )+import "base" Data.Monoid   ( Monoid )+import "base" Data.Ord      ( (<) )+import "base" Data.String   ( IsString )+import "base" Prelude       ( Num, Integral, fromIntegral, (-), div, divMod )+import "base-unicode-symbols" Data.Eq.Unicode       ( (≡) )+import "base-unicode-symbols" Data.Function.Unicode ( (∘) )+import "base-unicode-symbols" Data.Monoid.Unicode   ( (⊕) )+import "base-unicode-symbols" Data.Ord.Unicode      ( (≥) )+import qualified "containers" Data.Map as M ( Map, fromList, lookup )+import "containers-unicode-symbols" Data.Map.Unicode ( (∪) )+import           "numerals-base" Text.Numeral+import           "numerals-base" Text.Numeral.Misc ( dec )+import qualified "numerals-base" Text.Numeral.Exp.Classes as C+++--------------------------------------------------------------------------------+-- ZH+--------------------------------------------------------------------------------++{-+Sources:+  http://www.sf.airnet.ne.jp/~ts/language/number/mandarin.html+-}++flipIfR ∷ Side → (α → α → α) → (α → α → α)+flipIfR L = id+flipIfR R = flip++add0 ∷ (Integral α, C.Lit β, C.Add β) ⇒ α → Rule α β+add0 val f n | n < val `div` 10 = C.lit 0 `C.add` f n+             | otherwise        = f n++mulX ∷ (Integral α, C.Lit β, C.Add β, C.Mul β)+     ⇒ α → Side → Side → Rule α β+mulX val aSide mSide =+    \f n → let (m, a) = n `divMod` val+               mval = if m ≡ 1+                      then C.lit 1 ⊡ C.lit (fromIntegral val)+                      else f m ⊡ C.lit (fromIntegral val)+           in if a ≡ 0+              then mval+              else (flipIfR aSide C.add) (add0 val f a) mval+  where+     (⊡) = flipIfR mSide C.mul++struct ∷ (Integral α, C.Unknown β, C.Lit β, C.Neg β, C.Add β, C.Mul β) ⇒ α → β+struct = pos+       $ fix+       $ findRule (0, lit)+                  ( [(dec 1, step  (dec 1) (dec 1) R L)]+                  ⊕ [(dec n, stepX (dec n) (dec 1) R L) | n ← [2,3]]+                  ⊕ [(dec n, stepX (dec n) (dec 4) R L) | n ← [4,8..44]]+                  )+                  (dec 48 - 1)+    where+      stepX = mkStep lit1 addX mulX++      addX val _ = \f n → C.add (f val) (add0 val f $ n - val)++cardinalRepr ∷ (Monoid s, IsString s) ⇒ Repr s+cardinalRepr = defaultRepr+               { reprAdd = Just $ \_ _ _ → ""+               , reprMul = Just $ \_ _ _ → ""+               }+++--------------------------------------------------------------------------------+-- Traditional Characters+--------------------------------------------------------------------------------++trad_cardinal ∷ (Integral α, Monoid s, IsString s) ⇒ α → Maybe s+trad_cardinal = trad_cardinalRepr ∘ struct++trad_cardinalRepr ∷ (Monoid s, IsString s) ⇒ Exp → Maybe s+trad_cardinalRepr =+    render cardinalRepr+    { reprValue = \n → M.lookup n trad_syms+    , reprNeg = Just $ \_ _ → "負"+    }++trad_syms ∷ (Integral α, IsString s) ⇒ M.Map α (Ctx Exp → s)+trad_syms =+    M.fromList+    [ (0, \c → case c of+                 CtxEmpty → "零"+                 _        → "〇"+      )+    , (1, const "一")+    , (2, \c → case c of+                 CtxMul _ (Lit n) _ | n ≥ 1000 → "兩"+                 _ → "二"+      )+    , (3, const "三")+    , (4, const "四")+    , (5, const "五")+    , (6, const "六")+    , (7, const "七")+    , (8, const "八")+    , (9, const "九")+    , (10, const "十")+    , (100, const "百")+    , (1000, const "千")+    , (dec 4, const "萬")+    , (dec 8, const "億")+    , (dec 12, const "兆")+    , (dec 16, const "京")+    , (dec 20, const "垓")+    , (dec 24, const "秭")+    , (dec 28, const "穰")+    , (dec 32, const "溝")+    , (dec 36, const "澗")+    , (dec 40, const "正")+    , (dec 44, const "載")+    ]+++--------------------------------------------------------------------------------+-- Simplified Characters+--------------------------------------------------------------------------------++simpl_cardinal ∷ (Integral α, Monoid s, IsString s) ⇒ α → Maybe s+simpl_cardinal = simpl_cardinalRepr ∘ struct++simpl_cardinalRepr ∷ (Monoid s, IsString s) ⇒ Exp → Maybe s+simpl_cardinalRepr =+    render cardinalRepr+            { reprValue = \n → M.lookup n (simpl_syms ∪ trad_syms)+            , reprNeg = Just $ \_ _ → "负"+            }++simpl_syms ∷ (Integral α, IsString s) ⇒ M.Map α (Ctx Exp → s)+simpl_syms =+    M.fromList+    [ (2, \c → case c of+                 CtxMul _ (Lit n) _ | n ≥ 1000 → "两"+                 _ → "二"+      )+    , (dec 4, const "万")+    , (dec 8, const "亿")+    ]+++--------------------------------------------------------------------------------+-- Financial Characters (Traditional)+--------------------------------------------------------------------------------++finance_trad_cardinal ∷ (Integral α, Monoid s, IsString s) ⇒ α → Maybe s+finance_trad_cardinal = finance_trad_cardinalRepr ∘ struct++finance_trad_cardinalRepr ∷ (Monoid s, IsString s) ⇒ Exp → Maybe s+finance_trad_cardinalRepr =+    render cardinalRepr+    { reprValue = \n → M.lookup n (finance_trad_syms ∪ trad_syms)+    , reprNeg = Just $ \_ _ → "負"+    }++finance_trad_syms ∷ (Integral α, IsString s) ⇒ M.Map α (Ctx Exp → s)+finance_trad_syms =+    M.fromList+    [ (0, const "零")+    , (1, const "壹")+    , (2, const "貳")+    , (3, const "参")+    , (4, const "肆")+    , (5, const "伍")+    , (6, const "陸")+    , (7, const "柒")+    , (8, const "捌")+    , (9, const "玖")+    , (10, const "拾")+    , (100, const "伯")+    , (1000, const "仟")+    , (dec 4, const "萬")+    , (dec 8, const "億")+    ]+++--------------------------------------------------------------------------------+-- Financial Characters (Simplified)+--------------------------------------------------------------------------------++finance_simpl_cardinal ∷ (Integral α, Monoid s, IsString s) ⇒ α → Maybe s+finance_simpl_cardinal = finance_simpl_cardinalRepr ∘ struct++finance_simpl_cardinalRepr ∷ (Monoid s, IsString s) ⇒ Exp → Maybe s+finance_simpl_cardinalRepr =+    render cardinalRepr+    { reprValue = \n → M.lookup n ( finance_simpl_syms+                                  ∪ finance_trad_syms+                                  ∪ trad_syms+                                  )+    , reprNeg = Just $ \_ _ → "负"+    }+  where+    finance_simpl_syms ∷ (Integral α, IsString s) ⇒ M.Map α (Ctx Exp → s)+    finance_simpl_syms =+        M.fromList+        [ (2, const "贰")+        , (6, const "陆")+        , (dec 4, const "万")+        , (dec 8, const "亿")+        ]+++--------------------------------------------------------------------------------+-- Pinyin+--------------------------------------------------------------------------------++pinyin_cardinal ∷ (Integral α, Monoid s, IsString s) ⇒ α → Maybe s+pinyin_cardinal = pinyin_cardinalRepr ∘ struct++pinyin_cardinalRepr ∷ (Monoid s, IsString s) ⇒ Exp → Maybe s+pinyin_cardinalRepr =+    render cardinalRepr+            { reprValue = \n → M.lookup n pinyin_syms+            , reprNeg = Just $ \_ _ → "fù"+            , reprAdd = Just (⊞)+            }+  where+    (Lit 10 ⊞ _) _ = ""+    (_      ⊞ _) _ = " "++    pinyin_syms ∷ (Integral α, IsString s) ⇒ M.Map α (Ctx Exp → s)+    pinyin_syms =+        M.fromList+        [ (0, const "líng")+        , (1, const "yī")+        , (2, \c → case c of+                     CtxMul _ (Lit n) _ | n ≥ 1000 → "liǎng"+                     _ → "èr"+          )+        , (3, const "sān")+        , (4, const "sì")+        , (5, const "wǔ")+        , (6, const "liù")+        , (7, const "qī")+        , (8, const "bā")+        , (9, const "jiǔ")+        , (10, const "shí")+        , (100, const "bǎi")+        , (1000, const "qiān")+        , (dec 4, const "wàn")+        , (dec 8, const "yì")+        , (dec 12, const "zhào")+        , (dec 16, const "jīng")+        , (dec 20, const "gāi")+        , (dec 24, const "zǐ")+        , (dec 28, const "ráng")+        , (dec 32, const "gōu")+        , (dec 36, const "jiàn")+        , (dec 40, const "zhēng")+        , (dec 44, const "zài")+        ]