mirror of
https://github.com/simonmichael/hledger.git
synced 2024-09-20 02:37:12 +03:00
refactor
This commit is contained in:
parent
fd8ebd7c3d
commit
d028e9eb17
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user