slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

parsing: support D default commodity directive

Browse Source
This commit is contained in:
Simon Michael 2010-11-12 23:54:21 +00:00
parent 8429df0f32
commit 78db98366f
6 changed files with 102 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
MANUAL.markdown
View File

@ -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

4
hledger-lib/Hledger/Data/Types.hs
View File

@ -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,

16
hledger-lib/Hledger/Read/Common.hs
View File

@ -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 }

63
hledger-lib/Hledger/Read/Journal.hs
View File

@ -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

5
hledger/Hledger/Cli/Commands/Add.hs
View File

@ -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

38
tests/default-commodity.test Normal file
View File

@ -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