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

(per amount for now)

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

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]

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,42 +288,69 @@ 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")

Ledger/Types.hs

@@ -19,9 +19,13 @@ data Side = L | R deriving (Eq,Show)
 
 data Commodity = Commodity {
       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)
 

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 =