push some more stuff down into Parse, cleanups
This commit is contained in:
		
							parent
							
								
									8b117e1581
								
							
						
					
					
						commit
						6f83e902a8
					
				| @ -38,6 +38,9 @@ instance Show Ledger where | ||||
| -- 1. filter based on account/description patterns, if any | ||||
| -- 2. cache per-account info | ||||
| -- also, figure out the precision(s) to use | ||||
| cacheLedgerAndDo :: LedgerFile -> (Regex,Regex) -> (Ledger -> IO ()) -> IO () | ||||
| cacheLedgerAndDo l pats cmd = do cmd $ cacheLedger l pats | ||||
| 
 | ||||
| cacheLedger :: LedgerFile -> (Regex,Regex) -> Ledger | ||||
| cacheLedger l pats =  | ||||
|     let  | ||||
|  | ||||
							
								
								
									
										47
									
								
								Parse.hs
									
									
									
									
									
								
							
							
						
						
									
										47
									
								
								Parse.hs
									
									
									
									
									
								
							| @ -111,8 +111,33 @@ import System.IO | ||||
| 
 | ||||
| import Utils | ||||
| import Models | ||||
| import Options | ||||
| 
 | ||||
| 
 | ||||
| -- utils | ||||
| 
 | ||||
| -- | parse the user's specified ledger file and do some action with it | ||||
| -- (or report a parse error) | ||||
| parseLedgerAndDo :: [Flag] -> (Regex,Regex) -> (Ledger -> IO ()) -> IO () | ||||
| parseLedgerAndDo opts pats cmd = do | ||||
|     path <- ledgerFilePath opts | ||||
|     parsed <- parseLedgerFile path | ||||
|     case parsed of Left err -> parseError err | ||||
|                    Right l -> cacheLedgerAndDo l pats cmd | ||||
| 
 | ||||
| -- do some action with the ledger parse result, or report a parse error | ||||
| -- withParsedLedgerOrErrorDo :: (Either ParseError LedgerFile) -> (Regex,Regex) -> (Ledger -> IO ()) -> IO () | ||||
| -- withParsedLedgerOrErrorDo parsed pats cmd = do | ||||
| --   case parsed of Left err -> parseError err | ||||
| --                  Right l -> cacheLedgerAndDo l pats cmd | ||||
| 
 | ||||
| parseLedgerFile :: String -> IO (Either ParseError LedgerFile) | ||||
| parseLedgerFile "-" = fmap (parse ledgerfile "-") $ hGetContents stdin | ||||
| parseLedgerFile f   = parseFromFile ledgerfile f | ||||
|      | ||||
| parseError :: (Show a) => a -> IO () | ||||
| parseError e = do putStr "ledger parse error at "; print e | ||||
| 
 | ||||
| -- set up token parsing, though we're not yet using these much | ||||
| ledgerLanguageDef = LanguageDef { | ||||
|    commentStart   = "" | ||||
| @ -138,7 +163,7 @@ identifier = P.identifier lexer | ||||
| reserved   = P.reserved lexer | ||||
| reservedOp = P.reservedOp lexer | ||||
| 
 | ||||
| 
 | ||||
| -- parsers | ||||
| 
 | ||||
| ledgerfile :: Parser LedgerFile | ||||
| ledgerfile = ledger <|> ledgerfromtimelog | ||||
| @ -274,10 +299,11 @@ whiteSpace1 :: Parser () | ||||
| whiteSpace1 = do space; whiteSpace | ||||
| 
 | ||||
| 
 | ||||
| -- | timelog file parser | ||||
| {-  | ||||
| timelog grammar, from timeclock.el 2.6 | ||||
| {-| timelog file parser  | ||||
| 
 | ||||
| Here is the timelog grammar, from timeclock.el 2.6: | ||||
| 
 | ||||
| @ | ||||
| A timelog contains data in the form of a single entry per line. | ||||
| Each entry has the form: | ||||
| 
 | ||||
| @ -308,7 +334,7 @@ example: | ||||
| 
 | ||||
| i 2007/03/10 12:26:00 hledger | ||||
| o 2007/03/10 17:26:02 | ||||
| 
 | ||||
| @ | ||||
| -} | ||||
| 
 | ||||
| ledgerfromtimelog :: Parser LedgerFile | ||||
| @ -333,14 +359,3 @@ timelogentry = do | ||||
|   comment <- restofline | ||||
|   return $ TimeLogEntry code datetime comment | ||||
| 
 | ||||
| 
 | ||||
| 
 | ||||
| -- utils | ||||
| 
 | ||||
| parseError :: (Show a) => a -> IO () | ||||
| parseError e = do putStr "ledger parse error at "; print e | ||||
| 
 | ||||
| parseLedgerFile :: String -> IO (Either ParseError LedgerFile) | ||||
| parseLedgerFile "-" = fmap (parse ledgerfile "-") $ hGetContents stdin | ||||
| parseLedgerFile f   = parseFromFile ledgerfile f | ||||
|      | ||||
|  | ||||
							
								
								
									
										63
									
								
								hledger.hs
									
									
									
									
									
								
							
							
						
						
									
										63
									
								
								hledger.hs
									
									
									
									
									
								
							| @ -20,9 +20,9 @@ functions/methods. Here is the approximate module hierarchy: | ||||
| 
 | ||||
| @ | ||||
| hledger ("Main") | ||||
|  "Options" | ||||
|  "Tests" | ||||
|  "Parse" | ||||
|   "Options" | ||||
|   "Models" | ||||
|    "TimeLog" | ||||
|    "Ledger" | ||||
| @ -36,7 +36,7 @@ hledger ("Main") | ||||
|         "Currency" | ||||
|          "Types" | ||||
|           "Utils" | ||||
| @ | ||||
| 
 | ||||
| -} | ||||
| 
 | ||||
| module Main | ||||
| @ -65,20 +65,6 @@ main = do | ||||
|               | cmd `isPrefixOf` "balance"  = balance  opts pats | ||||
|               | otherwise                   = putStr usage | ||||
| 
 | ||||
| parseLedgerAndDo :: [Flag] -> (Regex,Regex) -> (Ledger -> IO ()) -> IO () | ||||
| parseLedgerAndDo opts pats cmd = do | ||||
|     path <- ledgerFilePath opts | ||||
|     parsed <- parseLedgerFile path | ||||
|     withParsedLedgerOrErrorDo parsed pats cmd | ||||
| 
 | ||||
| withParsedLedgerOrErrorDo :: (Either ParseError LedgerFile) -> (Regex,Regex) -> (Ledger -> IO ()) -> IO () | ||||
| withParsedLedgerOrErrorDo parsed pats cmd = do | ||||
|   case parsed of Left err -> parseError err | ||||
|                  Right l -> cacheLedgerAndDo l pats cmd | ||||
| 
 | ||||
| cacheLedgerAndDo :: LedgerFile -> (Regex,Regex) -> (Ledger -> IO ()) -> IO () | ||||
| cacheLedgerAndDo l pats cmd = do cmd $ cacheLedger l pats | ||||
| 
 | ||||
| type Command = [Flag] -> (Regex,Regex) -> IO () | ||||
| 
 | ||||
| selftest :: Command | ||||
| @ -116,31 +102,7 @@ balance opts pats = do | ||||
|                           ((wildcard,_), False) -> 1 | ||||
|                           otherwise  -> 9999 | ||||
| 
 | ||||
| -- helpers for interacting in ghci | ||||
| 
 | ||||
| -- | return a Ledger parsed from the file your LEDGER environment variable | ||||
| -- points to or (WARNING) an empty one if there was a problem. | ||||
| myledger :: IO Ledger | ||||
| myledger = do | ||||
|   parsed <- ledgerFilePath [] >>= parseLedgerFile | ||||
|   let ledgerfile = either (\_ -> LedgerFile [] [] [] "") id parsed | ||||
|   return $ cacheLedger ledgerfile (wildcard,wildcard) | ||||
| 
 | ||||
| -- | return a Ledger parsed from the given file path | ||||
| ledgerfromfile :: String -> IO Ledger | ||||
| ledgerfromfile f = do | ||||
|   parsed <- ledgerFilePath [File f] >>= parseLedgerFile | ||||
|   let ledgerfile = either (\_ -> LedgerFile [] [] [] "") id parsed | ||||
|   return $ cacheLedger ledgerfile (wildcard,wildcard) | ||||
| 
 | ||||
| accountnamed :: AccountName -> IO Account | ||||
| accountnamed a = myledger >>= (return . fromMaybe nullacct . Map.lookup a . accounts) | ||||
| 
 | ||||
| 
 | ||||
| --clearedBalanceToDate :: String -> Amount | ||||
| 
 | ||||
| {- | ||||
| ghci examples: | ||||
| {- helpers for interacting in ghci. Examples: | ||||
| 
 | ||||
| $ ghci hledger.hs | ||||
| GHCi, version 6.8.2: http://www.haskell.org/ghc/  :? for help | ||||
| @ -160,5 +122,22 @@ $ ghci hledger.hs | ||||
| > accounts l | ||||
| > accountnamed "assets" | ||||
| 
 | ||||
| 
 | ||||
| -} | ||||
| 
 | ||||
| -- | return a Ledger parsed from the file your LEDGER environment variable | ||||
| -- points to or (WARNING) an empty one if there was a problem. | ||||
| myledger :: IO Ledger | ||||
| myledger = do | ||||
|   parsed <- ledgerFilePath [] >>= parseLedgerFile | ||||
|   let ledgerfile = either (\_ -> LedgerFile [] [] [] "") id parsed | ||||
|   return $ cacheLedger ledgerfile (wildcard,wildcard) | ||||
| 
 | ||||
| -- | return a Ledger parsed from the given file path | ||||
| ledgerfromfile :: String -> IO Ledger | ||||
| ledgerfromfile f = do | ||||
|   parsed <- ledgerFilePath [File f] >>= parseLedgerFile | ||||
|   let ledgerfile = either (\_ -> LedgerFile [] [] [] "") id parsed | ||||
|   return $ cacheLedger ledgerfile (wildcard,wildcard) | ||||
| 
 | ||||
| accountnamed :: AccountName -> IO Account | ||||
| accountnamed a = myledger >>= (return . fromMaybe nullacct . Map.lookup a . accounts) | ||||
|  | ||||
		Loading…
	
		Reference in New Issue
	
	Block a user