Parse cleanups
This commit is contained in:
		
							parent
							
								
									fa1b4bdfa2
								
							
						
					
					
						commit
						83e58501fc
					
				
							
								
								
									
										141
									
								
								Ledger/Parse.hs
									
									
									
									
									
								
							
							
						
						
									
										141
									
								
								Ledger/Parse.hs
									
									
									
									
									
								
							| @ -1,7 +1,66 @@ | |||||||
| {-| | {-| | ||||||
| 
 | 
 | ||||||
| A parser for standard ledger files.  Here's the grammar from the | Parsers for standard ledger and timelog files. | ||||||
| ledger 2.5 manual: | 
 | ||||||
|  | -} | ||||||
|  | 
 | ||||||
|  | module Ledger.Parse | ||||||
|  | where | ||||||
|  | import qualified Data.Map as Map | ||||||
|  | import Text.ParserCombinators.Parsec | ||||||
|  | import Text.ParserCombinators.Parsec.Language | ||||||
|  | import qualified Text.ParserCombinators.Parsec.Token as P | ||||||
|  | import System.IO | ||||||
|  | 
 | ||||||
|  | import Ledger.Utils | ||||||
|  | import Ledger.Types | ||||||
|  | import Ledger.Entry (autofillEntry) | ||||||
|  | import Ledger.Currency (getcurrency) | ||||||
|  | import Ledger.TimeLog (ledgerFromTimeLog) | ||||||
|  | 
 | ||||||
|  | -- utils | ||||||
|  | 
 | ||||||
|  | parseLedgerFile :: String -> IO (Either ParseError RawLedger) | ||||||
|  | parseLedgerFile "-" = fmap (parse ledgerfile "-") $ hGetContents stdin | ||||||
|  | parseLedgerFile f   = parseFromFile ledgerfile f | ||||||
|  |      | ||||||
|  | printParseError :: (Show a) => a -> IO () | ||||||
|  | printParseError e = do putStr "ledger parse error at "; print e | ||||||
|  | 
 | ||||||
|  | -- set up token parsing, though we're not yet using these much | ||||||
|  | ledgerLanguageDef = LanguageDef { | ||||||
|  |    commentStart   = "" | ||||||
|  |    , commentEnd     = "" | ||||||
|  |    , commentLine    = ";" | ||||||
|  |    , nestedComments = False | ||||||
|  |    , identStart     = letter <|> char '_' | ||||||
|  |    , identLetter    = alphaNum <|> oneOf "_':" | ||||||
|  |    , opStart        = opLetter emptyDef | ||||||
|  |    , opLetter       = oneOf "!#$%&*+./<=>?@\\^|-~" | ||||||
|  |    , reservedOpNames= [] | ||||||
|  |    , reservedNames  = [] | ||||||
|  |    , caseSensitive  = False | ||||||
|  |    } | ||||||
|  | lexer      = P.makeTokenParser ledgerLanguageDef | ||||||
|  | whiteSpace = P.whiteSpace lexer | ||||||
|  | lexeme     = P.lexeme lexer | ||||||
|  | symbol     = P.symbol lexer | ||||||
|  | natural    = P.natural lexer | ||||||
|  | parens     = P.parens lexer | ||||||
|  | semi       = P.semi lexer | ||||||
|  | identifier = P.identifier lexer | ||||||
|  | reserved   = P.reserved lexer | ||||||
|  | reservedOp = P.reservedOp lexer | ||||||
|  | 
 | ||||||
|  | -- parsers | ||||||
|  | 
 | ||||||
|  | -- | Parse a RawLedger from either a ledger file or a timelog file. | ||||||
|  | -- It tries first the timelog parser then the ledger parser; this means | ||||||
|  | -- parse errors for ledgers are useful while those for timelogs are not. | ||||||
|  | ledgerfile :: Parser RawLedger | ||||||
|  | ledgerfile = try ledgerfromtimelog <|> ledger | ||||||
|  | 
 | ||||||
|  | {-| Parse a ledger file. Here is the ledger grammar from the ledger 2.5 manual: | ||||||
| 
 | 
 | ||||||
| @ | @ | ||||||
| The ledger file format is quite simple, but also very flexible. It supports | The ledger file format is quite simple, but also very flexible. It supports | ||||||
| @ -99,71 +158,14 @@ i, o, b, h | |||||||
|            timelog files. |            timelog files. | ||||||
| @ | @ | ||||||
| 
 | 
 | ||||||
| See Tests.hs for sample data. | See "Tests" for sample data. | ||||||
| -} | -} | ||||||
| 
 |  | ||||||
| module Ledger.Parse |  | ||||||
| where |  | ||||||
| import qualified Data.Map as Map |  | ||||||
| import Text.ParserCombinators.Parsec |  | ||||||
| import Text.ParserCombinators.Parsec.Language |  | ||||||
| import qualified Text.ParserCombinators.Parsec.Token as P |  | ||||||
| import System.IO |  | ||||||
| 
 |  | ||||||
| import Ledger.Utils |  | ||||||
| import Ledger.Types |  | ||||||
| import Ledger.Entry (autofillEntry) |  | ||||||
| import Ledger.Currency (getcurrency) |  | ||||||
| import Ledger.TimeLog (ledgerFromTimeLog) |  | ||||||
| 
 |  | ||||||
| -- utils |  | ||||||
| 
 |  | ||||||
| parseLedgerFile :: String -> IO (Either ParseError RawLedger) |  | ||||||
| parseLedgerFile "-" = fmap (parse ledgerfile "-") $ hGetContents stdin |  | ||||||
| parseLedgerFile f   = parseFromFile ledgerfile f |  | ||||||
|      |  | ||||||
| printParseError :: (Show a) => a -> IO () |  | ||||||
| printParseError e = do putStr "ledger parse error at "; print e |  | ||||||
| 
 |  | ||||||
| -- set up token parsing, though we're not yet using these much |  | ||||||
| ledgerLanguageDef = LanguageDef { |  | ||||||
|    commentStart   = "" |  | ||||||
|    , commentEnd     = "" |  | ||||||
|    , commentLine    = ";" |  | ||||||
|    , nestedComments = False |  | ||||||
|    , identStart     = letter <|> char '_' |  | ||||||
|    , identLetter    = alphaNum <|> oneOf "_':" |  | ||||||
|    , opStart        = opLetter emptyDef |  | ||||||
|    , opLetter       = oneOf "!#$%&*+./<=>?@\\^|-~" |  | ||||||
|    , reservedOpNames= [] |  | ||||||
|    , reservedNames  = [] |  | ||||||
|    , caseSensitive  = False |  | ||||||
|    } |  | ||||||
| lexer      = P.makeTokenParser ledgerLanguageDef |  | ||||||
| whiteSpace = P.whiteSpace lexer |  | ||||||
| lexeme     = P.lexeme lexer |  | ||||||
| symbol     = P.symbol lexer |  | ||||||
| natural    = P.natural lexer |  | ||||||
| parens     = P.parens lexer |  | ||||||
| semi       = P.semi lexer |  | ||||||
| identifier = P.identifier lexer |  | ||||||
| reserved   = P.reserved lexer |  | ||||||
| reservedOp = P.reservedOp lexer |  | ||||||
| 
 |  | ||||||
| -- parsers |  | ||||||
| 
 |  | ||||||
| -- | Parse a RawLedger from either a ledger file or a timelog file. |  | ||||||
| -- It tries first the ledger parser then the timelog parser, unfortunately |  | ||||||
| -- this obscures ledger file parse errors. |  | ||||||
| ledgerfile :: Parser RawLedger |  | ||||||
| ledgerfile = try (ledger) <|> ledgerfromtimelog |  | ||||||
| 
 |  | ||||||
| ledger :: Parser RawLedger | ledger :: Parser RawLedger | ||||||
| ledger = do | ledger = do | ||||||
|   -- for now these must come first, unlike ledger |   -- we expect these to come first, unlike ledger | ||||||
|   modifier_entries <- many ledgermodifierentry |   modifier_entries <- many ledgermodifierentry | ||||||
|   periodic_entries <- many ledgerperiodicentry |   periodic_entries <- many ledgerperiodicentry | ||||||
|   -- | 
 | ||||||
|   entries <- (many ledgerentry) <?> "entry" |   entries <- (many ledgerentry) <?> "entry" | ||||||
|   final_comment_lines <- ledgernondatalines |   final_comment_lines <- ledgernondatalines | ||||||
|   eof |   eof | ||||||
| @ -250,7 +252,7 @@ ledgertransactions = (ledgertransaction <?> "transaction") `manyTill` (do {newli | |||||||
| ledgertransaction :: Parser RawTransaction | ledgertransaction :: Parser RawTransaction | ||||||
| ledgertransaction = do | ledgertransaction = do | ||||||
|   many1 spacenonewline |   many1 spacenonewline | ||||||
|   account <- ledgeraccount |   account <- ledgeraccountname | ||||||
|   amount <- ledgeramount |   amount <- ledgeramount | ||||||
|   many spacenonewline |   many spacenonewline | ||||||
|   comment <- ledgercomment |   comment <- ledgercomment | ||||||
| @ -258,8 +260,8 @@ ledgertransaction = do | |||||||
|   return (RawTransaction account amount comment) |   return (RawTransaction account amount comment) | ||||||
| 
 | 
 | ||||||
| -- | account names may have single spaces inside them, and are terminated by two or more spaces | -- | account names may have single spaces inside them, and are terminated by two or more spaces | ||||||
| ledgeraccount :: Parser String | ledgeraccountname :: Parser String | ||||||
| ledgeraccount = do | ledgeraccountname = do | ||||||
|     accountname <- many1 (accountnamechar <|> singlespace) |     accountname <- many1 (accountnamechar <|> singlespace) | ||||||
|     return $ striptrailingspace accountname |     return $ striptrailingspace accountname | ||||||
|     where  |     where  | ||||||
| @ -294,9 +296,7 @@ whiteSpace1 :: Parser () | |||||||
| whiteSpace1 = do space; whiteSpace | whiteSpace1 = do space; whiteSpace | ||||||
| 
 | 
 | ||||||
| 
 | 
 | ||||||
| {-| timelog file parser  | {-| Parse a timelog file. Here is the timelog grammar, from timeclock.el 2.6: | ||||||
| 
 |  | ||||||
| Here is the timelog grammar, from timeclock.el 2.6: |  | ||||||
| 
 | 
 | ||||||
| @ | @ | ||||||
| A timelog contains data in the form of a single entry per line. | A timelog contains data in the form of a single entry per line. | ||||||
| @ -324,12 +324,13 @@ i, o or O.  The meanings of the codes are: | |||||||
| 
 | 
 | ||||||
|   O  Final clock out.  Whatever project was being worked on, it is |   O  Final clock out.  Whatever project was being worked on, it is | ||||||
|      now finished.  Useful for creating summary reports. |      now finished.  Useful for creating summary reports. | ||||||
|  | @ | ||||||
| 
 | 
 | ||||||
| example: | Example: | ||||||
| 
 | 
 | ||||||
| i 2007/03/10 12:26:00 hledger | i 2007/03/10 12:26:00 hledger | ||||||
| o 2007/03/10 17:26:02 | o 2007/03/10 17:26:02 | ||||||
| @ | 
 | ||||||
| -} | -} | ||||||
| timelog :: Parser TimeLog | timelog :: Parser TimeLog | ||||||
| timelog = do | timelog = do | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user