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
|
||||
|
||||
|
||||
91
hledger.hs
91
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)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user