From 6f83e902a8688653d839d2660a125445f4428818 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Wed, 1 Oct 2008 18:53:43 +0000 Subject: [PATCH] push some more stuff down into Parse, cleanups --- Ledger.hs | 3 ++ Parse.hs | 47 ++++++++++++++++++---------- hledger.hs | 91 +++++++++++++++++++++--------------------------------- 3 files changed, 69 insertions(+), 72 deletions(-) diff --git a/Ledger.hs b/Ledger.hs index d595a5305..af639f0d3 100644 --- a/Ledger.hs +++ b/Ledger.hs @@ -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 diff --git a/Parse.hs b/Parse.hs index 0e7d82788..8f2b70d3b 100644 --- a/Parse.hs +++ b/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 - diff --git a/hledger.hs b/hledger.hs index f3e8f99d2..5981aff27 100644 --- a/hledger.hs +++ b/hledger.hs @@ -20,23 +20,23 @@ functions/methods. Here is the approximate module hierarchy: @ hledger ("Main") - "Options" "Tests" - "Parse" - "Models" - "TimeLog" - "Ledger" - "Account" - "Transaction" - "LedgerFile" - "LedgerEntry" - "LedgerTransaction" - "AccountName" - "Amount" - "Currency" - "Types" - "Utils" -@ + "Parse" + "Options" + "Models" + "TimeLog" + "Ledger" + "Account" + "Transaction" + "LedgerFile" + "LedgerEntry" + "LedgerTransaction" + "AccountName" + "Amount" + "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)