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