always give a proper parse error for numbers, remember precisions and thousands separators
(per amount for now)
This commit is contained in:
		
							parent
							
								
									4efdda25b4
								
							
						
					
					
						commit
						042a8179e8
					
				| @ -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 | ||||||
|  | |||||||
| @ -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] | ||||||
|  | |||||||
| @ -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") | ||||||
| 
 | 
 | ||||||
|  | |||||||
| @ -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 { | ||||||
|  | |||||||
							
								
								
									
										2
									
								
								Tests.hs
									
									
									
									
									
								
							
							
						
						
									
										2
									
								
								Tests.hs
									
									
									
									
									
								
							| @ -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 = | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user