numerals (empty) → 0.1
raw patch · 25 files changed
+1868/−0 lines, 25 filesdep +basedep +bytestringdep +dstringsetup-changed
Dependencies added: base, bytestring, dstring, mtl, pretty, text
Files
- LICENSE +32/−0
- README +65/−0
- Setup.hs +3/−0
- TODO +63/−0
- Text/Numeral.hs +166/−0
- Text/Numeral/Debug.hs +166/−0
- Text/Numeral/Joinable.hs +58/−0
- Text/Numeral/Language.hs +36/−0
- Text/Numeral/Language/DE.hs +60/−0
- Text/Numeral/Language/EN.hs +69/−0
- Text/Numeral/Language/EO.hs +44/−0
- Text/Numeral/Language/FR.hs +71/−0
- Text/Numeral/Language/IT.hs +77/−0
- Text/Numeral/Language/JA.hs +65/−0
- Text/Numeral/Language/LA.hs +75/−0
- Text/Numeral/Language/NL.hs +59/−0
- Text/Numeral/Language/NO.hs +63/−0
- Text/Numeral/Language/PT.hs +75/−0
- Text/Numeral/Language/SP.hs +80/−0
- Text/Numeral/Language/SV.hs +74/−0
- Text/Numeral/Misc.hs +20/−0
- Text/Numeral/Pelletier.hs +74/−0
- Text/Numeral/Positional.hs +97/−0
- Text/Numeral/Roman.hs +216/−0
- numerals.cabal +60/−0
+ LICENSE view
@@ -0,0 +1,32 @@+Copyright (c) 2009 Roel van Dijk, Bas van Dijk++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * The names of Roel van Dijk and Bas van Dijk and the names of+ contributors may NOT be used to endorse or promote products+ derived from this software without specific prior written+ permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README view
@@ -0,0 +1,65 @@+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!
+ Setup.hs view
@@ -0,0 +1,3 @@+import Distribution.Simple++main = defaultMain
+ TODO view
@@ -0,0 +1,63 @@+Also see: http://conway.rutgers.edu/~ccshan/wiki/blog/posts/WordNumbers1/++*** Features ***++Conversions between:+ - Numbers and linguistic numerals+ - Numbers and representations in numeral systems+++*** Linguistic numerals ***++Cardinal numerals:+ How many items - one, two, three++Ordinal numerals:+ Position - first, second, third.+ en 1 = first+ en 2 = second+ en 32 = thirty-second+ nl 8 = achtste+ nl 9 = negende+ nl 89 = negenentachtigste++Partitive numerals:+ Expresses a fraction - half, third, quarter.+ en 1%2 = half+ en 2%3 = two thirds+ nl 2%3 = twee derden+ nl 3%4 = drie kwart++Decimals:+ Fractions of powers of ten+ en 0.7 = seven-tenths+ en 0.065 = sixty-five thousanths+ nl 0.28 = achtentwintig honderdsten++Multiplicative numerals:+ How many times - once, twice, thrice.+ en 1 = once+ en 2 = twice+ en 3 = thrice+ en [4..] = undefined - or use a convention like "four times,+ five times, etc."++Distributive numerals:+ Expresses a group of the number specified: In pairs, by the+ dozen. English does not have distributive numerals for these but+ other languages such as Georgian do.+++*** Numeral systems ***++Positional systems:+ Binary, octal, decimal, hexadecimal, vigesimal etc.+ Also support floating point numbers.++Concatenative systems:+ Roman numerals+++*** TODOS ***++Use a package which defines polynomials for the positional numeral systems stuff.
+ Text/Numeral.hs view
@@ -0,0 +1,166 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++module Text.Numeral+ ( -- *Types+ NumConfig(..)+ , NumSymbol(..)+ , SymbolType(..)+ , SymbolContext(..)+ , Gender(..)++ -- *Cardinals+ , cardinal+ , findSym++ -- *Smart NumSymbol constructors+ , term, add, mul+ , termG, addG, mulG++ -- *Symbol representation helper functions+ , gender, genderN+ , tenForms, tenFormsG, tenForms', mulForms+ )+ where++-------------------------------------------------------------------------------+-- Types+-------------------------------------------------------------------------------++data NumConfig s = NumConfig { ncCardinal :: Integer -> Maybe (NumSymbol s)+ , ncNeg :: s -> s+ , ncOne :: (Integer, s) -> s+ , ncAdd :: (Integer, s) -> (Integer, s) -> s+ , ncMul :: (Integer, s) -> (Integer, s) -> s+ }++data NumSymbol s = NumSym { symType :: SymbolType+ , symVal :: Integer+ , symScope :: Integer+ , symRepr :: Gender -> SymbolContext -> s+ }++data SymbolType = Terminal | Add | Mul deriving Show++data SymbolContext = EmptyContext+ | LA Integer SymbolContext+ | RA Integer SymbolContext+ | LM Integer SymbolContext+ | RM Integer SymbolContext+ deriving Show++-- | Grammatical gender+data Gender = Neuter | Masculine | Feminine deriving Show++-------------------------------------------------------------------------------+-------------------------------------------------------------------------------++cardinal :: NumConfig s -> Gender -> Integer -> Maybe s+cardinal NumConfig {..} g x | x < 0 = fmap ncNeg $ go EmptyContext $ abs x+ | x == 0 = fmap (\sym -> symRepr sym g EmptyContext) $ ncCardinal 0+ | otherwise = go EmptyContext x+ where go ctx n = do (NumSym _ v _ rv) <- ncCardinal n+ case n `divMod` v of+ (1, 0) -> return $ ncOne (v, rv g ctx)+ (1, r) -> do rs <- go (RA v ctx) r+ return $ (v, ncOne (v, rv g (LA r ctx))) `ncAdd` (r, rs)+ (q, r) | q >= v -> Nothing+ | otherwise -> do qs <- go (LM v ctx) q+ if r == 0+ then return $ (q, qs) `ncMul` (v, rv g (RM q ctx))+ else do let qv = q * v+ rs <- go (RA qv ctx) r+ return $ (qv, (q, qs) `ncMul` (v, rv g (RM q (LA qv ctx)))) `ncAdd` (r, rs)++-------------------------------------------------------------------------------+-------------------------------------------------------------------------------++findSym :: [NumSymbol s] -> Integer -> Maybe (NumSymbol s)+findSym [] _ = Nothing+findSym (e:es) n = go e e es+ where go :: NumSymbol s -> NumSymbol s -> [NumSymbol s] -> Maybe (NumSymbol s)+ go a m [] = stop a m+ go a m (x@(NumSym t v _ _) : xs)+ | v == n = Just x+ | otherwise = case t of+ Terminal -> go a m xs+ Add | v > n -> stop a m+ | otherwise -> go x m xs+ Mul | v > n -> stop a m+ | otherwise -> go a x xs++ stop :: NumSymbol s -> NumSymbol s -> Maybe (NumSymbol s)+ stop a@(NumSym {..}) m | n < symVal + symScope = return a+ | otherwise = return m++-------------------------------------------------------------------------------+-- Smart NumSymbol constructors+-------------------------------------------------------------------------------++termG :: Integer -> (Gender -> SymbolContext -> s) -> NumSymbol s+termG val fs = NumSym Terminal val 1 fs++addG :: Integer -> Integer -> (Gender -> SymbolContext -> s) -> NumSymbol s+addG scope val fs = NumSym Add scope val fs++mulG :: Integer -> (Gender -> SymbolContext -> s) -> NumSymbol s+mulG val fs = NumSym Mul val val fs++term :: Integer -> (SymbolContext -> s) -> NumSymbol s+term val fs = termG val $ const fs++add :: Integer -> Integer -> (SymbolContext -> s) -> NumSymbol s+add scope val fs = addG scope val $ const fs++mul :: Integer -> (SymbolContext -> s) -> NumSymbol s+mul val fs = mulG val $ const fs++-------------------------------------------------------------------------------+-- Symbol representation helper functions+-------------------------------------------------------------------------------++-- Differentiate between masculine and feminine genders. Other genders+-- default to masculine.+gender :: s -> s -> (Gender -> s)+gender _ f Feminine = f+gender m _ _ = m++-- Differentiate between neuter, masculine and feminine genders+genderN :: s -> s -> s -> (Gender -> s)+genderN n _ _ Neuter = n+genderN _ m _ Masculine = m+genderN _ _ f Feminine = f+++-- |Constructs a symbol representation based on the relation of the+-- symbol with the number 10.+-- The chosen representation depends on the context in which the+-- symbol is used:+-- d) default: x+-- a) additive: 10 + x+-- m) multiplicative: x * 10+tenForms :: s -> s -> s -> (SymbolContext -> s)+tenForms _ a _ (RA 10 _) = a+tenForms _ _ m (LM 10 _) = m+tenForms d _ _ _ = d++tenFormsG :: (Gender -> s) -> (Gender -> s) -> (Gender -> s) -> (Gender -> SymbolContext -> s)+tenFormsG d a m g ctx = tenForms (d g) (a g) (m g) ctx++-- |Constructs a symbol representation based on the relation of the+-- symbol with the number 10.+-- The chosen representation depends on the context in which the+-- symbol is used:+-- d) default: x+-- a) additive: 10 + x+-- mt) multiplicative: x * 10+-- mh) multiplicative: x * 100+tenForms' :: s -> s -> s -> s -> (SymbolContext -> s)+tenForms' _ a _ _ (RA 10 _) = a+tenForms' _ _ mt _ (LM 10 _) = mt+tenForms' _ _ _ mh (LM 100 _) = mh+tenForms' d _ _ _ _ = d++mulForms :: s -> s -> (SymbolContext -> s)+mulForms _ p (RM {}) = p+mulForms s _ _ = s
+ Text/Numeral/Debug.hs view
@@ -0,0 +1,166 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeSynonymInstances #-}++module Text.Numeral.Debug where++import Data.String+import Text.Numeral+import Text.Numeral.Joinable+import Text.Numeral.Misc (const2, withSnd)+import Text.Numeral.Language++import qualified Data.DString as DS+import qualified Data.ByteString.Char8 as B+import qualified Data.Text as T+import qualified Text.PrettyPrint as PP++-------------------------------------------------------------------------------++class Stringable s where+ toString :: s -> String++instance Stringable String where+ toString = id++instance Stringable B.ByteString where+ toString = B.unpack++instance Stringable T.Text where+ toString = T.unpack++instance Stringable ShowS where+ toString s = s []++instance Stringable DS.DString where+ toString = DS.toString++instance Stringable PP.Doc where+ toString = PP.render++-------------------------------------------------------------------------------++type Test s = NumConfig s -> Gender -> [Integer] -> IO ()++test :: Stringable s => Test s+test nc g = mapM_ (putStrLn . pretty)+ where pretty n = show n ++ " == " ++ (maybe "-" id $ fmap toString $ cardinal nc g n)++testS :: Test String+testS = test++testBS :: Test B.ByteString+testBS = test++testT :: Test T.Text+testT = test++testSS :: Test ShowS+testSS = test++testDS :: Test DS.DString+testDS = test++testDoc :: Test PP.Doc+testDoc = test++testDocWithStyle :: PP.Style -> NumConfig PP.Doc -> Gender -> [Integer] -> IO ()+testDocWithStyle s nc g = mapM_ (putStrLn . pretty)+ where pretty n = show n ++ " == " ++ (maybe "-" id $ fmap (PP.renderStyle s) $ cardinal nc g n)++-------------------------------------------------------------------------------++-- | @nummify@ transforms the given NumConfig to a numeric NumConfig+-- such that 'prop_cardinal_nummify' holds. @nummify@ is thus usefull+-- as a testing aid. @nummify@ is also usefull as a debugging aid+-- when you use a suitable numeric type such as 'NS' which renders a+-- numeric expression to a string representing the same expression.+nummify :: Num n => NumConfig s -> NumConfig n+nummify (NumConfig {..}) = NumConfig { ncCardinal = fmap transformSym . ncCardinal+ , ncNeg = negate+ , ncOne = snd+ , ncAdd = withSnd (+)+ , ncMul = withSnd (*)+ }+ where+ -- Create a new symbol who's representation is its value.+ transformSym :: (Num n) => NumSymbol s -> NumSymbol n+ transformSym sym = sym { symRepr = const2 . fromInteger . symVal $ sym}++-- | 'prop_cardinal_nummify' specifies the correctness of 'cardinal'.+prop_cardinal_nummify :: NumConfig String -> Gender -> Integer -> Bool+prop_cardinal_nummify nc g n = maybe True (== n) $ cardinal (nummify nc) g n++-------------------------------------------------------------------------------++-- | 'NS' is used+newtype NS s = NS {unNS :: Precedence -> s}++type Precedence = Int++-- The following bogus Show and Eq instances are needed for Num :-(++instance Show (NS s) where+ show _ = "NS <function>"++instance Eq (NS s) where+ _ == _ = False++instance (IsString s, Joinable s) => Num (NS s) where+ fromInteger = NS . const . fromString . show++ (+) = bin "+" 6+ (-) = bin "-" 6+ (*) = bin "*" 7++ negate = un "negate"+ abs = un "abs"+ signum = un "signum"++un :: (IsString s, Joinable s) => s -> (NS s -> NS s)+un sFun x = NS $ \p -> paren (p > precApp)+ (sFun <+> unNS x (precApp+1))+ where+ precApp = 10++bin :: (IsString s, Joinable s) => s -> Precedence -> (NS s -> NS s -> NS s)+bin sOp d x y = NS $ \p -> paren (p > d) $+ let p' = d + 1+ in unNS x p' <+> sOp <+> unNS y p'++paren :: (IsString s, Joinable s) => Bool -> s -> s+paren True s = "(" <> s <> ")"+paren False s = s++instance Stringable s => Stringable (NS s) where+ toString (NS f) = toString $ f 0++testNSS :: Test (NS String)+testNSS = test++testNumS :: Test String+testNumS = testNSS . nummify++-------------------------------------------------------------------------------++newtype Lst s = Lst {unLst :: [s]}++instance Joinable s => Joinable (Lst s) where+ x <> y = Lst $ appendUnionWith (<>) (unLst x) (unLst y)+ x <+> y = Lst $ unLst x ++ unLst y++-- | appendUnionWith f [a, b, c] [d, e, f] => [a, b, c `f` d, e, f]+appendUnionWith :: (a -> a -> a) -> [a] -> [a] -> [a]+appendUnionWith _ [] ys = ys+appendUnionWith _ xs [] = xs+appendUnionWith f [x] (y:ys) = x `f` y : ys+appendUnionWith f (x:xs) ys = x : appendUnionWith f xs ys++instance IsString s => IsString (Lst s) where+ fromString s = Lst [fromString s]++instance Stringable s => Stringable (Lst s) where+ toString = show . map toString . unLst++testLst :: Test (Lst String)+testLst = test
+ Text/Numeral/Joinable.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeSynonymInstances #-}++module Text.Numeral.Joinable where++import Data.Monoid+import Data.String++import qualified Data.DString as DS+import qualified Data.ByteString.Char8 as B+import qualified Data.Text as T+import qualified Text.PrettyPrint as PP+++-- | Class of string-like types which can be joined.+class Joinable s where+ (<>) :: s -> s -> s+ (<+>) :: s -> s -> s++infixr 5 <>, <+>, <->++(<->) :: (Joinable s, IsString s) => s -> s -> s+x <-> y = x <> "-" <> y++space :: (Joinable s, IsString s) => s -> s -> s+space x y = x <> " " <> y++instance Joinable String where+ (<>) = mappend+ (<+>) = space++instance Joinable B.ByteString where+ (<>) = mappend+ (<+>) = space++instance Joinable T.Text where+ (<>) = mappend+ (<+>) = space++instance Joinable ShowS where+ (<>) = mappend+ (<+>) = space++instance Joinable DS.DString where+ (<>) = mappend+ (<+>) = space++instance Joinable PP.Doc where+ (<>) = (PP.<>)+ (<+>) = (PP.<+>)++-------------------------------------------------------------------------------++instance IsString ShowS where+ fromString = showString++instance IsString PP.Doc where+ fromString = PP.text
+ Text/Numeral/Language.hs view
@@ -0,0 +1,36 @@+module Text.Numeral.Language+ ( -- *West Germanic+ module Text.Numeral.Language.NL+ , module Text.Numeral.Language.DE+ , module Text.Numeral.Language.EN+ -- *North Germanic+ , module Text.Numeral.Language.SV+ , module Text.Numeral.Language.NO+ -- *Romance+ , module Text.Numeral.Language.FR+ , module Text.Numeral.Language.IT+ , module Text.Numeral.Language.LA+ , module Text.Numeral.Language.PT+ , module Text.Numeral.Language.SP+ -- *Japonic+ , module Text.Numeral.Language.JA+ -- *Constructed+ , module Text.Numeral.Language.EO+ ) where++import Text.Numeral.Language.NL+import Text.Numeral.Language.DE+import Text.Numeral.Language.EN++import Text.Numeral.Language.SV+import Text.Numeral.Language.NO++import Text.Numeral.Language.FR+import Text.Numeral.Language.IT+import Text.Numeral.Language.LA+import Text.Numeral.Language.PT+import Text.Numeral.Language.SP++import Text.Numeral.Language.JA++import Text.Numeral.Language.EO
+ Text/Numeral/Language/DE.hs view
@@ -0,0 +1,60 @@+-- -*- coding: utf-8 -*-++{-# LANGUAGE CPP, OverloadedStrings #-}++module Text.Numeral.Language.DE (de) where++import Data.String+import Text.Numeral+import Text.Numeral.Joinable+import Text.Numeral.Misc (d, withSnd)++#ifdef DO_SPECIALISE+import qualified Data.ByteString as B+import qualified Data.DString as DS++{-# SPECIALISE de :: NumConfig String #-}+{-# SPECIALISE de :: NumConfig B.ByteString #-}+{-# SPECIALISE de :: NumConfig DS.DString #-}+#endif++de :: (IsString s, Joinable s) => NumConfig s+de = NumConfig { ncNeg = ("minus" <+>)+ , ncOne = deOne+ , ncAdd = deAdd+ , ncMul = withSnd (<>)+ , ncCardinal = findSym deTable+ }++deOne :: (IsString s, Joinable s) => (Integer, s) -> s+deOne (v, vs) | v >= (d 6) = "eine" <+> vs+ | v >= 100 = "ein" <> vs+ | otherwise = vs++deAdd :: (IsString s, Joinable s) => (Integer, s) -> (Integer, s) -> s+deAdd (x, x') (y, y') | x < 20 = y' <> x'+ | x < 100 = (if y == 1+ then "ein"+ else y') <> "und" <> x'+ | otherwise = x' <> y'++deTable :: (IsString s, Joinable s) => [NumSymbol s]+deTable = [ term 0 $ const "null"+ , term 1 $ const "eins"+ , term 2 $ tenForms "zwei" "zwei" "zwan"+ , term 3 $ const "drei"+ , term 4 $ const "vier"+ , term 5 $ const "fünf"+ , term 6 $ const "sechs"+ , term 7 $ tenForms "sieben" "sieb" "sieb"+ , term 8 $ const "acht"+ , term 9 $ const "neun"+ , mul 10 $ mulForms "zehn" "zig"+ , term 11 $ const "elf"+ , term 12 $ const "zwölf"+ , add 30 10 $ const "dreißig"+ , mul 100 $ const "hundert"+ , mul 1000 $ const "tausend"+ , mul (d 6) $ const "million"+ , mul (d 9) $ const "milliarde"+ ]
+ Text/Numeral/Language/EN.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE CPP, OverloadedStrings #-}++module Text.Numeral.Language.EN (enShort, enLong) where++import Data.String+import Text.Numeral+import Text.Numeral.Joinable+import Text.Numeral.Pelletier (shortScale, longScale)++#ifdef DO_SPECIALISE+import qualified Data.ByteString as B+import qualified Data.DString as DS++{-# SPECIALISE enShort :: NumConfig String #-}+{-# SPECIALISE enShort :: NumConfig B.ByteString #-}+{-# SPECIALISE enShort :: NumConfig DS.DString #-}++{-# SPECIALISE enLong :: NumConfig String #-}+{-# SPECIALISE enLong :: NumConfig B.ByteString #-}+{-# SPECIALISE enLong :: NumConfig DS.DString #-}+#endif++enShort :: (IsString s, Joinable s) => NumConfig s+enShort = NumConfig { ncNeg = enNeg+ , ncOne = enOne+ , ncAdd = enAdd+ , ncMul = enMul+ , ncCardinal = findSym $ enTable ++ shortScale "illion"+ }++enLong :: (IsString s, Joinable s) => NumConfig s+enLong = enShort { ncCardinal = findSym $ enTable ++ longScale "illion" "illiard"}++enNeg :: (IsString s, Joinable s) => s -> s+enNeg = ("minus" <+>)++enOne :: (IsString s, Joinable s) => (Integer, s) -> s+enOne (v, vs) | v >= 100 = "one" <+> vs+ | otherwise = vs++enAdd :: (IsString s, Joinable s) => (Integer, s) -> (Integer, s) -> s+enAdd (x, x') (_, y') | x < 20 = y' <> x'+ | x < 100 = x' <-> y'+ | otherwise = x' <+> y'++enMul :: (IsString s, Joinable s) => (Integer, s) -> (Integer, s) -> s+enMul (_, x') (y, y') | y == 10 = x' <> y'+ | otherwise = x' <+> y'++enTable :: (IsString s, Joinable s) => [NumSymbol s]+enTable = [ term 0 $ const "zero"+ , term 1 $ const "one"+ , term 2 $ tenForms "two" "twen" "twen"+ , term 3 $ tenForms "three" "thir" "thir"+ , term 4 $ tenForms "four" "four" "for"+ , term 5 $ tenForms "five" "fif" "fif"+ , term 6 $ const "six"+ , term 7 $ const "seven"+ , term 8 $ tenForms "eight" "eigh" "eigh"+ , term 9 $ const "nine"+ , mul 10 $ \ctx -> case ctx of+ LA {} -> "teen"+ RM {} -> "ty"+ _ -> "ten"+ , term 11 $ const "eleven"+ , term 12 $ const "twelve"+ , mul 100 $ const "hundred"+ , mul 1000 $ const "thousand"+ ]
+ Text/Numeral/Language/EO.hs view
@@ -0,0 +1,44 @@+-- -*- coding: utf-8 -*-++{-# LANGUAGE CPP, OverloadedStrings #-}++module Text.Numeral.Language.EO (eo) where++import Data.String+import Text.Numeral+import Text.Numeral.Joinable+import Text.Numeral.Misc (d, withSnd)++#ifdef DO_SPECIALISE+import qualified Data.ByteString as B+import qualified Data.DString as DS++{-# SPECIALISE eo :: NumConfig String #-}+{-# SPECIALISE eo :: NumConfig B.ByteString #-}+{-# SPECIALISE eo :: NumConfig DS.DString #-}+#endif++eo :: (IsString s, Joinable s) => NumConfig s+eo = NumConfig { ncNeg = error "eoNeg: undefined"+ , ncOne = snd+ , ncAdd = withSnd (<+>)+ , ncMul = withSnd (<>)+ , ncCardinal = findSym eoTable+ }++eoTable :: (IsString s, Joinable s) => [NumSymbol s]+eoTable = [ term 0 $ const "nulo"+ , term 1 $ const "unu"+ , term 2 $ const "du"+ , term 3 $ const "tri"+ , term 4 $ const "kvar"+ , term 5 $ const "kvin"+ , term 6 $ const "ses"+ , term 7 $ const "sep"+ , term 8 $ const "ok"+ , term 9 $ const "naŭ"+ , mul 10 $ const "dek"+ , mul 100 $ const "cent"+ , mul 1000 $ const "mil"+ , mul (d 6) $ const "miliono"+ ]
+ Text/Numeral/Language/FR.hs view
@@ -0,0 +1,71 @@+-- -*- coding: utf-8 -*-++{-# LANGUAGE CPP, OverloadedStrings #-}++module Text.Numeral.Language.FR (fr) where++import Data.String+import Text.Numeral+import Text.Numeral.Joinable+import Text.Numeral.Pelletier (longScalePlural)++#ifdef DO_SPECIALISE+import qualified Data.ByteString as B+import qualified Data.DString as DS++{-# SPECIALISE fr :: NumConfig String #-}+{-# SPECIALISE fr :: NumConfig B.ByteString #-}+{-# SPECIALISE fr :: NumConfig DS.DString #-}+#endif++-- Sources:+-- http://www.cliffsnotes.com/WileyCDA/CliffsReviewTopic/Numbers.topicArticleId-25559,articleId-25469.html++fr :: (IsString s, Joinable s) => NumConfig s+fr = NumConfig { ncNeg = ("moins" <+>)+ , ncOne = snd+ , ncAdd = frAdd+ , ncMul = frMul+ , ncCardinal = findSym frTable+ }++frAdd :: (IsString s, Joinable s) => (Integer, s) -> (Integer, s) -> s+frAdd (x, x') (y, y') | x == 10 && y < 7 = y' <> x'+ | x < 80 && y == 1 = x' <+> "et" <+> y'+ | x < 100 = x' <-> y'+ | otherwise = x' <+> y'++frMul :: (IsString s, Joinable s) => (Integer, s) -> (Integer, s) -> s+frMul (_, x') (y, y') | y == 10 = x' <> y'+ | otherwise = x' <+> y'++frTable :: (IsString s, Joinable s) => [NumSymbol s]+frTable = [ term 0 $ const "zéro"+ , termG 1 $ tenFormsG (gender "un" "une") (const "on") (const "un")+ , term 2 $ tenForms "deux" "deux" "dou"+ , term 3 $ tenForms "trois" "trei" "tren"+ , term 4 $ tenForms "quatre" "quator" "quar"+ , term 5 $ tenForms "cinq" "quin" "cinqu"+ , term 6 $ tenForms "six" "sei" "soix"+ , term 7 $ const "sept"+ , term 8 $ const "huit"+ , term 9 $ const "neuf"+ , mul 10 $ \ctx -> case ctx of+ LA n _ | n < 7 -> "ze"+ | otherwise -> "dix"+ RM 3 _ -> "te"+ RM _ _ -> "ante"+ _ -> "dix"+ , add 20 10 $ const "vingt"+ , add 60 20 $ const "soixante"+ , term 71 $ const "soixante et onze"+ , term 80 $ const "quatre-vingts"+ , add 80 20 $ const "quatre-vingt"+ , mul 100 $ let c = "cent"+ in \ctx -> case ctx of+ RM _ (LA _ _) -> c+ RM _ (LM _ _) -> c+ RM _ _ -> c <> "s"+ _ -> c+ , mul 1000 $ const "mille"+ ] ++ longScalePlural "illion" "illions" "illiard" "illiards"
+ Text/Numeral/Language/IT.hs view
@@ -0,0 +1,77 @@+-- -*- coding: utf-8 -*-++{-# LANGUAGE CPP, OverloadedStrings #-}++module Text.Numeral.Language.IT (it) where++import Data.String+import Text.Numeral+import Text.Numeral.Joinable+import Text.Numeral.Misc (d)+import Text.Numeral.Pelletier (longScalePlural)++#ifdef DO_SPECIALISE+import qualified Data.ByteString as B+import qualified Data.DString as DS++{-# SPECIALISE it :: NumConfig String #-}+{-# SPECIALISE it :: NumConfig B.ByteString #-}+{-# SPECIALISE it :: NumConfig DS.DString #-}+#endif++-- Sources:+-- http://italian.about.com/library/weekly/aa042600a.htm++it :: (IsString s, Joinable s) => NumConfig s+it = NumConfig { ncNeg = error "itNeg: undefined"+ , ncOne = snd+ , ncAdd = itAdd+ , ncMul = itMul+ , ncCardinal = findSym itTable+ }++itAdd :: (IsString s, Joinable s) => (Integer, s) -> (Integer, s) -> s+itAdd (x, x') (y, y') | x == 10 && y < 7 = y' <> x'+ | y == 3 = x' <> "tré"+ | otherwise = x' <> y'++itMul :: (IsString s, Joinable s) => (Integer, s) -> (Integer, s) -> s+itMul (_, x') (y, y') | y < d 6 = x' <> y'+ | otherwise = x' <+> y'++itTable :: (IsString s, Joinable s) => [NumSymbol s]+itTable = [ term 0 $ const "zero"+ , termG 1 $ tenFormsG (gender "uno" "una") (const "un") (const "uno")+ , term 2 $ tenForms "due" "do" "due"+ , term 3 $ tenForms "tre" "tre" "ten"+ , term 4 $ tenForms "quattro" "quattor" "quar"+ , term 5 $ tenForms "cinque" "quin" "cinqu"+ , term 6 $ tenForms "sei" "se" "sess"+ , term 7 $ tenForms "sette" "assette" "sett"+ , term 8 $ tenForms "otto" "otto" "ott"+ , term 9 $ tenForms "nove" "annove" "nove"+ , mul 10 $ \ctx -> case ctx of+ LA _ _ -> "dici"+ RM 3 _ -> "ta"+ RM _ _ -> "anta"+ _ -> "dieci"+ , add 20 10 $ const "venti"+ , term 21 $ const "ventuno"+ , term 28 $ const "ventotto"+ , term 31 $ const "trentuno"+ , term 38 $ const "trentotto"+ , term 41 $ const "quarantuno"+ , term 48 $ const "quarantotto"+ , term 51 $ const "cinquantuno"+ , term 58 $ const "cinquantotto"+ , term 61 $ const "sessantuno"+ , term 68 $ const "sessantotto"+ , term 71 $ const "settantuno"+ , term 78 $ const "settantotto"+ , term 81 $ const "ottantuno"+ , term 88 $ const "ottantotto"+ , term 91 $ const "novantuno"+ , term 98 $ const "novantotto"+ , mul 100 $ const "cento"+ , mul 1000 $ mulForms "mille" "mila"+ ] ++ longScalePlural "ilione" "ilioni" "iliardo" "iliardi"
+ Text/Numeral/Language/JA.hs view
@@ -0,0 +1,65 @@+-- -*- coding: utf-8 -*-++{-# LANGUAGE CPP, OverloadedStrings #-}++module Text.Numeral.Language.JA (ja) where++import Data.String+import Text.Numeral+import Text.Numeral.Joinable+import Text.Numeral.Misc (d, withSnd)++#ifdef DO_SPECIALISE+import qualified Data.ByteString as B+import qualified Data.DString as DS++{-# SPECIALISE ja :: NumConfig String #-}+{-# SPECIALISE ja :: NumConfig B.ByteString #-}+{-# SPECIALISE ja :: NumConfig DS.DString #-}+#endif++ja :: (IsString s, Joinable s) => NumConfig s+ja = NumConfig { ncNeg = ("mainasu" <+>)+ , ncOne = jaOne+ , ncAdd = withSnd (<+>)+ , ncMul = withSnd (<->)+ , ncCardinal = findSym jaTable+ }++jaOne :: (IsString s, Joinable s) => (Integer, s) -> s+jaOne (v, vs) | v < 100 || (300 >= v && v < 400) = vs+ | otherwise = "ichi" <-> vs++jaTable :: (IsString s, Joinable s) => [NumSymbol s]+jaTable = [ term 0 $ const "rei"+ , term 1 $ const "ichi"+ , term 2 $ const "ni"+ , term 3 $ const "san"+ , term 4 $ const "yon"+ , term 5 $ const "go"+ , term 6 $ const "roku"+ , term 7 $ const "nana"+ , term 8 $ const "hachi"+ , term 9 $ const "kyū"+ , mul 10 $ const "jū"+ , mul 100 $ const "hyaku"+ , add 300 100 $ const "san-byaku" -- rendaku+ , mul 1000 $ const "sen"+ , mul (d 4) $ const "man"+ , mul (d 8) $ const "oku"+ , mul (d 12) $ const "chō"+ , mul (d 16) $ const "kei"+ , mul (d 20) $ const "gai"+ , mul (d 24) $ const "jo"+ , mul (d 28) $ const "jō"+ , mul (d 32) $ const "kō"+ , mul (d 36) $ const "kan"+ , mul (d 40) $ const "sei"+ , mul (d 44) $ const "sai"+ , mul (d 48) $ const "goku"+ , mul (d 52) $ const "gōgasha"+ , mul (d 56) $ const "asōgi"+ , mul (d 60) $ const "nayuta"+ , mul (d 64) $ const "fukashigi"+ , mul (d 68) $ const "muryōtaisū"+ ]
+ Text/Numeral/Language/LA.hs view
@@ -0,0 +1,75 @@+{-# LANGUAGE CPP, OverloadedStrings #-}++module Text.Numeral.Language.LA (la) where++import Data.String+import Text.Numeral+import Text.Numeral.Joinable+import Text.Numeral.Misc (d)++#ifdef DO_SPECIALISE+import qualified Data.ByteString as B+import qualified Data.DString as DS++{-# SPECIALISE la :: NumConfig String #-}+{-# SPECIALISE la :: NumConfig B.ByteString #-}+{-# SPECIALISE la :: NumConfig DS.DString #-}+#endif++la :: (IsString s, Joinable s) => NumConfig s+la = NumConfig { ncNeg = error "laNeg: undefined"+ , ncOne = snd+ , ncAdd = laAdd+ , ncMul = laMul+ , ncCardinal = findSym laTable+ }++laAdd :: (IsString s, Joinable s) => (Integer, s) -> (Integer, s) -> s+laAdd (x, x') (_, y') | x == 10 = y' <> x'+ | otherwise = x' <+> y'++laMul :: (IsString s, Joinable s) => (Integer, s) -> (Integer, s) -> s+laMul (_, x') (y, y') | y < 1000 = x' <> y'+ | otherwise = x' <+> y'++laTable :: (IsString s, Joinable s) => [NumSymbol s]+laTable = [ term 0 $ const "nulla"+ , term 1 $ tenForms "unus" "un" "unus"+ , term 2 $ tenForms' "duo" "duo" "vi" "du"+ , term 3 $ tenForms' "tres" "tre" "tri" "tre"+ , term 4 $ tenForms' "quattuor" "quattuor" "quadra" "quadri"+ , term 5 $ tenForms' "quinque" "quin" "quinqua" "quin"+ , term 6 $ tenForms' "sex" "se" "sexa" "ses"+ , term 7 $ tenForms' "septem" "septen" "septua" "septin"+ , term 8 $ const "octo"+ , term 9 $ tenForms' "novem" "novem" "nona" "non"+ , mul 10 $ \ctx -> case ctx of+ LA _ _ -> "decim"+ RM 2 _ -> "ginti"+ RM _ _ -> "ginta"+ _ -> "decem"+ , term 18 $ const "duodeviginti"+ , term 19 $ const "undeviginti"+ , term 28 $ const "duodetriginta"+ , term 29 $ const "undetriginta"+ , term 38 $ const "duodequadraginta"+ , term 39 $ const "undequadraginta"+ , term 48 $ const "duodequinquaginta"+ , term 49 $ const "undequinquaginta"+ , term 58 $ const "duodesexaginta"+ , term 59 $ const "undesexaginta"+ , term 68 $ const "duodeseptuaginta"+ , term 69 $ const "undeseptuaginta"+ , term 78 $ const "duodeoctoginta"+ , term 79 $ const "undeoctoginta"+ , term 88 $ const "duodenonaginta"+ , term 89 $ const "undenonaginta"+ , term 98 $ const "duodecentum"+ , term 99 $ const "undecentum"+ , mul 100 $ \ctx -> case ctx of+ RM n _ | n `elem` [2, 3, 6] -> "centi"+ | otherwise -> "genti"+ _ -> "centum"+ , mul 1000 $ mulForms "mille" "millia"+ , term (d 6) $ const "decies centena milia"+ ]
+ Text/Numeral/Language/NL.hs view
@@ -0,0 +1,59 @@+-- -*- coding: utf-8 -*-++{-# LANGUAGE CPP, OverloadedStrings #-}++module Text.Numeral.Language.NL (nl) where++import Data.String+import Text.Numeral+import Text.Numeral.Joinable+import Text.Numeral.Pelletier (longScale)++#ifdef DO_SPECIALISE+import qualified Data.ByteString as B+import qualified Data.DString as DS++{-# SPECIALISE nl :: NumConfig String #-}+{-# SPECIALISE nl :: NumConfig B.ByteString #-}+{-# SPECIALISE nl :: NumConfig DS.DString #-}+#endif++nl :: (IsString s, Joinable s) => NumConfig s+nl = NumConfig { ncNeg = ("min" <+>)+ , ncOne = snd+ , ncAdd = nlAdd+ , ncMul = nlMul+ , ncCardinal = findSym nlTable+ }++nlAdd :: (IsString s, Joinable s) => (Integer, s) -> (Integer, s) -> s+nlAdd (x, x') (y, y') | x < 20 = y' <> x'+ | x < 100 = y' <> (if y == 2 || y == 3+ then "ën"+ else "en")+ <> x'+ | otherwise = x' <+> y'++nlMul :: (IsString s, Joinable s) => (Integer, s) -> (Integer, s) -> s+nlMul (_, x') (y, y') | y <= 10 = x' <> y'+ | otherwise = x' <+> y'++nlTable :: (IsString s, Joinable s) => [NumSymbol s]+nlTable = [ term 0 $ const "nul"+ , term 1 $ const "één"+ , term 2 $ tenForms "twee" "twin" "twin"+ , term 3 $ tenForms "drie" "der" "der"+ , term 4 $ tenForms "vier" "veer" "veer"+ , term 5 $ const "vijf"+ , term 6 $ const "zes"+ , term 7 $ const "zeven"+ , term 8 $ tenForms "acht" "tach" "acht"+ , term 9 $ const "negen"+ , mul 10 $ \ctx -> case ctx of+ RM {} -> "tig"+ _ -> "tien"+ , term 11 $ const "elf"+ , term 12 $ const "twaalf"+ , mul 100 $ const "honderd"+ , mul 1000 $ const "duizend"+ ] ++ (longScale "iljoen" "iljard")
+ Text/Numeral/Language/NO.hs view
@@ -0,0 +1,63 @@+-- -*- coding: utf-8 -*-++{-# LANGUAGE CPP, OverloadedStrings #-}++module Text.Numeral.Language.NO (no) where++import Data.String+import Text.Numeral+import Text.Numeral.Joinable+import Text.Numeral.Misc (d, withSnd)++#ifdef DO_SPECIALISE+import qualified Data.ByteString as B+import qualified Data.DString as DS++{-# SPECIALISE no :: NumConfig String #-}+{-# SPECIALISE no :: NumConfig B.ByteString #-}+{-# SPECIALISE no :: NumConfig DS.DString #-}+#endif++-- Sources:+-- http://en.wikibooks.org/wiki/Norwegian_Numbers++no :: (IsString s, Joinable s) => NumConfig s+no = NumConfig { ncNeg = error "noNeg: undefined"+ , ncOne = noOne+ , ncAdd = noAdd+ , ncMul = withSnd (<>)+ , ncCardinal = findSym noTable+ }++noOne :: (IsString s, Joinable s) => (Integer, s) -> s+noOne (v, vs) | v >= (d 6) = "én" <+> vs+ | otherwise = vs++-- TODO: What are the rules for conjunction in Norse? When do you put+-- "og" between numbers?+noAdd :: (IsString s, Joinable s) => (Integer, s) -> (Integer, s) -> s+noAdd (x, x') (_, y') | x < 20 = y' <> x'+ | otherwise = x' <> y'++noTable :: (IsString s, Joinable s) => [NumSymbol s]+noTable = [ term 0 $ const "null"+ , term 1 $ const "én"+ , term 2 $ const "to"+ , term 3 $ tenForms "tre" "tret" "tret"+ , term 4 $ tenForms "fire" "fjor" "før"+ , term 5 $ const "fem"+ , term 6 $ const "seks"+ , term 7 $ tenForms "sju" "syt" "syt"+ , term 8 $ tenForms "åtte" "at" "åt"+ , term 9 $ tenForms "ni" "nit" "nit"+ , mul 10 $ \ctx -> case ctx of+ LA {} -> "ten"+ _ -> "ti"+ , term 11 $ const "elleve"+ , term 12 $ const "tolv"+ , add 20 10 $ const "tjue"+ , mul 100 $ const "hundre"+ , mul (d 3) $ const "tusen"+ , mul (d 6) $ mulForms "million" "millioner"+ , mul (d 9) $ mulForms "milliard" "milliarder"+ ]
+ Text/Numeral/Language/PT.hs view
@@ -0,0 +1,75 @@+-- -*- coding: utf-8 -*-++{-# LANGUAGE CPP, OverloadedStrings #-}++module Text.Numeral.Language.PT (pt) where++import Data.String+import Text.Numeral+import Text.Numeral.Joinable+import Text.Numeral.Pelletier (shortScalePlural)++#ifdef DO_SPECIALISE+import qualified Data.ByteString as B+import qualified Data.DString as DS++{-# SPECIALISE pt :: NumConfig String #-}+{-# SPECIALISE pt :: NumConfig B.ByteString #-}+{-# SPECIALISE pt :: NumConfig DS.DString #-}+#endif++-- Sources:+-- http://www.sonia-portuguese.com/text/numerals.htm+-- http://www.smartphrase.com/Portuguese/po_numbers_voc.shtml++pt :: (IsString s, Joinable s) => NumConfig s+pt = NumConfig { ncNeg = error "ptNeg: undefined"+ , ncOne = ptOne+ , ncAdd = ptAdd+ , ncMul = ptMul+ , ncCardinal = findSym ptTable+ }++ptOne :: (IsString s, Joinable s) => (Integer, s) -> s+ptOne (x, x') | x <= 1000 = x'+ | otherwise = "um" <+> x'++-- TODO: When to use "e" is still unclear.+ptAdd :: (IsString s, Joinable s) => (Integer, s) -> (Integer, s) -> s+ptAdd (x, x') (_, y') | x == 10 = y' <> x'+ | otherwise = x' <+> "e" <+> y'++ptMul :: (IsString s, Joinable s) => (Integer, s) -> (Integer, s) -> s+ptMul (_, x') (y, y') | y < 1000 = x' <> y'+ | otherwise = x' <+> y'++ptTable :: (IsString s, Joinable s) => [NumSymbol s]+ptTable = [ term 0 $ const "zero"+ , term 1 $ tenForms "um" "on" "um"+ , term 2 $ tenForms "dois" "do" "dois"+ , term 3 $ tenForms "três" "tre" "trin"+ , term 4 $ tenForms "quatro" "cator" "quar"+ , term 5 $ tenForms "cinco" "quin" "cinqü"+ , term 6 $ tenForms "seis" "seis" "sess"+ , term 7 $ tenForms "sete" "sete" "set"+ , term 8 $ tenForms "oito" "oito" "oit"+ , term 9 $ tenForms "nove" "nove" "nov"+ , mul 10 $ \ctx -> case ctx of+ LA _ _ -> "ze"+ RM 3 _ -> "ta"+ RM _ _ -> "enta"+ _ -> "dez"+ , term 16 $ const "dezesseis"+ , term 17 $ const "dezessete"+ , term 18 $ const "dezoito"+ , term 19 $ const "dezenove"+ , add 20 10 $ const "vinte"+ , mul 100 $ \ctx -> case ctx of+ RM _ _ -> "centos"+ LA _ _ -> "cento"+ _ -> "cem"+ , add 200 100 $ const "duzentos"+ , add 300 100 $ const "trezentos"+ , add 500 100 $ const "quinhentos"+ , mul 1000 $ const "mil"+ ] ++ shortScalePlural "ilhão" "ilhões"
+ Text/Numeral/Language/SP.hs view
@@ -0,0 +1,80 @@+-- -*- coding: utf-8 -*-++{-# LANGUAGE CPP, OverloadedStrings #-}++module Text.Numeral.Language.SP (sp) where++import Data.String+import Text.Numeral+import Text.Numeral.Joinable+import Text.Numeral.Misc (d)++#ifdef DO_SPECIALISE+import qualified Data.ByteString as B+import qualified Data.DString as DS++{-# SPECIALISE sp :: NumConfig String #-}+{-# SPECIALISE sp :: NumConfig B.ByteString #-}+{-# SPECIALISE sp :: NumConfig DS.DString #-}+#endif++-- Sources:+-- http://spanish.about.com/cs/forbeginners/a/cardinalnum_beg.htm+-- http://www.learn-spanish-help.com/count-in-spanish.html+-- http://www.donquijote.org/spanishlanguage/numbers/numbers1.asp++sp :: (IsString s, Joinable s) => NumConfig s+sp = NumConfig { ncNeg = error "spNeg: undefined"+ , ncOne = snd+ , ncAdd = spAdd+ , ncMul = spMul+ , ncCardinal = findSym spTable+ }++spAdd :: (IsString s, Joinable s) => (Integer, s) -> (Integer, s) -> s+spAdd (x, x') (y, y') | x == 10 && y < 6 = y' <> x'+ | x == 10 = x' <> y'+ | x < 30 = x' <> "i" <> y'+ | x < 100 = x' <+> "y" <+> y'+ | otherwise = x' <+> y'++spMul :: (IsString s, Joinable s) => (Integer, s) -> (Integer, s) -> s+spMul (_, x') (y, y') | y < 1000 = x' <> y'+ | otherwise = x' <+> y'++spTable :: (IsString s, Joinable s) => [NumSymbol s]+spTable = [ term 0 $ const "cero"+ , termG 1 $ tenFormsG (genderN "uno" "un" "una") (const "on") (const "uno")+ , term 2 $ \ctx -> case ctx of+ RA 10 _ -> "do"+ RA 20 _ -> "dós"+ _ -> "dos"+ , term 3 $ \ctx -> case ctx of+ RA n _ | n == 10 -> "tre"+ | n < 100 -> "trés"+ LM 10 _ -> "trein"+ _ -> "tres"+ , term 4 $ tenForms "cuatro" "cator" "cuaren"+ , term 5 $ tenForms "cinco" "quin" "cincuen"+ , term 6 $ \ctx -> case ctx of+ RA n _ | n <= 20 -> "séis"+ LM 10 _ -> "sesen"+ _ -> "seis"+ , term 7 $ tenForms' "siete" "siete" "seten" "sete"+ , term 8 $ tenForms "ocho" "ocho" "ochen"+ , term 9 $ tenForms' "nueve" "nueve" "noven" "novo"+ , mul 10 $ \ctx -> case ctx of+ LA n _ | n < 6 -> "ce"+ | otherwise -> "dieci"+ RM _ _ -> "ta"+ _ -> "diez"+ , add 20 10 $ const "veint"+ , mul 100 $ \ctx -> case ctx of+ RM _ _ -> "cientos"+ LA _ _ -> "ciento"+ _ -> "cien"+ , add 500 100 $ const "quinientos"+ , mul 1000 $ const "mil"+ , mul (d 6) $ mulForms "millón" "millones"+ , mul (d 12) $ mulForms "billón" "billones"+ ]
+ Text/Numeral/Language/SV.hs view
@@ -0,0 +1,74 @@+-- -*- coding: utf-8 -*-++{-# LANGUAGE CPP, OverloadedStrings #-}++module Text.Numeral.Language.SV (sv) where++import Data.String+import Text.Numeral+import Text.Numeral.Joinable+import Text.Numeral.Misc (d, withSnd)++#ifdef DO_SPECIALISE+import qualified Data.ByteString as B+import qualified Data.DString as DS++{-# SPECIALISE sv :: NumConfig String #-}+{-# SPECIALISE sv :: NumConfig B.ByteString #-}+{-# SPECIALISE sv :: NumConfig DS.DString #-}+#endif++-- Sources:+-- http://www.lysator.liu.se/language/Languages/Swedish/Grammar.html+-- http://en.wikibooks.org/wiki/Swedish/Numerals+-- http://longstrom.com/swedishtoenglish.htm#numbers++-- http://www.cs.chalmers.se/~aarne/GF/+-- http://www.cs.chalmers.se/~aarne/GF/lib/resource/norwegian/NumeralNor.gf++sv :: (IsString s, Joinable s) => NumConfig s+sv = NumConfig { ncNeg = ("minus" <+>)+ , ncOne = svOne+ , ncAdd = svAdd+ , ncMul = withSnd (<>)+ , ncCardinal = findSym svTable+ }++svOne :: (IsString s, Joinable s) => (Integer, s) -> s+svOne (v, vs) | v >= 100 = "ett" <> vs+ | otherwise = vs++svAdd :: (IsString s, Joinable s) => (Integer, s) -> (Integer, s) -> s+svAdd (x, x') (_, y') | x < 20 = y' <> x'+ | otherwise = x' <> y'++svTable :: (IsString s, Joinable s) => [NumSymbol s]+svTable = [ term 0 $ const "noll"+ , term 1 $ const "ett"+ , term 2 $ const "två"+ , term 3 $ tenForms "tre" "tret" "tret"+ , term 4 $ tenForms "fyra" "fjor" "fyr"+ , term 5 $ const "fem"+ , term 6 $ const "sex"+ , term 7 $ tenForms "sju" "sjut" "sjut"+ , term 8 $ tenForms "åtta" "ar" "åt"+ , term 9 $ tenForms "nio" "nit" "nit"+ , mul 10 $ \ctx -> case ctx of+ LA {} -> "ton"+ _ -> "tio"+ , term 11 $ const "elva"+ , term 12 $ const "tolv"+ , add 20 10 $ const "tjugo"+ , mul 100 $ const "hundra"+ , mul (d 3) $ const "tusen"+ , mul (d 6) $ mulForms "miljon" "miljoner"+ , mul (d 9) $ mulForms "miljard" "miljarder"+ , mul (d 12) $ mulForms "biljon" "biljoner"+ , mul (d 15) $ mulForms "biljard" "biljarder"+ , mul (d 18) $ mulForms "triljon" "triljoner"+ , mul (d 21) $ mulForms "triljard" "triljarder"+ , mul (d 24) $ mulForms "kvadriljon" "kvadriljoner"+ , mul (d 27) $ mulForms "kvadriljard" "kvadriljarder"+ , mul (d 30) $ mulForms "kvintriljon" "kvintriljoner"+ , mul (d 33) $ mulForms "kvintriljard" "kvintriljarder"+ ]
+ Text/Numeral/Misc.hs view
@@ -0,0 +1,20 @@+module Text.Numeral.Misc where+++withSnd :: (a -> b -> c) -> (d, a) -> (e, b) -> c+withSnd f (_, x) (_, y) = f x y++d :: Integer -> Integer+d = (10 ^)++const2 :: a -> b -> c -> a+const2 = const . const++weave :: [a] -> [a] -> [a]+weave [] ys = ys+weave (x:xs) ys = x : weave ys xs++untilNothing :: [Maybe a] -> [a]+untilNothing [] = []+untilNothing (Just x : xs) = x : untilNothing xs+untilNothing (Nothing : _) = []
+ Text/Numeral/Pelletier.hs view
@@ -0,0 +1,74 @@+{-# LANGUAGE OverloadedStrings #-}++module Text.Numeral.Pelletier+ ( longScale+ , longScalePlural+ , shortScale+ , shortScalePlural+ ) where++import Data.String+import Text.Numeral+import Text.Numeral.Joinable+import Text.Numeral.Misc (d, untilNothing, weave, withSnd)+++longScale :: (IsString s, Joinable s) => s -> s -> [NumSymbol s]+longScale a b = longScalePlural a a b b++longScalePlural :: (IsString s, Joinable s) => s -> s -> s -> s -> [NumSymbol s]+longScalePlural a as b bs = untilNothing $ weave (map illion [1..]) (map illiard [1..])+ where illion n = fmap (\s -> mul (d 6 ^ n) $ mulForms (s <> a) (s <> as)) $ bigCardinal n+ illiard n = fmap (\s -> mul (d 6 ^ n * d 3) $ mulForms (s <> b) (s <> bs)) $ bigCardinal n++shortScale :: (IsString s, Joinable s) => s -> [NumSymbol s]+shortScale a = shortScalePlural a a++shortScalePlural :: (IsString s, Joinable s) => s -> s -> [NumSymbol s]+shortScalePlural a as = untilNothing $ map illion [1..]+ where illion n = fmap (\s -> mul (d 3 * (d 3 ^ n)) $ mulForms (s <> a) (s <> as)) $ bigCardinal n++bigCardinal :: (IsString s, Joinable s) => Integer -> Maybe s+bigCardinal = cardinal bigNum Masculine+++-------------------------------------------------------------------------------+-- Big Num 'language'+-------------------------------------------------------------------------------++bigNum :: (IsString s, Joinable s) => NumConfig s+bigNum = NumConfig { ncNeg = error "bigNumNeg: undefined"+ , ncOne = snd+ , ncAdd = withSnd . flip $ (<>)+ , ncMul = withSnd (<>)+ , ncCardinal = findSym bigNumTable+ }++bigNumTable :: (IsString s, Joinable s) => [NumSymbol s]+bigNumTable = [ term 0 $ const "nulla"+ , term 1 $ forms "m" "un" "un" "mi" "mi"+ , term 2 $ forms "b" "duo" "duo" "vi" "du"+ , term 3 $ forms "tr" "tre" "tres" "tri" "tre"+ , term 4 $ forms "quadr" "quattuor" "quattuor" "quadra" "quadrin"+ , term 5 $ forms "quint" "quin" "quinqua" "quinqua" "quin"+ , term 6 $ forms "sext" "sex" "ses" "sexa" "ses"+ , term 7 $ forms "sept" "septen" "septem" "septua" "septin"+ , term 8 $ forms "oct" "octo" "octo" "octo" "octin"+ , term 9 $ forms "non" "novem" "novem" "nona" "non"+ , mul 10 $ \ctx -> case ctx of+ RM {} -> "gint"+ _ -> "dec"+ , mul 100 $ \ctx -> case ctx of+ RM n _ | n `elem` [2, 3, 6] -> "cent"+ | otherwise -> "gent"+ _ -> "cent"+ , mul 1000 $ const "mill"+ , mul 10000 $ const "myr"+ ]+ where forms d a1 a2 m1 m2 ctx = case ctx of+ RA 10 _ -> a1+ RA _ _ -> a2+ LM 100 _ -> m2+ LM _ _ -> m1+ _ -> d+
+ Text/Numeral/Positional.hs view
@@ -0,0 +1,97 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE BangPatterns #-}++module Text.Numeral.Positional+ ( toPositional+ , digitSymbol++ -- *Positional numeral systems+ , binary+ , negabinary+ , ternary+ , octal+ , decimal+ , negadecimal+ , hexadecimal+ ) where++import qualified Data.List as L+import Data.Monoid+import Data.String++-------------------------------------------------------------------------------+++toPolynomial :: Integer -> Integer -> [Integer]+toPolynomial b n | n == 0 = [0]+ | b == 0 = error "toPolynomial: base 0"+ | b == (-1) = case n of+ (-1) -> [0, 1]+ 1 -> [1]+ _ -> error "toPolynomial: base (-1)"+ | b == 1 = L.genericReplicate (abs n) (signum n)+ | otherwise = toPolynomial_b $ n+ where toPolynomial_b 0 = []+ toPolynomial_b n = let (q, r) = n `qr` b+ in r : toPolynomial_b q++ qr | b > 0 = quotRem+ | otherwise = quotRem'++ quotRem' :: Integral a => a -> a -> (a, a)+ quotRem' n d = let qr@(q, r) = n `quotRem` d+ in if r < 0+ then (q + 1, r - d)+ else qr++fromPolynomial :: Integer -> [Integer] -> Integer+fromPolynomial b = sum' . zipWith (*) (iterate (* b) 1)+ where sum' = L.foldl' (+) 0++prop_polynomial :: Integer -> Integer -> Bool+prop_polynomial b n | b == 0 && n /= 0 = True+ | b == (-1) && abs n > 1 = True+ | otherwise = n == (fromPolynomial b $ toPolynomial b n)++-------------------------------------------------------------------------------++toPositional :: (IsString s, Monoid s) => (Integer -> s) -> Integer -> Integer -> Maybe s+toPositional f b n | b == 0 = Nothing+ | n < 0 && b > 0 = fmap (mappend "-") $ repr (abs n)+ | otherwise = repr n+ where repr x = fmap mconcat . mapM f' . reverse . toPolynomial b $ x+ f' n | n >= abs b = Nothing+ | otherwise = Just $ f n++-------------------------------------------------------------------------------++-- Digit symbols up to base 62.+-- TODO: array for faster lookup+digitSymbols :: IsString s => [s]+digitSymbols = map (\x -> fromString [x]) $ ['0'..'9'] ++ ['A'..'Z'] ++ ['a'..'z']++digitSymbol :: IsString s => Integer -> s+digitSymbol = (digitSymbols `L.genericIndex`)++-------------------------------------------------------------------------------++binary :: (Monoid s, IsString s) => Integer -> Maybe s+binary = toPositional digitSymbol 2++negabinary :: (Monoid s, IsString s) => Integer -> Maybe s+negabinary = toPositional digitSymbol (-2)++ternary :: (Monoid s, IsString s) => Integer -> Maybe s+ternary = toPositional digitSymbol 3++octal :: (Monoid s, IsString s) => Integer -> Maybe s+octal = toPositional digitSymbol 8++decimal :: (Monoid s, IsString s) => Integer -> Maybe s+decimal = toPositional digitSymbol 10++negadecimal :: (Monoid s, IsString s) => Integer -> Maybe s+negadecimal = toPositional digitSymbol (-10)++hexadecimal ::(Monoid s, IsString s) => Integer -> Maybe s+hexadecimal = toPositional digitSymbol 16
+ Text/Numeral/Roman.hs view
@@ -0,0 +1,216 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}++{-| Parsing and pretty printing of Roman numerals.++ This module provides functions for parsing and pretty printing Roman+ numerals. Because the notation of Roman numerals has varied through+ the centuries this package allows for some customisation using a+ configuration that is passed to the conversion functions. Exceptions+ are dealt with by wrapping the results of conversions in the error+ monad.+-}+module Text.Numeral.Roman+ ( -- * Types+ NumeralConfig(..)+ -- * Sample configurations+ , modernRoman+ , simpleRoman+ -- * Pretty printing+ , convertTo+ , unsafeConvertTo+ , toRoman+ , unsafeToRoman+ -- * Parsing+ , convertFrom+ , fromRoman+ , unsafeConvertFrom+ , unsafeFromRoman+ ) where++import Control.Monad.Error+import qualified Data.ByteString as BS+import qualified Data.List as L+import Data.Monoid+import Data.String+import Prelude hiding (null)+import qualified Prelude as P++-------------------------------------------------------------------------------+-- Types+-------------------------------------------------------------------------------++-- |A configuration with which the 'convertTo' and 'convertFrom'+-- functions can be parameterized.+data NumeralConfig s n = NC { -- |The largest value that can be+ -- represented using this configuration.+ ncMax :: n+ -- |Symbol to represent the value 0. The+ -- Romans did not have a symbol for+ -- zero. If set to Nothing a+ -- 'convertFrom' 0 will throw an error.+ , ncZero :: Maybe s+ -- |A table of symbols and their+ -- numerical values. The table must be+ -- ordered with the largest symbols+ -- appearing first. If any symbol is+ -- the empty string then 'convertFrom'+ -- will be undefined. If any symbol in+ -- this table is associated with the+ -- value 0 both the convertTo and+ -- 'convertFrom' function will be+ -- undefined.+ , ncTable :: [(s, n)]+ }++-------------------------------------------------------------------------------+-- Default tables+-------------------------------------------------------------------------------++-- |Configuration for Roman numerals as they are commonly used+-- today. The value 0 is represented by the empty string. It can be+-- interpreted as not writing down a number. This configuration is+-- limited to the range [1..3999]. Larger numbers can be represented+-- using Roman numerals but you will need notations that are hard or+-- impossible to express using strings.+modernRoman :: (IsString s, Ord n, Num n) => NumeralConfig s n+modernRoman = NC { ncMax = 3999+ , ncZero = Just ""+ , ncTable = [ ("M", 1000)+ , ("CM", 900)+ , ("D", 500)+ , ("CD", 400)+ , ("C", 100)+ , ("XC", 90)+ , ("L", 50)+ , ("XL", 40)+ , ("X", 10)+ , ("IX", 9)+ , ("V", 5)+ , ("IV", 4)+ , ("I", 1)+ ]+ }++-- |Configuration for Roman numerals that do not use the rule that a+-- lower rank symbol can be placed before a higher rank symbol to+-- denote the difference between them. Thus a numeral like "IV" will+-- not be accepted or generated by this configuration.+simpleRoman :: (IsString s, Ord n, Num n) => NumeralConfig s n+simpleRoman = NC { ncMax = 3999+ , ncZero = Just ""+ , ncTable = [ ("M", 1000)+ , ("D", 500)+ , ("C", 100)+ , ("L", 50)+ , ("X", 10)+ , ("V", 5)+ , ("I", 1)+ ]+ }++-------------------------------------------------------------------------------+-- Pretty printing+-------------------------------------------------------------------------------++-- |Converts a number to a Roman numeral according to the given+-- configuration. Numbers which are out of bounds will cause+-- exceptions to be thrown. An exception will also be raised if no+-- representation is possible with the given configuration. If the+-- value of any symbol in the configuration is equal to 0 or a symbol+-- is the empty string this function is undefined.+convertTo :: (Monoid s, Ord n, Num n, MonadError String m)+ => NumeralConfig s n -> n -> m s+convertTo nc n | n < 0 = throwError "Roman.convertTo: can't represent negative numbers"+ | n > maxN = throwError $ "Roman.convertTo: too large (max = " ++ (show maxN) ++ ")"+ | n == 0 = maybe (throwError "Roman.convertTo: no symbol for zero")+ return+ $ ncZero nc+ | otherwise = go n $ ncTable nc+ where maxN = ncMax nc+ go 0 _ = return mempty+ go _ [] = throwError "Roman.convertTo: out of symbols"+ go n tab@(~(sym, val) : ts) | n >= val = liftM2 mappend (return sym) $ go (n - val) tab+ | otherwise = go n ts++-- |Like 'convertTo', but exceptions are promoted to errors.+unsafeConvertTo :: (Monoid s, Ord n, Num n) => NumeralConfig s n -> n -> s+unsafeConvertTo nc = either error id . convertTo nc++-- |Converts a number to a modern Roman numeral. See 'convertTo' for+-- possible exceptions.+toRoman :: (IsString s, Monoid s, Ord n, Num n, MonadError String m) => n -> m s+toRoman = convertTo modernRoman++-- |Like 'toRoman', but exceptions are promoted to errors.+unsafeToRoman :: (IsString s, Monoid s, Ord n, Num n) => n -> s+unsafeToRoman = unsafeConvertTo modernRoman++-------------------------------------------------------------------------------+-- Parsing+-------------------------------------------------------------------------------++-- |Class used to overload the input of the parsing functions.+class StripPrefix s where+ null :: s -> Bool+ stripPrefix :: s -> s -> Maybe s++instance Eq a => StripPrefix [a] where+ null = P.null+ stripPrefix = L.stripPrefix++instance StripPrefix BS.ByteString where+ null = BS.null+ stripPrefix p s = let (h, t) = BS.breakSubstring p s+ in if null h+ then Just $ BS.drop (BS.length p) t+ else Nothing++-- |Parses a string as a Roman numeral according to the given+-- configuration. An exception will be raised if the input is not a+-- valid numeral.+convertFrom :: (Monoid s, StripPrefix s, Eq s, Ord n, Num n, MonadError String m)+ => NumeralConfig s n -> s -> m n+convertFrom nc s | maybe False (== s) (ncZero nc) = return 0+ | otherwise = do n <- (go 0 (ncTable nc) s)+ s' <- convertTo nc n+ if s == s'+ then return n+ else throwError "Roman.convertFrom: invalid Roman numeral"+ where go n _ s | null s = return n+ go _ [] s = throwError $ "Roman.convertFrom: can't parse"+ go n tab@((sym, val) : ts) s = maybe (go n ts s)+ (go (n + val) tab)+ $ stripPrefix sym s++-- |Like 'convertFrom', but exceptions are promoted to errors.+unsafeConvertFrom :: (Monoid s, StripPrefix s, Eq s, Ord n, Num n)+ => NumeralConfig s n -> s -> n+unsafeConvertFrom nc = either error id . convertFrom nc++-- |Parses a string as a modern Roman numeral. See 'convertFrom' for+-- possible exceptions.+fromRoman :: (IsString s, Monoid s, StripPrefix s, Eq s, Ord n, Num n, MonadError String m)+ => s -> m n+fromRoman = convertFrom modernRoman++-- |Like 'fromRoman', but exceptions are promoted to errors.+unsafeFromRoman :: (IsString s, Monoid s, StripPrefix s, Eq s, Ord n, Num n)+ => s -> n+unsafeFromRoman = unsafeConvertFrom modernRoman++-------------------------------------------------------------------------------+-- Properties+-------------------------------------------------------------------------------++prop_printParseIsId :: NumeralConfig String Integer -> String -> Bool+prop_printParseIsId nc xs = either (const True) id+ $ do n <- convertFrom nc xs+ xs' <- convertTo nc n+ return $ xs' == xs++prop_parsePrintIsId :: NumeralConfig String Integer -> Integer -> Bool+prop_parsePrintIsId nc n = either (const True) id+ $ do xs <- convertTo nc n+ n' <- convertFrom nc xs+ return $ n' == n
+ numerals.cabal view
@@ -0,0 +1,60 @@+name: numerals+version: 0.1+cabal-version: >= 1.6+build-type: Simple+stability: experimental+author: Roel van Dijk <vandijk.roel@gmail.com>, Bas van Dijk <v.dijk.bas@gmail.com>+maintainer: Roel van Dijk <vandijk.roel@gmail.com>, Bas van Dijk <v.dijk.bas@gmail.com>+copyright: (c) 2009 Roel van Dijk, Bas van Dijk+license: BSD3+license-file: LICENSE+category: Natural Language Processing, Numerical, Text+synopsis: Utilities for working with numerals+description:++extra-source-files: ./TODO+ , ./README+ , ./LICENSE+ , ./Text/Numeral/Debug.hs++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++library+ if flag(specialise)+ CPP-Options: -DDO_SPECIALISE++ GHC-Options: -O2++ 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+ , 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