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

journal: parse account directives

Browse Source 
We now parse account directives, like Ledger's. We don't do anything
with them yet. The default parent account feature must now be spelled
"apply account"/"end apply account".
This commit is contained in:
Simon Michael 2016-04-04 10:18:59 -07:00
parent 25cd65442a
commit 31a754544a
7 changed files with 149 additions and 144 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
hledger-lib/Hledger/Data/Journal.hs
View File

@ -137,7 +137,7 @@ nulljournal = Journal { jmodifiertxns = []
} }
nullctx :: JournalContext nullctx :: JournalContext
nullctx = Ctx{ctxYear=Nothing, ctxDefaultCommodityAndStyle=Nothing, ctxAccount=[], ctxAliases=[], ctxTransactionIndex=0} nullctx = Ctx{ctxYear=Nothing, ctxDefaultCommodityAndStyle=Nothing, ctxAccounts=[], ctxParentAccount=[], ctxAliases=[], ctxTransactionIndex=0}
journalFilePath :: Journal -> FilePath journalFilePath :: Journal -> FilePath
journalFilePath = fst . mainfile journalFilePath = fst . mainfile

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

@ -230,11 +230,12 @@ type Year = Integer
data JournalContext = Ctx { data JournalContext = Ctx {
ctxYear :: !(Maybe Year) -- ^ the default year most recently specified with Y ctxYear :: !(Maybe Year) -- ^ the default year most recently specified with Y
, ctxDefaultCommodityAndStyle :: !(Maybe (Commodity,AmountStyle)) -- ^ the default commodity and amount style most recently specified with D , ctxDefaultCommodityAndStyle :: !(Maybe (Commodity,AmountStyle)) -- ^ the default commodity and amount style most recently specified with D
, ctxAccount :: ![AccountName] -- ^ the current stack of parent accounts/account name components , ctxAccounts :: ![AccountName] -- ^ the accounts that have been defined with account directives so far
-- specified with "account" directive(s). Concatenated, these , ctxParentAccount :: ![AccountName] -- ^ the current stack of parent accounts/account name components
-- are the account prefix prepended to parsed account names. -- specified with "apply account" directive(s). Concatenated, these
, ctxAliases :: ![AccountAlias] -- ^ the current list of account name aliases in effect -- are the account prefix prepended to parsed account names.
, ctxTransactionIndex :: !Integer -- ^ the number of transactions read so far , ctxAliases :: ![AccountAlias] -- ^ the current list of account name aliases in effect
, ctxTransactionIndex :: !Integer -- ^ the number of transactions read so far
} deriving (Read, Show, Eq, Data, Typeable, Generic) } deriving (Read, Show, Eq, Data, Typeable, Generic)
instance NFData JournalContext instance NFData JournalContext

38
hledger-lib/Hledger/Read/JournalReader.hs
View File

@ -190,18 +190,22 @@ setDefaultCommodityAndStyle cs = modifyState (\ctx -> ctx{ctxDefaultCommodityAnd
getDefaultCommodityAndStyle :: Stream [Char] m Char => ParsecT [Char] JournalContext m (Maybe (Commodity,AmountStyle)) getDefaultCommodityAndStyle :: Stream [Char] m Char => ParsecT [Char] JournalContext m (Maybe (Commodity,AmountStyle))
getDefaultCommodityAndStyle = ctxDefaultCommodityAndStyle `fmap` getState getDefaultCommodityAndStyle = ctxDefaultCommodityAndStyle `fmap` getState
pushAccount :: Stream [Char] m Char => String -> ParsecT [Char] JournalContext m ()
pushAccount acct = modifyState addAccount
where addAccount ctx0 = ctx0 { ctxAccounts = acct : ctxAccounts ctx0 }
pushParentAccount :: Stream [Char] m Char => String -> ParsecT [Char] JournalContext m () pushParentAccount :: Stream [Char] m Char => String -> ParsecT [Char] JournalContext m ()
pushParentAccount parent = modifyState addParentAccount pushParentAccount parent = modifyState addParentAccount
where addParentAccount ctx0 = ctx0 { ctxAccount = parent : ctxAccount ctx0 } where addParentAccount ctx0 = ctx0 { ctxParentAccount = parent : ctxParentAccount ctx0 }
popParentAccount :: Stream [Char] m Char => ParsecT [Char] JournalContext m () popParentAccount :: Stream [Char] m Char => ParsecT [Char] JournalContext m ()
popParentAccount = do ctx0 <- getState popParentAccount = do ctx0 <- getState
case ctxAccount ctx0 of case ctxParentAccount ctx0 of
[] -> unexpected "End of account block with no beginning" [] -> unexpected "End of apply account block with no beginning"
(_:rest) -> setState $ ctx0 { ctxAccount = rest } (_:rest) -> setState $ ctx0 { ctxParentAccount = rest }
getParentAccount :: Stream [Char] m Char => ParsecT [Char] JournalContext m String getParentAccount :: Stream [Char] m Char => ParsecT [Char] JournalContext m String
getParentAccount = liftM (concatAccountNames . reverse . ctxAccount) getState getParentAccount = liftM (concatAccountNames . reverse . ctxParentAccount) getState
addAccountAlias :: Stream [Char] m Char => AccountAlias -> ParsecT [Char] JournalContext m () addAccountAlias :: Stream [Char] m Char => AccountAlias -> ParsecT [Char] JournalContext m ()
addAccountAlias a = modifyState (\(ctx@Ctx{..}) -> ctx{ctxAliases=a:ctxAliases}) addAccountAlias a = modifyState (\(ctx@Ctx{..}) -> ctx{ctxAliases=a:ctxAliases})
@ -251,7 +255,8 @@ directivep = do
,aliasdirectivep ,aliasdirectivep
,endaliasesdirectivep ,endaliasesdirectivep
,accountdirectivep ,accountdirectivep
,enddirectivep ,applyaccountdirectivep
,endapplyaccountdirectivep
,tagdirectivep ,tagdirectivep
,endtagdirectivep ,endtagdirectivep
,defaultyeardirectivep ,defaultyeardirectivep
@ -296,18 +301,27 @@ journalAddFile f j@Journal{files=fs} = j{files=fs++[f]}
accountdirectivep :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate accountdirectivep :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate
accountdirectivep = do accountdirectivep = do
(try $ string "apply" >> many1 spacenonewline >> string "account") string "account"
<|> string "account" many1 spacenonewline
acct <- accountnamep
newline
let indentedline = many1 spacenonewline >> restofline
many indentedline
pushAccount acct
return $ ExceptT $ return $ Right id
applyaccountdirectivep :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate
applyaccountdirectivep = do
string "apply" >> many1 spacenonewline >> string "account"
many1 spacenonewline many1 spacenonewline
parent <- accountnamep parent <- accountnamep
newline newline
pushParentAccount parent pushParentAccount parent
return $ ExceptT $ return $ Right id return $ ExceptT $ return $ Right id
enddirectivep :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate endapplyaccountdirectivep :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate
enddirectivep = do endapplyaccountdirectivep = do
string "end" string "end" >> many1 spacenonewline >> string "apply" >> many1 spacenonewline >> string "account"
optional $ many1 spacenonewline >> string "apply" >> many1 spacenonewline >> string "account"
popParentAccount popParentAccount
return $ ExceptT $ return $ Right id return $ ExceptT $ return $ Right id

90
hledger-lib/hledger_journal.5.md
View File

@ -561,6 +561,59 @@ You can clear (forget) all currently defined aliases with the `end aliases` dire
end aliases end aliases
``` ```
## account directive
The `account` directive predefines account names, as in Ledger and Beancount.
This may be useful for your own documentation; hledger doesn't make use of it yet.
``` {.journal}
; account ACCT
; OPTIONAL COMMENTS/TAGS...
account assets:bank:checking
a comment
acct-no:12345
account expenses:food
; etc.
```
## apply account directive
You can specify a parent account which will be prepended to all accounts
within a section of the journal. Use the `apply account` and `end apply account`
directives like so:
``` {.journal}
apply account home
2010/1/1
food $10
cash
end apply account
```
which is equivalent to:
``` {.journal}
2010/01/01
home:food $10
home:cash $-10
```
If `end apply account` is omitted, the effect lasts to the end of the file.
Included files are also affected, eg:
``` {.journal}
apply account business
include biz.journal
end apply account
apply account personal
include personal.journal
```
Prior to hledger 0.28, legacy `account` and `end` spellings were also supported.
## Multi-line comments ## Multi-line comments
A line containing just `comment` starts a multi-line comment, and a A line containing just `comment` starts a multi-line comment, and a
@ -600,43 +653,6 @@ $ hledger print
d £-1,000.00 d £-1,000.00
``` ```
## Default parent account
You can specify a parent account which will be prepended to all accounts
within a section of the journal. Use the `apply account` directive like so:
``` {.journal}
apply account home
2010/1/1
food $10
cash
end
```
(`!account`, `account`, and `end apply account` are also supported).
If `end` is omitted, the effect lasts to the end of the file.
The above is equivalent to:
``` {.journal}
2010/01/01
home:food $10
home:cash $-10
```
Included files are also affected, eg:
``` {.journal}
account business
include biz.journal
end
account personal
include personal.journal
end
```
## Default year ## Default year
You can set a default year to be used for subsequent dates which don't You can set a default year to be used for subsequent dates which don't

28
hledger/Hledger/Cli.hs
View File

@ -62,31 +62,19 @@ tests_Hledger_Cli = TestList
-- ,tests_Hledger_Cli_Stats -- ,tests_Hledger_Cli_Stats
,"account directive" ~: ,"apply account directive" ~:
let ignoresourcepos j = j{jtxns=map (\t -> t{tsourcepos=nullsourcepos}) (jtxns j)} in let ignoresourcepos j = j{jtxns=map (\t -> t{tsourcepos=nullsourcepos}) (jtxns j)} in
let sameParse str1 str2 = do j1 <- readJournal Nothing Nothing True Nothing str1 >>= either error' (return . ignoresourcepos) let sameParse str1 str2 = do j1 <- readJournal Nothing Nothing True Nothing str1 >>= either error' (return . ignoresourcepos)
j2 <- readJournal Nothing Nothing True Nothing str2 >>= either error' (return . ignoresourcepos) j2 <- readJournal Nothing Nothing True Nothing str2 >>= either error' (return . ignoresourcepos)
j1 `is` j2{filereadtime=filereadtime j1, files=files j1, jContext=jContext j1} j1 `is` j2{filereadtime=filereadtime j1, files=files j1, jContext=jContext j1}
in TestList in TestList
[ [
"account directive 1" ~: sameParse "apply account directive 1" ~: sameParse
"2008/12/07 One\n test:from $-1\n test:to $1\n"
"!account test\n2008/12/07 One\n from $-1\n to $1\n"
,"account directive 2" ~: sameParse
"2008/12/07 One\n test:foo:from $-1\n test:foo:to $1\n"
"!account test\n!account foo\n2008/12/07 One\n from $-1\n to $1\n"
,"account directive 3" ~: sameParse
"2008/12/07 One\n test:from $-1\n test:to $1\n"
"!account test\n!account foo\n!end\n2008/12/07 One\n from $-1\n to $1\n"
,"account directive 4" ~: sameParse
("2008/12/07 One\n alpha $-1\n beta $1\n" ++ ("2008/12/07 One\n alpha $-1\n beta $1\n" ++
"!account outer\n2008/12/07 Two\n aigh $-2\n bee $2\n" ++ "apply account outer\n2008/12/07 Two\n aigh $-2\n bee $2\n" ++
"!account inner\n2008/12/07 Three\n gamma $-3\n delta $3\n" ++ "apply account inner\n2008/12/07 Three\n gamma $-3\n delta $3\n" ++
"!end\n2008/12/07 Four\n why $-4\n zed $4\n" ++ "end apply account\n2008/12/07 Four\n why $-4\n zed $4\n" ++
"!end\n2008/12/07 Five\n foo $-5\n bar $5\n" "end apply account\n2008/12/07 Five\n foo $-5\n bar $5\n"
) )
("2008/12/07 One\n alpha $-1\n beta $1\n" ++ ("2008/12/07 One\n alpha $-1\n beta $1\n" ++
"2008/12/07 Two\n outer:aigh $-2\n outer:bee $2\n" ++ "2008/12/07 Two\n outer:aigh $-2\n outer:bee $2\n" ++
@ -95,8 +83,8 @@ tests_Hledger_Cli = TestList
"2008/12/07 Five\n foo $-5\n bar $5\n" "2008/12/07 Five\n foo $-5\n bar $5\n"
) )
,"account directive should preserve \"virtual\" posting type" ~: do ,"apply account directive should preserve \"virtual\" posting type" ~: do
j <- readJournal Nothing Nothing True Nothing "!account test\n2008/12/07 One\n (from) $-1\n (to) $1\n" >>= either error' return j <- readJournal Nothing Nothing True Nothing "apply account test\n2008/12/07 One\n (from) $-1\n (to) $1\n" >>= either error' return
let p = head $ tpostings $ head $ jtxns j let p = head $ tpostings $ head $ jtxns j
assertBool "" $ paccount p == "test:from" assertBool "" $ paccount p == "test:from"
assertBool "" $ ptype p == VirtualPosting assertBool "" $ ptype p == VirtualPosting

90
site/manual.md
View File

@ -671,6 +671,59 @@ You can clear (forget) all currently defined aliases with the `end aliases` dire
end aliases end aliases
``` ```
##### account directive
The `account` directive predefines account names, as in Ledger and Beancount.
This may be useful for your own documentation; hledger doesn't make use of it yet.
``` {.journal}
; account ACCT
; OPTIONAL COMMENTS/TAGS...
account assets:bank:checking
a comment
acct-no:12345
account expenses:food
; etc.
```
##### apply account directive
You can specify a parent account which will be prepended to all accounts
within a section of the journal. Use the `apply account` and `end apply account`
directives like so:
``` {.journal}
apply account home
2010/1/1
food $10
cash
end apply account
```
which is equivalent to:
``` {.journal}
2010/01/01
home:food $10
home:cash $-10
```
If `end apply account` is omitted, the effect lasts to the end of the file.
Included files are also affected, eg:
``` {.journal}
apply account business
include biz.journal
end apply account
apply account personal
include personal.journal
```
Prior to hledger 0.28, legacy `account` and `end` spellings were also supported.
##### Multi-line comments ##### Multi-line comments
A line containing just `comment` starts a multi-line comment, and a A line containing just `comment` starts a multi-line comment, and a
@ -710,43 +763,6 @@ $ hledger print
d £-1,000.00 d £-1,000.00
``` ```
##### Default parent account
You can specify a parent account which will be prepended to all accounts
within a section of the journal. Use the `apply account` directive like so:
``` {.journal}
apply account home
2010/1/1
food $10
cash
end
```
(`!account`, `account`, and `end apply account` are also supported).
If `end` is omitted, the effect lasts to the end of the file.
The above is equivalent to:
``` {.journal}
2010/01/01
home:food $10
home:cash $-10
```
Included files are also affected, eg:
``` {.journal}
account business
include biz.journal
end
account personal
include personal.journal
end
```
##### Default year ##### Default year
You can set a default year to be used for subsequent dates which don't You can set a default year to be used for subsequent dates which don't

34
tests/journal/directives.test
View File

@ -1,40 +1,10 @@
# Accept three forms of the account directive # . apply account, end apply account
# . !account, !end (ledger 2, hledger)
hledger -f - accounts
<<<
!account a
2016/1/1
(b) 1
!end
2016/1/2
(c) 1
>>>
a:b
c
>>>=0
# . account, end (ledger 3 pre ?, hledger)
hledger -f - accounts
<<<
account a
2016/1/1
(b) 1
end
2016/1/2
(c) 1
>>>
a:b
c
>>>=0
# . apply account, end [apply account] (ledger 3, hledger)
# . now: apply account
hledger -f - accounts hledger -f - accounts
<<< <<<
apply account a apply account a
2016/1/1 2016/1/1
(b) 1 (b) 1
end end apply account
apply account aa apply account aa
2016/1/1 2016/1/1
(b) 1 (b) 1