diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -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. diff --git a/README b/README deleted file mode 100644 --- a/README +++ /dev/null @@ -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! diff --git a/README.markdown b/README.markdown new file mode 100644 --- /dev/null +++ b/README.markdown @@ -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)) diff --git a/TODO b/TODO deleted file mode 100644 --- a/TODO +++ /dev/null @@ -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. diff --git a/Text/Numeral.hs b/Text/Numeral.hs deleted file mode 100644 --- a/Text/Numeral.hs +++ /dev/null @@ -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 diff --git a/Text/Numeral/Debug.hs b/Text/Numeral/Debug.hs deleted file mode 100644 --- a/Text/Numeral/Debug.hs +++ /dev/null @@ -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 " - -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 diff --git a/Text/Numeral/Joinable.hs b/Text/Numeral/Joinable.hs deleted file mode 100644 --- a/Text/Numeral/Joinable.hs +++ /dev/null @@ -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 diff --git a/Text/Numeral/Language.hs b/Text/Numeral/Language.hs deleted file mode 100644 --- a/Text/Numeral/Language.hs +++ /dev/null @@ -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 diff --git a/Text/Numeral/Language/DE.hs b/Text/Numeral/Language/DE.hs deleted file mode 100644 --- a/Text/Numeral/Language/DE.hs +++ /dev/null @@ -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" - ] diff --git a/Text/Numeral/Language/EN.hs b/Text/Numeral/Language/EN.hs deleted file mode 100644 --- a/Text/Numeral/Language/EN.hs +++ /dev/null @@ -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" - ] diff --git a/Text/Numeral/Language/EO.hs b/Text/Numeral/Language/EO.hs deleted file mode 100644 --- a/Text/Numeral/Language/EO.hs +++ /dev/null @@ -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" - ] diff --git a/Text/Numeral/Language/FR.hs b/Text/Numeral/Language/FR.hs deleted file mode 100644 --- a/Text/Numeral/Language/FR.hs +++ /dev/null @@ -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" diff --git a/Text/Numeral/Language/IT.hs b/Text/Numeral/Language/IT.hs deleted file mode 100644 --- a/Text/Numeral/Language/IT.hs +++ /dev/null @@ -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" diff --git a/Text/Numeral/Language/JA.hs b/Text/Numeral/Language/JA.hs deleted file mode 100644 --- a/Text/Numeral/Language/JA.hs +++ /dev/null @@ -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ū" - ] diff --git a/Text/Numeral/Language/LA.hs b/Text/Numeral/Language/LA.hs deleted file mode 100644 --- a/Text/Numeral/Language/LA.hs +++ /dev/null @@ -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" - ] diff --git a/Text/Numeral/Language/NL.hs b/Text/Numeral/Language/NL.hs deleted file mode 100644 --- a/Text/Numeral/Language/NL.hs +++ /dev/null @@ -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") diff --git a/Text/Numeral/Language/NO.hs b/Text/Numeral/Language/NO.hs deleted file mode 100644 --- a/Text/Numeral/Language/NO.hs +++ /dev/null @@ -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" - ] diff --git a/Text/Numeral/Language/PT.hs b/Text/Numeral/Language/PT.hs deleted file mode 100644 --- a/Text/Numeral/Language/PT.hs +++ /dev/null @@ -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" diff --git a/Text/Numeral/Language/SP.hs b/Text/Numeral/Language/SP.hs deleted file mode 100644 --- a/Text/Numeral/Language/SP.hs +++ /dev/null @@ -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" - ] diff --git a/Text/Numeral/Language/SV.hs b/Text/Numeral/Language/SV.hs deleted file mode 100644 --- a/Text/Numeral/Language/SV.hs +++ /dev/null @@ -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" - ] diff --git a/Text/Numeral/Misc.hs b/Text/Numeral/Misc.hs deleted file mode 100644 --- a/Text/Numeral/Misc.hs +++ /dev/null @@ -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 : _) = [] diff --git a/Text/Numeral/Pelletier.hs b/Text/Numeral/Pelletier.hs deleted file mode 100644 --- a/Text/Numeral/Pelletier.hs +++ /dev/null @@ -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 - diff --git a/Text/Numeral/Positional.hs b/Text/Numeral/Positional.hs deleted file mode 100644 --- a/Text/Numeral/Positional.hs +++ /dev/null @@ -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 diff --git a/Text/Numeral/Roman.hs b/Text/Numeral/Roman.hs deleted file mode 100644 --- a/Text/Numeral/Roman.hs +++ /dev/null @@ -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 diff --git a/numerals.cabal b/numerals.cabal --- a/numerals.cabal +++ b/numerals.cabal @@ -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 , Bas van Dijk -maintainer: Roel van Dijk , Bas van Dijk -copyright: (c) 2009 Roel van Dijk, Bas van Dijk +maintainer: Roel van Dijk +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 + diff --git a/src/Text/Numeral/Language/AMP.hs b/src/Text/Numeral/Language/AMP.hs new file mode 100644 --- /dev/null +++ b/src/Text/Numeral/Language/AMP.hs @@ -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" + ) + ] diff --git a/src/Text/Numeral/Language/CHN.hs b/src/Text/Numeral/Language/CHN.hs new file mode 100644 --- /dev/null +++ b/src/Text/Numeral/Language/CHN.hs @@ -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") + ] diff --git a/src/Text/Numeral/Language/DE.hs b/src/Text/Numeral/Language/DE.hs new file mode 100644 --- /dev/null +++ b/src/Text/Numeral/Language/DE.hs @@ -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" + ) + ] diff --git a/src/Text/Numeral/Language/EN.hs b/src/Text/Numeral/Language/EN.hs new file mode 100644 --- /dev/null +++ b/src/Text/Numeral/Language/EN.hs @@ -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 diff --git a/src/Text/Numeral/Language/EO.hs b/src/Text/Numeral/Language/EO.hs new file mode 100644 --- /dev/null +++ b/src/Text/Numeral/Language/EO.hs @@ -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") + ] diff --git a/src/Text/Numeral/Language/ES.hs b/src/Text/Numeral/Language/ES.hs new file mode 100644 --- /dev/null +++ b/src/Text/Numeral/Language/ES.hs @@ -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") + ] + diff --git a/src/Text/Numeral/Language/FR.hs b/src/Text/Numeral/Language/FR.hs new file mode 100644 --- /dev/null +++ b/src/Text/Numeral/Language/FR.hs @@ -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" + ) + ] diff --git a/src/Text/Numeral/Language/GV.hs b/src/Text/Numeral/Language/GV.hs new file mode 100644 --- /dev/null +++ b/src/Text/Numeral/Language/GV.hs @@ -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") + ] diff --git a/src/Text/Numeral/Language/IT.hs b/src/Text/Numeral/Language/IT.hs new file mode 100644 --- /dev/null +++ b/src/Text/Numeral/Language/IT.hs @@ -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") + ] diff --git a/src/Text/Numeral/Language/JA.hs b/src/Text/Numeral/Language/JA.hs new file mode 100644 --- /dev/null +++ b/src/Text/Numeral/Language/JA.hs @@ -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" diff --git a/src/Text/Numeral/Language/LA.hs b/src/Text/Numeral/Language/LA.hs new file mode 100644 --- /dev/null +++ b/src/Text/Numeral/Language/LA.hs @@ -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" + ) + ] diff --git a/src/Text/Numeral/Language/MG.hs b/src/Text/Numeral/Language/MG.hs new file mode 100644 --- /dev/null +++ b/src/Text/Numeral/Language/MG.hs @@ -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 diff --git a/src/Text/Numeral/Language/NL.hs b/src/Text/Numeral/Language/NL.hs new file mode 100644 --- /dev/null +++ b/src/Text/Numeral/Language/NL.hs @@ -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 diff --git a/src/Text/Numeral/Language/NO.hs b/src/Text/Numeral/Language/NO.hs new file mode 100644 --- /dev/null +++ b/src/Text/Numeral/Language/NO.hs @@ -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 diff --git a/src/Text/Numeral/Language/NQM.hs b/src/Text/Numeral/Language/NQM.hs new file mode 100644 --- /dev/null +++ b/src/Text/Numeral/Language/NQM.hs @@ -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") + ] diff --git a/src/Text/Numeral/Language/OJ.hs b/src/Text/Numeral/Language/OJ.hs new file mode 100644 --- /dev/null +++ b/src/Text/Numeral/Language/OJ.hs @@ -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 diff --git a/src/Text/Numeral/Language/PT.hs b/src/Text/Numeral/Language/PT.hs new file mode 100644 --- /dev/null +++ b/src/Text/Numeral/Language/PT.hs @@ -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")] diff --git a/src/Text/Numeral/Language/RU.hs b/src/Text/Numeral/Language/RU.hs new file mode 100644 --- /dev/null +++ b/src/Text/Numeral/Language/RU.hs @@ -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 "миллиард") + ] diff --git a/src/Text/Numeral/Language/SCO.hs b/src/Text/Numeral/Language/SCO.hs new file mode 100644 --- /dev/null +++ b/src/Text/Numeral/Language/SCO.hs @@ -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 diff --git a/src/Text/Numeral/Language/SV.hs b/src/Text/Numeral/Language/SV.hs new file mode 100644 --- /dev/null +++ b/src/Text/Numeral/Language/SV.hs @@ -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") + ] diff --git a/src/Text/Numeral/Language/TR.hs b/src/Text/Numeral/Language/TR.hs new file mode 100644 --- /dev/null +++ b/src/Text/Numeral/Language/TR.hs @@ -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" + ) + ] diff --git a/src/Text/Numeral/Language/WO.hs b/src/Text/Numeral/Language/WO.hs new file mode 100644 --- /dev/null +++ b/src/Text/Numeral/Language/WO.hs @@ -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" + _ → "" diff --git a/src/Text/Numeral/Language/YOR.hs b/src/Text/Numeral/Language/YOR.hs new file mode 100644 --- /dev/null +++ b/src/Text/Numeral/Language/YOR.hs @@ -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 diff --git a/src/Text/Numeral/Language/ZH.hs b/src/Text/Numeral/Language/ZH.hs new file mode 100644 --- /dev/null +++ b/src/Text/Numeral/Language/ZH.hs @@ -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") + ]