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)
|
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.
|
-- | Some context kept during parsing.
|
||||||
data LedgerFileCtx = Ctx {
|
data LedgerFileCtx = Ctx {
|
||||||
ctxYear :: !(Maybe Integer) -- ^ the default year most recently specified with Y
|
ctxYear :: !(Maybe Integer) -- ^ the default year most recently specified with Y
|
||||||
@ -218,10 +222,10 @@ parseLedger reftime inname intxt =
|
|||||||
|
|
||||||
-- parsers
|
-- parsers
|
||||||
|
|
||||||
-- | Top-level journal parser. Returns a mighty composite, I/O performing,
|
-- | Top-level journal parser. Returns a single composite, I/O performing,
|
||||||
-- error-raising journal transformation, which should be applied to a
|
-- error-raising "JournalUpdate" which can be applied to an empty journal
|
||||||
-- journal to get the final result.
|
-- to get the final result.
|
||||||
ledgerFile :: GenParser Char LedgerFileCtx (ErrorT String IO (Journal -> Journal))
|
ledgerFile :: GenParser Char LedgerFileCtx JournalUpdate
|
||||||
ledgerFile = do items <- many ledgerItem
|
ledgerFile = do items <- many ledgerItem
|
||||||
eof
|
eof
|
||||||
return $ liftM (foldr (.) id) $ sequence items
|
return $ liftM (foldr (.) id) $ sequence items
|
||||||
@ -264,7 +268,7 @@ ledgercommentline = do
|
|||||||
return s
|
return s
|
||||||
<?> "comment"
|
<?> "comment"
|
||||||
|
|
||||||
ledgerExclamationDirective :: GenParser Char LedgerFileCtx (ErrorT String IO (Journal -> Journal))
|
ledgerExclamationDirective :: GenParser Char LedgerFileCtx JournalUpdate
|
||||||
ledgerExclamationDirective = do
|
ledgerExclamationDirective = do
|
||||||
char '!' <?> "directive"
|
char '!' <?> "directive"
|
||||||
directive <- many nonspace
|
directive <- many nonspace
|
||||||
@ -274,7 +278,7 @@ ledgerExclamationDirective = do
|
|||||||
"end" -> ledgerAccountEnd
|
"end" -> ledgerAccountEnd
|
||||||
_ -> mzero
|
_ -> mzero
|
||||||
|
|
||||||
ledgerInclude :: GenParser Char LedgerFileCtx (ErrorT String IO (Journal -> Journal))
|
ledgerInclude :: GenParser Char LedgerFileCtx JournalUpdate
|
||||||
ledgerInclude = do many1 spacenonewline
|
ledgerInclude = do many1 spacenonewline
|
||||||
filename <- restofline
|
filename <- restofline
|
||||||
outerState <- getState
|
outerState <- getState
|
||||||
@ -289,14 +293,14 @@ ledgerInclude = do many1 spacenonewline
|
|||||||
currentPos = show outerPos
|
currentPos = show outerPos
|
||||||
whileReading = " reading " ++ show filename ++ ":\n"
|
whileReading = " reading " ++ show filename ++ ":\n"
|
||||||
|
|
||||||
ledgerAccountBegin :: GenParser Char LedgerFileCtx (ErrorT String IO (Journal -> Journal))
|
ledgerAccountBegin :: GenParser Char LedgerFileCtx JournalUpdate
|
||||||
ledgerAccountBegin = do many1 spacenonewline
|
ledgerAccountBegin = do many1 spacenonewline
|
||||||
parent <- ledgeraccountname
|
parent <- ledgeraccountname
|
||||||
newline
|
newline
|
||||||
pushParentAccount parent
|
pushParentAccount parent
|
||||||
return $ return id
|
return $ return id
|
||||||
|
|
||||||
ledgerAccountEnd :: GenParser Char LedgerFileCtx (ErrorT String IO (Journal -> Journal))
|
ledgerAccountEnd :: GenParser Char LedgerFileCtx JournalUpdate
|
||||||
ledgerAccountEnd = popParentAccount >> return (return id)
|
ledgerAccountEnd = popParentAccount >> return (return id)
|
||||||
|
|
||||||
ledgerModifierTransaction :: GenParser Char LedgerFileCtx ModifierTransaction
|
ledgerModifierTransaction :: GenParser Char LedgerFileCtx ModifierTransaction
|
||||||
@ -327,7 +331,7 @@ ledgerHistoricalPrice = do
|
|||||||
restofline
|
restofline
|
||||||
return $ HistoricalPrice date symbol price
|
return $ HistoricalPrice date symbol price
|
||||||
|
|
||||||
ledgerIgnoredPriceCommodity :: GenParser Char LedgerFileCtx (ErrorT String IO (Journal -> Journal))
|
ledgerIgnoredPriceCommodity :: GenParser Char LedgerFileCtx JournalUpdate
|
||||||
ledgerIgnoredPriceCommodity = do
|
ledgerIgnoredPriceCommodity = do
|
||||||
char 'N' <?> "ignored-price commodity"
|
char 'N' <?> "ignored-price commodity"
|
||||||
many1 spacenonewline
|
many1 spacenonewline
|
||||||
@ -335,7 +339,7 @@ ledgerIgnoredPriceCommodity = do
|
|||||||
restofline
|
restofline
|
||||||
return $ return id
|
return $ return id
|
||||||
|
|
||||||
ledgerDefaultCommodity :: GenParser Char LedgerFileCtx (ErrorT String IO (Journal -> Journal))
|
ledgerDefaultCommodity :: GenParser Char LedgerFileCtx JournalUpdate
|
||||||
ledgerDefaultCommodity = do
|
ledgerDefaultCommodity = do
|
||||||
char 'D' <?> "default commodity"
|
char 'D' <?> "default commodity"
|
||||||
many1 spacenonewline
|
many1 spacenonewline
|
||||||
@ -343,7 +347,7 @@ ledgerDefaultCommodity = do
|
|||||||
restofline
|
restofline
|
||||||
return $ return id
|
return $ return id
|
||||||
|
|
||||||
ledgerCommodityConversion :: GenParser Char LedgerFileCtx (ErrorT String IO (Journal -> Journal))
|
ledgerCommodityConversion :: GenParser Char LedgerFileCtx JournalUpdate
|
||||||
ledgerCommodityConversion = do
|
ledgerCommodityConversion = do
|
||||||
char 'C' <?> "commodity conversion"
|
char 'C' <?> "commodity conversion"
|
||||||
many1 spacenonewline
|
many1 spacenonewline
|
||||||
@ -355,7 +359,7 @@ ledgerCommodityConversion = do
|
|||||||
restofline
|
restofline
|
||||||
return $ return id
|
return $ return id
|
||||||
|
|
||||||
ledgerTagDirective :: GenParser Char LedgerFileCtx (ErrorT String IO (Journal -> Journal))
|
ledgerTagDirective :: GenParser Char LedgerFileCtx JournalUpdate
|
||||||
ledgerTagDirective = do
|
ledgerTagDirective = do
|
||||||
string "tag" <?> "tag directive"
|
string "tag" <?> "tag directive"
|
||||||
many1 spacenonewline
|
many1 spacenonewline
|
||||||
@ -363,14 +367,14 @@ ledgerTagDirective = do
|
|||||||
restofline
|
restofline
|
||||||
return $ return id
|
return $ return id
|
||||||
|
|
||||||
ledgerEndTagDirective :: GenParser Char LedgerFileCtx (ErrorT String IO (Journal -> Journal))
|
ledgerEndTagDirective :: GenParser Char LedgerFileCtx JournalUpdate
|
||||||
ledgerEndTagDirective = do
|
ledgerEndTagDirective = do
|
||||||
string "end tag" <?> "end tag directive"
|
string "end tag" <?> "end tag directive"
|
||||||
restofline
|
restofline
|
||||||
return $ return id
|
return $ return id
|
||||||
|
|
||||||
-- like ledgerAccountBegin, updates the LedgerFileCtx
|
-- like ledgerAccountBegin, updates the LedgerFileCtx
|
||||||
ledgerDefaultYear :: GenParser Char LedgerFileCtx (ErrorT String IO (Journal -> Journal))
|
ledgerDefaultYear :: GenParser Char LedgerFileCtx JournalUpdate
|
||||||
ledgerDefaultYear = do
|
ledgerDefaultYear = do
|
||||||
char 'Y' <?> "default year"
|
char 'Y' <?> "default year"
|
||||||
many spacenonewline
|
many spacenonewline
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user