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