From 78db98366f44d4e0a0cb23329e239fa155e9d2a9 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Fri, 12 Nov 2010 23:54:21 +0000 Subject: [PATCH] parsing: support D default commodity directive --- MANUAL.markdown | 14 +++++++ hledger-lib/Hledger/Data/Types.hs | 4 +- hledger-lib/Hledger/Read/Common.hs | 16 +++++--- hledger-lib/Hledger/Read/Journal.hs | 63 ++++++++++++++++------------- hledger/Hledger/Cli/Commands/Add.hs | 5 ++- tests/default-commodity.test | 38 +++++++++++++++++ 6 files changed, 102 insertions(+), 38 deletions(-) create mode 100644 tests/default-commodity.test diff --git a/MANUAL.markdown b/MANUAL.markdown index dd5d2575e..1669545fb 100644 --- a/MANUAL.markdown +++ b/MANUAL.markdown @@ -797,6 +797,20 @@ You can pull in the content of additional journal files, by writing lines like t The `!include` directive may only be used in journal files, and currently it may only include other journal files (eg, not timelog files.) +##### Default commodity + +You can set a default commodity with a `D` directive in the journal. This +will be used for any subsequent amounts with no commodity symbol, +including the commodity display settings (left or right symbol, spacing, +thousands separator, and precision.) + + ; default commodity: british pound, comma thousands separator, two decimal places + D £1,000.00 + + 2010/1/1 + a 2340.11 ; <- no commodity symbol, so will use the above + b + #### Default parent account You can specify a default parent account within a section of the journal with diff --git a/hledger-lib/Hledger/Data/Types.hs b/hledger-lib/Hledger/Data/Types.hs index e36fdc489..c5134834d 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/hledger-lib/Hledger/Data/Types.hs @@ -49,7 +49,7 @@ data Interval = NoInterval | Daily | Weekly | Monthly | Quarterly | Yearly type AccountName = String -data Side = L | R deriving (Eq,Show,Ord) +data Side = L | R deriving (Eq,Show,Read,Ord) data Commodity = Commodity { symbol :: String, -- ^ the commodity's symbol @@ -58,7 +58,7 @@ data Commodity = Commodity { 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 - } deriving (Eq,Show,Ord) + } deriving (Eq,Show,Read,Ord) data Amount = Amount { commodity :: Commodity, diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index dfbac025c..460c795d4 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -10,7 +10,7 @@ where import Control.Monad.Error import Hledger.Data.Utils -import Hledger.Data.Types (Journal) +import Hledger.Data.Types (Journal, Commodity) import Hledger.Data.Journal import System.Directory (getHomeDirectory) import System.FilePath(takeDirectory,combine) @@ -43,13 +43,13 @@ parseJournalWith p f s = do -- | Some state kept while parsing a journal file. data JournalContext = Ctx { - ctxYear :: !(Maybe Integer) -- ^ the default year most recently specified with Y - , ctxCommod :: !(Maybe String) -- ^ I don't know - , ctxAccount :: ![String] -- ^ the current stack of parent accounts specified by !account + ctxYear :: !(Maybe Integer) -- ^ the default year most recently specified with Y + , ctxCommodity :: !(Maybe Commodity) -- ^ the default commodity recently specified with D + , ctxAccount :: ![String] -- ^ the current stack of parent accounts specified by !account } deriving (Read, Show) emptyCtx :: JournalContext -emptyCtx = Ctx { ctxYear = Nothing, ctxCommod = Nothing, ctxAccount = [] } +emptyCtx = Ctx { ctxYear = Nothing, ctxCommodity = Nothing, ctxAccount = [] } setYear :: Integer -> GenParser tok JournalContext () setYear y = updateState (\ctx -> ctx{ctxYear=Just y}) @@ -57,6 +57,12 @@ setYear y = updateState (\ctx -> ctx{ctxYear=Just y}) getYear :: GenParser tok JournalContext (Maybe Integer) getYear = liftM ctxYear getState +setCommodity :: Commodity -> GenParser tok JournalContext () +setCommodity c = updateState (\ctx -> ctx{ctxCommodity=Just c}) + +getCommodity :: GenParser tok JournalContext (Maybe Commodity) +getCommodity = liftM ctxCommodity getState + pushParentAccount :: String -> GenParser tok JournalContext () pushParentAccount parent = updateState addParentAccount where addParentAccount ctx0 = ctx0 { ctxAccount = normalize parent : ctxAccount ctx0 } diff --git a/hledger-lib/Hledger/Read/Journal.hs b/hledger-lib/Hledger/Read/Journal.hs index 5f742f5e7..c66295132 100644 --- a/hledger-lib/Hledger/Read/Journal.hs +++ b/hledger-lib/Hledger/Read/Journal.hs @@ -169,6 +169,7 @@ journalFile = do journalupdates <- many journalItem , liftM (return . addPeriodicTransaction) ledgerPeriodicTransaction , liftM (return . addHistoricalPrice) ledgerHistoricalPrice , ledgerDefaultYear + , ledgerDefaultCommodity , ledgerIgnoredPriceCommodity , ledgerTagDirective , ledgerEndTagDirective @@ -178,20 +179,20 @@ journalFile = do journalupdates <- many journalItem journalAddFilePath :: FilePath -> Journal -> Journal journalAddFilePath f j@Journal{allfilepaths=fs} = j{allfilepaths=fs++[f]} -emptyLine :: GenParser Char st () +emptyLine :: GenParser Char JournalContext () emptyLine = do many spacenonewline optional $ (char ';' "comment") >> many (noneOf "\n") newline return () -ledgercomment :: GenParser Char st String +ledgercomment :: GenParser Char JournalContext String ledgercomment = do many1 $ char ';' many spacenonewline many (noneOf "\n") "comment" -ledgercommentline :: GenParser Char st String +ledgercommentline :: GenParser Char JournalContext String ledgercommentline = do many spacenonewline s <- ledgercomment @@ -272,14 +273,6 @@ ledgerIgnoredPriceCommodity = do restofline return $ return id -ledgerDefaultCommodity :: GenParser Char JournalContext JournalUpdate -ledgerDefaultCommodity = do - char 'D' "default commodity" - many1 spacenonewline - someamount - restofline - return $ return id - ledgerCommodityConversion :: GenParser Char JournalContext JournalUpdate ledgerCommodityConversion = do char 'C' "commodity conversion" @@ -317,6 +310,17 @@ ledgerDefaultYear = do setYear y' return $ return id +ledgerDefaultCommodity :: GenParser Char JournalContext JournalUpdate +ledgerDefaultCommodity = do + char 'D' "default commodity" + many1 spacenonewline + a <- someamount + -- someamount always returns a MixedAmount containing one Amount, but let's be safe + let as = amounts a + when (not $ null as) $ setCommodity $ commodity $ head as + restofline + return $ return id + -- | Try to parse a ledger entry. If we successfully parse an entry, -- check it can be balanced, and fail if not. ledgerTransaction :: GenParser Char JournalContext Transaction @@ -384,10 +388,10 @@ ledgereffectivedate actualdate = do edate <- withDefaultYear actualdate ledgerdate return edate -ledgerstatus :: GenParser Char st Bool +ledgerstatus :: GenParser Char JournalContext Bool ledgerstatus = try (do { many1 spacenonewline; char '*' "status"; return True } ) <|> return False -ledgercode :: GenParser Char st String +ledgercode :: GenParser Char JournalContext String ledgercode = try (do { many1 spacenonewline; char '(' "code"; code <- anyChar `manyTill` char ')'; return code } ) <|> return "" ledgerpostings :: GenParser Char JournalContext [Posting] @@ -404,7 +408,7 @@ ledgerpostings = do return $ map (fromparse . parseWithCtx ctx (setPosition pos >> ledgerposting)) ls' "postings" -linebeginningwithspaces :: GenParser Char st String +linebeginningwithspaces :: GenParser Char JournalContext String linebeginningwithspaces = do sp <- many1 spacenonewline c <- nonspace @@ -448,17 +452,17 @@ ledgeraccountname = do -- | Parse an amount, with an optional left or right currency symbol and -- optional price. -postingamount :: GenParser Char st MixedAmount +postingamount :: GenParser Char JournalContext MixedAmount postingamount = try (do many1 spacenonewline someamount <|> return missingamt ) <|> return missingamt -someamount :: GenParser Char st MixedAmount +someamount :: GenParser Char JournalContext MixedAmount someamount = try leftsymbolamount <|> try rightsymbolamount <|> nosymbolamount -leftsymbolamount :: GenParser Char st MixedAmount +leftsymbolamount :: GenParser Char JournalContext MixedAmount leftsymbolamount = do sign <- optionMaybe $ string "-" let applysign = if isJust sign then negate else id @@ -470,7 +474,7 @@ leftsymbolamount = do return $ applysign $ Mixed [Amount c q pri] "left-symbol amount" -rightsymbolamount :: GenParser Char st MixedAmount +rightsymbolamount :: GenParser Char JournalContext MixedAmount rightsymbolamount = do (q,p,comma) <- amountquantity sp <- many spacenonewline @@ -480,28 +484,29 @@ rightsymbolamount = do return $ Mixed [Amount c q pri] "right-symbol amount" -nosymbolamount :: GenParser Char st MixedAmount +nosymbolamount :: GenParser Char JournalContext MixedAmount nosymbolamount = do (q,p,comma) <- amountquantity pri <- priceamount - let c = Commodity {symbol="",side=L,spaced=False,comma=comma,precision=p} + defc <- getCommodity + let c = fromMaybe Commodity{symbol="",side=L,spaced=False,comma=comma,precision=p} defc return $ Mixed [Amount c q pri] "no-symbol amount" -commoditysymbol :: GenParser Char st String +commoditysymbol :: GenParser Char JournalContext String commoditysymbol = (quotedcommoditysymbol <|> simplecommoditysymbol) "commodity symbol" -quotedcommoditysymbol :: GenParser Char st String +quotedcommoditysymbol :: GenParser Char JournalContext String quotedcommoditysymbol = do char '"' s <- many1 $ noneOf ";\n\"" char '"' return s -simplecommoditysymbol :: GenParser Char st String +simplecommoditysymbol :: GenParser Char JournalContext String simplecommoditysymbol = many1 (noneOf nonsimplecommoditychars) -priceamount :: GenParser Char st (Maybe MixedAmount) +priceamount :: GenParser Char JournalContext (Maybe MixedAmount) priceamount = try (do many spacenonewline @@ -516,7 +521,7 @@ priceamount = -- | Parse a ledger-style numeric quantity and also return the number of -- digits to the right of the decimal point and whether thousands are -- separated by comma. -amountquantity :: GenParser Char st (Double, Int, Bool) +amountquantity :: GenParser Char JournalContext (Double, Int, Bool) amountquantity = do sign <- optionMaybe $ string "-" (intwithcommas,frac) <- numberparts @@ -534,10 +539,10 @@ amountquantity = do -- | parse the two strings of digits before and after a possible decimal -- point. The integer part may contain commas, or either part may be -- empty, or there may be no point. -numberparts :: GenParser Char st (String,String) +numberparts :: GenParser Char JournalContext (String,String) numberparts = numberpartsstartingwithdigit <|> numberpartsstartingwithpoint -numberpartsstartingwithdigit :: GenParser Char st (String,String) +numberpartsstartingwithdigit :: GenParser Char JournalContext (String,String) numberpartsstartingwithdigit = do let digitorcomma = digit <|> char ',' first <- digit @@ -545,7 +550,7 @@ numberpartsstartingwithdigit = do frac <- try (do {char '.'; many digit}) <|> return "" return (first:rest,frac) -numberpartsstartingwithpoint :: GenParser Char st (String,String) +numberpartsstartingwithpoint :: GenParser Char JournalContext (String,String) numberpartsstartingwithpoint = do char '.' frac <- many1 digit @@ -618,7 +623,7 @@ tests_Journal = TestList [ let -- | compare a parse result with a MixedAmount, showing the debug representation for clarity assertMixedAmountParse parseresult mixedamount = (either (const "parse error") showMixedAmountDebug parseresult) ~?= (showMixedAmountDebug mixedamount) - assertMixedAmountParse (parsewith someamount "1 @ $2") + assertMixedAmountParse (parseWithCtx emptyCtx someamount "1 @ $2") (Mixed [Amount unknown 1 (Just $ Mixed [Amount dollar{precision=0} 2 Nothing])]) ,"postingamount" ~: do diff --git a/hledger/Hledger/Cli/Commands/Add.hs b/hledger/Hledger/Cli/Commands/Add.hs index 1d3f16705..2a65a70b0 100644 --- a/hledger/Hledger/Cli/Commands/Add.hs +++ b/hledger/Hledger/Cli/Commands/Add.hs @@ -9,6 +9,7 @@ module Hledger.Cli.Commands.Add where import Hledger.Data import Hledger.Read.Journal (someamount) +import Hledger.Read.Common (emptyCtx) import Hledger.Cli.Options import Hledger.Cli.Commands.Register (registerReport, registerReportAsText) #if __GLASGOW_HASKELL__ <= 610 @@ -92,7 +93,7 @@ getPostings accept historicalps enteredps = do then return enteredps else do amountstr <- askFor (printf "amount %d" n) defaultamount validateamount - let amount = fromparse $ parse (someamount <|> return missingamt) "" amountstr + let amount = fromparse $ runParser (someamount <|> return missingamt) emptyCtx "" amountstr let p = nullposting{paccount=stripbrackets account, pamount=amount, ptype=postingtype account} @@ -113,7 +114,7 @@ getPostings accept historicalps enteredps = do postingtype _ = RegularPosting stripbrackets = dropWhile (`elem` "([") . reverse . dropWhile (`elem` "])") . reverse validateamount = Just $ \s -> (null s && not (null enteredrealps)) - || isRight (parse (someamount>>many spacenonewline>>eof) "" s) + || isRight (runParser (someamount>>many spacenonewline>>eof) emptyCtx "" s) -- | Prompt for and read a string value, optionally with a default value -- and a validator. A validator causes the prompt to repeat until the diff --git a/tests/default-commodity.test b/tests/default-commodity.test new file mode 100644 index 000000000..958d1a661 --- /dev/null +++ b/tests/default-commodity.test @@ -0,0 +1,38 @@ +# a default commodity defined with the D directive will be used for any +# commodity-less amounts in subsequent transactions. +# +bin/hledger -f- print +<<< + +; no default commodity +2010/1/1 x + a 1000 + b + +; pound, two decimal places, no thousands separator +D £1000.00 + +2010/1/1 y + a 1000 + b + +; dollar, no decimal places, comma thousands separator +D $1,000 + +2010/1/1 z + a 1000 + b + +>>> +2010/01/01 x + a 1000 + b -1000 + +2010/01/01 y + a £1000.00 + b £-1000.00 + +2010/01/01 z + a $1,000 + b $-1,000 +