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

ledgerFile cleanup

Browse Source
This commit is contained in:
Simon Michael 2009-04-10 05:40:57 +00:00
parent c14f1c280f
commit 638238dc5c
1 changed files with 15 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
Ledger/Parse.hs
View File

@ -83,23 +83,24 @@ parseLedger reftime inname intxt = do
Right m -> liftM (rawLedgerConvertTimeLog reftime) $ m `ap` (return rawLedgerEmpty) Right m -> liftM (rawLedgerConvertTimeLog reftime) $ m `ap` (return rawLedgerEmpty)
Left err -> throwError $ show err Left err -> throwError $ show err
-- As all ledger line types can be distinguished by the first
-- character, excepting transactions versus empty (blank or
-- comment-only) lines, can use choice w/o try
ledgerFile :: GenParser Char LedgerFileCtx (ErrorT String IO (RawLedger -> RawLedger)) ledgerFile :: GenParser Char LedgerFileCtx (ErrorT String IO (RawLedger -> RawLedger))
ledgerFile = do ledger_txns <- many1 ledgerItem ledgerFile = do items <- many1 ledgerItem
eof eof
return $ liftM (foldr1 (.)) $ sequence ledger_txns return $ liftM (foldr1 (.)) $ sequence items
where ledgerItem = choice [ ledgerDirective where
, liftM (return . addLedgerTransaction) ledgerTransaction -- As all ledger line types can be distinguished by the first
, liftM (return . addModifierTransaction) ledgerModifierTransaction -- character, excepting transactions versus empty (blank or
, liftM (return . addPeriodicTransaction) ledgerPeriodicTransaction -- comment-only) lines, can use choice w/o try
, liftM (return . addHistoricalPrice) ledgerHistoricalPrice ledgerItem = choice [ ledgerDirective
, ledgerDefaultYear , liftM (return . addLedgerTransaction) ledgerTransaction
, emptyLine >> return (return id) , liftM (return . addModifierTransaction) ledgerModifierTransaction
, liftM (return . addTimeLogEntry) timelogentry , liftM (return . addPeriodicTransaction) ledgerPeriodicTransaction
] , liftM (return . addHistoricalPrice) ledgerHistoricalPrice
, ledgerDefaultYear
, emptyLine >> return (return id)
, liftM (return . addTimeLogEntry) timelogentry
]
ledgerDirective :: GenParser Char LedgerFileCtx (ErrorT String IO (RawLedger -> RawLedger)) ledgerDirective :: GenParser Char LedgerFileCtx (ErrorT String IO (RawLedger -> RawLedger))
ledgerDirective = do char '!' ledgerDirective = do char '!'