journal: parse account directives
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:
		
							parent
							
								
									25cd65442a
								
							
						
					
					
						commit
						31a754544a
					
				| @ -137,7 +137,7 @@ nulljournal = Journal { jmodifiertxns = [] | ||||
|                       } | ||||
| 
 | ||||
| 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 = fst . mainfile | ||||
|  | ||||
| @ -230,8 +230,9 @@ type Year = Integer | ||||
| data JournalContext = Ctx { | ||||
|       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 | ||||
|     , ctxAccount   :: ![AccountName]     -- ^ the current stack of parent accounts/account name components | ||||
|                                         --   specified with "account" directive(s). Concatenated, these | ||||
|     , ctxAccounts :: ![AccountName]      -- ^ the accounts that have been defined with account directives so far | ||||
|     , ctxParentAccount :: ![AccountName] -- ^ the current stack of parent accounts/account name components | ||||
|                                          --   specified with "apply account" directive(s). Concatenated, these | ||||
|                                          --   are the account prefix prepended to parsed account names. | ||||
|     , ctxAliases   :: ![AccountAlias]    -- ^ the current list of account name aliases in effect | ||||
|     , ctxTransactionIndex   :: !Integer  -- ^ the number of transactions read so far | ||||
|  | ||||
| @ -190,18 +190,22 @@ setDefaultCommodityAndStyle cs = modifyState (\ctx -> ctx{ctxDefaultCommodityAnd | ||||
| getDefaultCommodityAndStyle :: Stream [Char] m Char => ParsecT [Char] JournalContext m (Maybe (Commodity,AmountStyle)) | ||||
| 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 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 = do ctx0 <- getState | ||||
|                       case ctxAccount ctx0 of | ||||
|                         [] -> unexpected "End of account block with no beginning" | ||||
|                         (_:rest) -> setState $ ctx0 { ctxAccount = rest } | ||||
|                       case ctxParentAccount ctx0 of | ||||
|                         [] -> unexpected "End of apply account block with no beginning" | ||||
|                         (_:rest) -> setState $ ctx0 { ctxParentAccount = rest } | ||||
| 
 | ||||
| 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 a = modifyState (\(ctx@Ctx{..}) -> ctx{ctxAliases=a:ctxAliases}) | ||||
| @ -251,7 +255,8 @@ directivep = do | ||||
|    ,aliasdirectivep | ||||
|    ,endaliasesdirectivep | ||||
|    ,accountdirectivep | ||||
|    ,enddirectivep | ||||
|    ,applyaccountdirectivep | ||||
|    ,endapplyaccountdirectivep | ||||
|    ,tagdirectivep | ||||
|    ,endtagdirectivep | ||||
|    ,defaultyeardirectivep | ||||
| @ -296,18 +301,27 @@ journalAddFile f j@Journal{files=fs} = j{files=fs++[f]} | ||||
| 
 | ||||
| accountdirectivep :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate | ||||
| 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 | ||||
|   parent <- accountnamep | ||||
|   newline | ||||
|   pushParentAccount parent | ||||
|   return $ ExceptT $ return $ Right id | ||||
| 
 | ||||
| enddirectivep :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate | ||||
| enddirectivep = do | ||||
|   string "end" | ||||
|   optional $ many1 spacenonewline >> string "apply" >> many1 spacenonewline >> string "account" | ||||
| endapplyaccountdirectivep :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate | ||||
| endapplyaccountdirectivep = do | ||||
|   string "end" >> many1 spacenonewline >> string "apply" >> many1 spacenonewline >> string "account" | ||||
|   popParentAccount | ||||
|   return $ ExceptT $ return $ Right id | ||||
| 
 | ||||
|  | ||||
| @ -561,6 +561,59 @@ You can clear (forget) all currently defined aliases with the `end aliases` dire | ||||
| 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 | ||||
| 
 | ||||
| A line containing just `comment` starts a multi-line comment, and a | ||||
| @ -600,43 +653,6 @@ $ hledger print | ||||
|     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 | ||||
| 
 | ||||
| You can set a default year to be used for subsequent dates which don't | ||||
|  | ||||
| @ -62,31 +62,19 @@ tests_Hledger_Cli = TestList | ||||
|    -- ,tests_Hledger_Cli_Stats | ||||
| 
 | ||||
| 
 | ||||
|    ,"account directive" ~: | ||||
|    ,"apply account directive" ~: | ||||
|    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) | ||||
|                                 j2 <- readJournal Nothing Nothing True Nothing str2 >>= either error' (return . ignoresourcepos) | ||||
|                                 j1 `is` j2{filereadtime=filereadtime j1, files=files j1, jContext=jContext j1} | ||||
|    in TestList | ||||
|    [ | ||||
|     "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 | ||||
|     "apply account directive 1" ~: sameParse | ||||
|                            ("2008/12/07 One\n  alpha  $-1\n  beta  $1\n" ++ | ||||
|                             "!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" ++ | ||||
|                             "!end\n2008/12/07 Four\n  why  $-4\n  zed  $4\n" ++ | ||||
|                             "!end\n2008/12/07 Five\n  foo  $-5\n  bar  $5\n" | ||||
|                             "apply account outer\n2008/12/07 Two\n  aigh  $-2\n  bee  $2\n" ++ | ||||
|                             "apply account inner\n2008/12/07 Three\n  gamma  $-3\n  delta  $3\n" ++ | ||||
|                             "end apply account\n2008/12/07 Four\n  why  $-4\n  zed  $4\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 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" | ||||
|                            ) | ||||
| 
 | ||||
|    ,"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 | ||||
|    ,"apply account directive should preserve \"virtual\" posting type" ~: do | ||||
|       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 | ||||
|       assertBool "" $ paccount p == "test:from" | ||||
|       assertBool "" $ ptype p == VirtualPosting | ||||
|  | ||||
| @ -671,6 +671,59 @@ You can clear (forget) all currently defined aliases with the `end aliases` dire | ||||
| 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 | ||||
| 
 | ||||
| A line containing just `comment` starts a multi-line comment, and a | ||||
| @ -710,43 +763,6 @@ $ hledger print | ||||
|     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 | ||||
| 
 | ||||
| You can set a default year to be used for subsequent dates which don't | ||||
|  | ||||
| @ -1,40 +1,10 @@ | ||||
| # Accept three forms of the account directive | ||||
| # . !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 | ||||
| # . apply account, end apply account | ||||
| hledger -f - accounts | ||||
| <<< | ||||
| apply account a | ||||
| 2016/1/1 | ||||
|     (b)  1 | ||||
| end | ||||
| end apply account | ||||
| apply account aa | ||||
| 2016/1/1 | ||||
|     (b)  1 | ||||
|  | ||||
		Loading…
	
		Reference in New Issue
	
	Block a user