diff --git a/hledger-lib/Ledger/Parse.hs b/hledger-lib/Ledger/Parse.hs index 8174385a7..e00c66625 100644 --- a/hledger-lib/Ledger/Parse.hs +++ b/hledger-lib/Ledger/Parse.hs @@ -161,6 +161,10 @@ import Ledger.Commodity (dollars,dollar,unknown) import System.FilePath(takeDirectory,combine) +-- | A JournalUpdate is some transformation of a "Journal". It can do I/O +-- or raise an error. +type JournalUpdate = ErrorT String IO (Journal -> Journal) + -- | Some context kept during parsing. data LedgerFileCtx = Ctx { ctxYear :: !(Maybe Integer) -- ^ the default year most recently specified with Y @@ -218,10 +222,10 @@ parseLedger reftime inname intxt = -- parsers --- | Top-level journal parser. Returns a mighty composite, I/O performing, --- error-raising journal transformation, which should be applied to a --- journal to get the final result. -ledgerFile :: GenParser Char LedgerFileCtx (ErrorT String IO (Journal -> Journal)) +-- | Top-level journal parser. Returns a single composite, I/O performing, +-- error-raising "JournalUpdate" which can be applied to an empty journal +-- to get the final result. +ledgerFile :: GenParser Char LedgerFileCtx JournalUpdate ledgerFile = do items <- many ledgerItem eof return $ liftM (foldr (.) id) $ sequence items @@ -264,7 +268,7 @@ ledgercommentline = do return s "comment" -ledgerExclamationDirective :: GenParser Char LedgerFileCtx (ErrorT String IO (Journal -> Journal)) +ledgerExclamationDirective :: GenParser Char LedgerFileCtx JournalUpdate ledgerExclamationDirective = do char '!' "directive" directive <- many nonspace @@ -274,7 +278,7 @@ ledgerExclamationDirective = do "end" -> ledgerAccountEnd _ -> mzero -ledgerInclude :: GenParser Char LedgerFileCtx (ErrorT String IO (Journal -> Journal)) +ledgerInclude :: GenParser Char LedgerFileCtx JournalUpdate ledgerInclude = do many1 spacenonewline filename <- restofline outerState <- getState @@ -289,14 +293,14 @@ ledgerInclude = do many1 spacenonewline currentPos = show outerPos whileReading = " reading " ++ show filename ++ ":\n" -ledgerAccountBegin :: GenParser Char LedgerFileCtx (ErrorT String IO (Journal -> Journal)) +ledgerAccountBegin :: GenParser Char LedgerFileCtx JournalUpdate ledgerAccountBegin = do many1 spacenonewline parent <- ledgeraccountname newline pushParentAccount parent return $ return id -ledgerAccountEnd :: GenParser Char LedgerFileCtx (ErrorT String IO (Journal -> Journal)) +ledgerAccountEnd :: GenParser Char LedgerFileCtx JournalUpdate ledgerAccountEnd = popParentAccount >> return (return id) ledgerModifierTransaction :: GenParser Char LedgerFileCtx ModifierTransaction @@ -327,7 +331,7 @@ ledgerHistoricalPrice = do restofline return $ HistoricalPrice date symbol price -ledgerIgnoredPriceCommodity :: GenParser Char LedgerFileCtx (ErrorT String IO (Journal -> Journal)) +ledgerIgnoredPriceCommodity :: GenParser Char LedgerFileCtx JournalUpdate ledgerIgnoredPriceCommodity = do char 'N' "ignored-price commodity" many1 spacenonewline @@ -335,7 +339,7 @@ ledgerIgnoredPriceCommodity = do restofline return $ return id -ledgerDefaultCommodity :: GenParser Char LedgerFileCtx (ErrorT String IO (Journal -> Journal)) +ledgerDefaultCommodity :: GenParser Char LedgerFileCtx JournalUpdate ledgerDefaultCommodity = do char 'D' "default commodity" many1 spacenonewline @@ -343,7 +347,7 @@ ledgerDefaultCommodity = do restofline return $ return id -ledgerCommodityConversion :: GenParser Char LedgerFileCtx (ErrorT String IO (Journal -> Journal)) +ledgerCommodityConversion :: GenParser Char LedgerFileCtx JournalUpdate ledgerCommodityConversion = do char 'C' "commodity conversion" many1 spacenonewline @@ -355,7 +359,7 @@ ledgerCommodityConversion = do restofline return $ return id -ledgerTagDirective :: GenParser Char LedgerFileCtx (ErrorT String IO (Journal -> Journal)) +ledgerTagDirective :: GenParser Char LedgerFileCtx JournalUpdate ledgerTagDirective = do string "tag" "tag directive" many1 spacenonewline @@ -363,14 +367,14 @@ ledgerTagDirective = do restofline return $ return id -ledgerEndTagDirective :: GenParser Char LedgerFileCtx (ErrorT String IO (Journal -> Journal)) +ledgerEndTagDirective :: GenParser Char LedgerFileCtx JournalUpdate ledgerEndTagDirective = do string "end tag" "end tag directive" restofline return $ return id -- like ledgerAccountBegin, updates the LedgerFileCtx -ledgerDefaultYear :: GenParser Char LedgerFileCtx (ErrorT String IO (Journal -> Journal)) +ledgerDefaultYear :: GenParser Char LedgerFileCtx JournalUpdate ledgerDefaultYear = do char 'Y' "default year" many spacenonewline