diff --git a/Ledger/Amount.hs b/Ledger/Amount.hs index c625d12f0..7ecd20713 100644 --- a/Ledger/Amount.hs +++ b/Ledger/Amount.hs @@ -110,4 +110,4 @@ toCommodity newc (Amount oldc q) = nullamt = Amount (comm "") 0 -- 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 diff --git a/Ledger/Commodity.hs b/Ledger/Commodity.hs index 4c38fac9f..7a1f44e18 100644 --- a/Ledger/Commodity.hs +++ b/Ledger/Commodity.hs @@ -14,21 +14,21 @@ import Ledger.Types 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="$",rate=1,side=L,spaced=False,precision=2} -euro = Commodity {symbol="EUR",rate=0.760383,side=L,spaced=False,precision=2} -pound = Commodity {symbol="£",rate=0.512527,side=L,spaced=False,precision=2} -hour = Commodity {symbol="h",rate=100,side=R,spaced=False,precision=1} +dollar = Commodity {symbol="$",side=L,spaced=False,comma=False,precision=2,rate=1} +euro = Commodity {symbol="EUR",side=L,spaced=False,comma=False,precision=2,rate=0.760383} +pound = Commodity {symbol="£",side=L,spaced=False,comma=False,precision=2,rate=0.512527} +hour = Commodity {symbol="h",side=R,spaced=False,comma=False,precision=1,rate=100} -- | convenient amount constructors -unknowns = Amount unknown dollars = Amount dollar euros = Amount euro pounds = Amount pound hours = Amount hour -defaultcommodities = [unknown, dollar, euro, pound, hour] +defaultcommodities = [dollar, euro, pound, hour, unknown] defaultcommoditiesmap :: Map.Map String Commodity defaultcommoditiesmap = Map.fromList [(symbol c :: String, c :: Commodity) | c <- defaultcommodities] diff --git a/Ledger/Parse.hs b/Ledger/Parse.hs index d4becfd1d..54b0acdeb 100644 --- a/Ledger/Parse.hs +++ b/Ledger/Parse.hs @@ -7,7 +7,9 @@ Parsers for standard ledger and timelog files. module Ledger.Parse where import Text.ParserCombinators.Parsec +import Text.ParserCombinators.Parsec.Char import Text.ParserCombinators.Parsec.Language +import Text.ParserCombinators.Parsec.Combinator import qualified Text.ParserCombinators.Parsec.Token as P import System.IO import qualified Data.Map as Map @@ -286,43 +288,70 @@ leftsymbolamount :: Parser Amount leftsymbolamount = do sym <- commoditysymbol sp <- many spacenonewline - q <- commodityquantity - let newcommodity = Commodity {symbol=sym,rate=1,side=L,spaced=not $ null sp,precision=1} - let c = Map.findWithDefault newcommodity sym defaultcommoditiesmap + (q,p,comma) <- amountquantity + let c = Commodity {symbol=sym,side=L,spaced=not $ null sp,comma=comma,precision=p,rate=1} return $ Amount c q "left-symbol amount" rightsymbolamount :: Parser Amount rightsymbolamount = do - q <- commodityquantity + (q,p,comma) <- amountquantity sp <- many spacenonewline sym <- commoditysymbol - let newcommodity = Commodity {symbol=sym,rate=1,side=R,spaced=not $ null sp,precision=1} - let c = Map.findWithDefault newcommodity sym defaultcommoditiesmap + let c = Commodity {symbol=sym,side=R,spaced=not $ null sp,comma=comma,precision=p,rate=1} return $ Amount c q "right-symbol amount" nosymbolamount :: Parser Amount nosymbolamount = do - q <- commodityquantity - return $ unknowns q + (q,p,comma) <- amountquantity + let c = Commodity {symbol="",side=L,spaced=False,comma=comma,precision=p,rate=1} + return $ Amount c q "no-symbol amount" commoditysymbol :: Parser String commoditysymbol = many1 (noneOf "-.0123456789;\n ") "commodity symbol" - -commodityquantity :: Parser Double -commodityquantity = do - q <- many1 (oneOf "-.,0123456789") - let q' = stripcommas $ striptrailingpoint q - let (int,frac) = break (=='.') q' - return $ read q' + +-- gawd.. trying to parse a ledger number without error: + +-- | parse a numeric quantity and also return the number of digits to the +-- right of the decimal point and whether thousands are separated by comma +amountquantity :: Parser (Double, Int, Bool) +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" - where - stripcommas = filter (',' /=) - striptrailingpoint = reverse . dropWhile (=='.') . reverse - -- precision = length $ dropWhile (=='.') frac -- XXX - + +-- | parse the two strings of digits before and after a decimal point, if +-- any. The integer part may contain commas, or either part may be empty, +-- 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 = satisfy (\c -> c `elem` " \v\f\t") diff --git a/Ledger/Types.hs b/Ledger/Types.hs index 019110a99..47e8da38e 100644 --- a/Ledger/Types.hs +++ b/Ledger/Types.hs @@ -18,11 +18,15 @@ type DateTime = String data Side = L | R deriving (Eq,Show) data Commodity = Commodity { - 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 - precision :: Int, -- ^ number of decimal places to display - rate :: Double -- ^ the current (hard-coded) conversion rate against the dollar + symbol :: String, -- ^ the commodity's symbol + + -- display preferences for amounts of this commodity + side :: Side, -- ^ should the symbol appear on the left or the right + 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) data Amount = Amount { diff --git a/Tests.hs b/Tests.hs index 744e9782a..bcd1c817e 100644 --- a/Tests.hs +++ b/Tests.hs @@ -88,7 +88,7 @@ tests = ,"transactionamount" ~: do 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 =