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