always give a proper parse error for numbers, remember precisions and thousands separators

(per amount for now)
This commit is contained in:
Simon Michael 2008-10-14 23:14:31 +00:00
parent 4efdda25b4
commit 042a8179e8
5 changed files with 67 additions and 34 deletions

View File

@ -110,4 +110,4 @@ toCommodity newc (Amount oldc q) =
nullamt = Amount (comm "") 0 nullamt = Amount (comm "") 0
-- temporary value for partial entries -- temporary value for partial entries
autoamt = Amount (Commodity {symbol="AUTO",rate=1,side=L,spaced=False,precision=0}) 0 autoamt = Amount (Commodity {symbol="AUTO",side=L,spaced=False,comma=False,precision=0,rate=1}) 0

View File

@ -14,21 +14,21 @@ import Ledger.Types
commoditytests = TestList [ commoditytests = TestList [
] ]
-- for nullamt, autoamt, etc.
unknown = Commodity {symbol="",side=L,spaced=False,comma=False,precision=0,rate=1}
unknown = Commodity {symbol="",rate=1,side=L,spaced=False,precision=0} dollar = Commodity {symbol="$",side=L,spaced=False,comma=False,precision=2,rate=1}
dollar = Commodity {symbol="$",rate=1,side=L,spaced=False,precision=2} euro = Commodity {symbol="EUR",side=L,spaced=False,comma=False,precision=2,rate=0.760383}
euro = Commodity {symbol="EUR",rate=0.760383,side=L,spaced=False,precision=2} pound = Commodity {symbol="£",side=L,spaced=False,comma=False,precision=2,rate=0.512527}
pound = Commodity {symbol="£",rate=0.512527,side=L,spaced=False,precision=2} hour = Commodity {symbol="h",side=R,spaced=False,comma=False,precision=1,rate=100}
hour = Commodity {symbol="h",rate=100,side=R,spaced=False,precision=1}
-- | convenient amount constructors -- | convenient amount constructors
unknowns = Amount unknown
dollars = Amount dollar dollars = Amount dollar
euros = Amount euro euros = Amount euro
pounds = Amount pound pounds = Amount pound
hours = Amount hour hours = Amount hour
defaultcommodities = [unknown, dollar, euro, pound, hour] defaultcommodities = [dollar, euro, pound, hour, unknown]
defaultcommoditiesmap :: Map.Map String Commodity defaultcommoditiesmap :: Map.Map String Commodity
defaultcommoditiesmap = Map.fromList [(symbol c :: String, c :: Commodity) | c <- defaultcommodities] defaultcommoditiesmap = Map.fromList [(symbol c :: String, c :: Commodity) | c <- defaultcommodities]

View File

@ -7,7 +7,9 @@ Parsers for standard ledger and timelog files.
module Ledger.Parse module Ledger.Parse
where where
import Text.ParserCombinators.Parsec import Text.ParserCombinators.Parsec
import Text.ParserCombinators.Parsec.Char
import Text.ParserCombinators.Parsec.Language import Text.ParserCombinators.Parsec.Language
import Text.ParserCombinators.Parsec.Combinator
import qualified Text.ParserCombinators.Parsec.Token as P import qualified Text.ParserCombinators.Parsec.Token as P
import System.IO import System.IO
import qualified Data.Map as Map import qualified Data.Map as Map
@ -286,43 +288,70 @@ leftsymbolamount :: Parser Amount
leftsymbolamount = do leftsymbolamount = do
sym <- commoditysymbol sym <- commoditysymbol
sp <- many spacenonewline sp <- many spacenonewline
q <- commodityquantity (q,p,comma) <- amountquantity
let newcommodity = Commodity {symbol=sym,rate=1,side=L,spaced=not $ null sp,precision=1} let c = Commodity {symbol=sym,side=L,spaced=not $ null sp,comma=comma,precision=p,rate=1}
let c = Map.findWithDefault newcommodity sym defaultcommoditiesmap
return $ Amount c q return $ Amount c q
<?> "left-symbol amount" <?> "left-symbol amount"
rightsymbolamount :: Parser Amount rightsymbolamount :: Parser Amount
rightsymbolamount = do rightsymbolamount = do
q <- commodityquantity (q,p,comma) <- amountquantity
sp <- many spacenonewline sp <- many spacenonewline
sym <- commoditysymbol sym <- commoditysymbol
let newcommodity = Commodity {symbol=sym,rate=1,side=R,spaced=not $ null sp,precision=1} let c = Commodity {symbol=sym,side=R,spaced=not $ null sp,comma=comma,precision=p,rate=1}
let c = Map.findWithDefault newcommodity sym defaultcommoditiesmap
return $ Amount c q return $ Amount c q
<?> "right-symbol amount" <?> "right-symbol amount"
nosymbolamount :: Parser Amount nosymbolamount :: Parser Amount
nosymbolamount = do nosymbolamount = do
q <- commodityquantity (q,p,comma) <- amountquantity
return $ unknowns q let c = Commodity {symbol="",side=L,spaced=False,comma=comma,precision=p,rate=1}
return $ Amount c q
<?> "no-symbol amount" <?> "no-symbol amount"
commoditysymbol :: Parser String commoditysymbol :: Parser String
commoditysymbol = many1 (noneOf "-.0123456789;\n ") <?> "commodity symbol" commoditysymbol = many1 (noneOf "-.0123456789;\n ") <?> "commodity symbol"
commodityquantity :: Parser Double -- gawd.. trying to parse a ledger number without error:
commodityquantity = do
q <- many1 (oneOf "-.,0123456789") -- | parse a numeric quantity and also return the number of digits to the
let q' = stripcommas $ striptrailingpoint q -- right of the decimal point and whether thousands are separated by comma
let (int,frac) = break (=='.') q' amountquantity :: Parser (Double, Int, Bool)
return $ read q' amountquantity = do
sign <- optionMaybe $ string "-"
(intwithcommas,frac) <- numberparts
let comma = ',' `elem` intwithcommas
let precision = length frac
-- read the actual value. We expect this read to never fail.
let int = filter (/= ',') intwithcommas
let int' = if null int then "0" else int
let frac' = if null frac then "0" else frac
let sign' = fromMaybe "" sign
let quantity = read $ sign'++int'++"."++frac'
return (quantity, precision, comma)
<?> "commodity quantity" <?> "commodity quantity"
where
stripcommas = filter (',' /=) -- | parse the two strings of digits before and after a decimal point, if
striptrailingpoint = reverse . dropWhile (=='.') . reverse -- any. The integer part may contain commas, or either part may be empty,
-- precision = length $ dropWhile (=='.') frac -- XXX -- or there may be no point.
numberparts :: Parser (String,String)
numberparts = numberpartsstartingwithdigit <|> numberpartsstartingwithpoint
numberpartsstartingwithdigit :: Parser (String,String)
numberpartsstartingwithdigit = do
let digitorcomma = digit <|> char ','
first <- digit
rest <- many digitorcomma
frac <- try (do {char '.'; many digit >>= return}) <|> return ""
return (first:rest,frac)
numberpartsstartingwithpoint :: Parser (String,String)
numberpartsstartingwithpoint = do
char '.'
frac <- many1 digit
return ("",frac)
spacenonewline :: Parser Char spacenonewline :: Parser Char
spacenonewline = satisfy (\c -> c `elem` " \v\f\t") spacenonewline = satisfy (\c -> c `elem` " \v\f\t")

View File

@ -18,11 +18,15 @@ type DateTime = String
data Side = L | R deriving (Eq,Show) data Side = L | R deriving (Eq,Show)
data Commodity = Commodity { data Commodity = Commodity {
symbol :: String, -- ^ the commodity's symbol symbol :: String, -- ^ the commodity's symbol
side :: Side, -- ^ should the symbol appear on the left or the right
spaced :: Bool, -- ^ should there be a space between symbol and quantity -- display preferences for amounts of this commodity
precision :: Int, -- ^ number of decimal places to display side :: Side, -- ^ should the symbol appear on the left or the right
rate :: Double -- ^ the current (hard-coded) conversion rate against the dollar spaced :: Bool, -- ^ should there be a space between symbol and quantity
comma :: Bool, -- ^ should thousands be comma-separated
precision :: Int, -- ^ number of decimal places to display
rate :: Double -- ^ the current (hard-coded) conversion rate against the dollar
} deriving (Eq,Show) } deriving (Eq,Show)
data Amount = Amount { data Amount = Amount {

View File

@ -88,7 +88,7 @@ tests =
,"transactionamount" ~: do ,"transactionamount" ~: do
assertparseequal (dollars 47.18) (parsewith transactionamount " $47.18") assertparseequal (dollars 47.18) (parsewith transactionamount " $47.18")
assertparseequal (Amount (Commodity {symbol="$",rate=1,side=L,spaced=False,precision=0}) 1) (parsewith transactionamount " $1.") assertparseequal (Amount (Commodity {symbol="$",side=L,spaced=False,comma=False,precision=0,rate=1}) 1) (parsewith transactionamount " $1.")
] ]
balancecommandtests = balancecommandtests =