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
|
-- 1. filter based on account/description patterns, if any
|
||||||
-- 2. cache per-account info
|
-- 2. cache per-account info
|
||||||
-- also, figure out the precision(s) to use
|
-- 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 :: LedgerFile -> (Regex,Regex) -> Ledger
|
||||||
cacheLedger l pats =
|
cacheLedger l pats =
|
||||||
let
|
let
|
||||||
|
|||||||
47
Parse.hs
47
Parse.hs
@ -111,8 +111,33 @@ import System.IO
|
|||||||
|
|
||||||
import Utils
|
import Utils
|
||||||
import Models
|
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
|
-- set up token parsing, though we're not yet using these much
|
||||||
ledgerLanguageDef = LanguageDef {
|
ledgerLanguageDef = LanguageDef {
|
||||||
commentStart = ""
|
commentStart = ""
|
||||||
@ -138,7 +163,7 @@ identifier = P.identifier lexer
|
|||||||
reserved = P.reserved lexer
|
reserved = P.reserved lexer
|
||||||
reservedOp = P.reservedOp lexer
|
reservedOp = P.reservedOp lexer
|
||||||
|
|
||||||
|
-- parsers
|
||||||
|
|
||||||
ledgerfile :: Parser LedgerFile
|
ledgerfile :: Parser LedgerFile
|
||||||
ledgerfile = ledger <|> ledgerfromtimelog
|
ledgerfile = ledger <|> ledgerfromtimelog
|
||||||
@ -274,10 +299,11 @@ whiteSpace1 :: Parser ()
|
|||||||
whiteSpace1 = do space; whiteSpace
|
whiteSpace1 = do space; whiteSpace
|
||||||
|
|
||||||
|
|
||||||
-- | timelog file parser
|
{-| timelog file parser
|
||||||
{-
|
|
||||||
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.
|
||||||
Each entry has the form:
|
Each entry has the form:
|
||||||
|
|
||||||
@ -308,7 +334,7 @@ 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
|
||||||
|
@
|
||||||
-}
|
-}
|
||||||
|
|
||||||
ledgerfromtimelog :: Parser LedgerFile
|
ledgerfromtimelog :: Parser LedgerFile
|
||||||
@ -333,14 +359,3 @@ timelogentry = do
|
|||||||
comment <- restofline
|
comment <- restofline
|
||||||
return $ TimeLogEntry code datetime comment
|
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")
|
hledger ("Main")
|
||||||
"Options"
|
|
||||||
"Tests"
|
"Tests"
|
||||||
"Parse"
|
"Parse"
|
||||||
|
"Options"
|
||||||
"Models"
|
"Models"
|
||||||
"TimeLog"
|
"TimeLog"
|
||||||
"Ledger"
|
"Ledger"
|
||||||
@ -36,7 +36,7 @@ hledger ("Main")
|
|||||||
"Currency"
|
"Currency"
|
||||||
"Types"
|
"Types"
|
||||||
"Utils"
|
"Utils"
|
||||||
@
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
module Main
|
module Main
|
||||||
@ -65,20 +65,6 @@ main = do
|
|||||||
| cmd `isPrefixOf` "balance" = balance opts pats
|
| cmd `isPrefixOf` "balance" = balance opts pats
|
||||||
| otherwise = putStr usage
|
| 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 ()
|
type Command = [Flag] -> (Regex,Regex) -> IO ()
|
||||||
|
|
||||||
selftest :: Command
|
selftest :: Command
|
||||||
@ -116,31 +102,7 @@ balance opts pats = do
|
|||||||
((wildcard,_), False) -> 1
|
((wildcard,_), False) -> 1
|
||||||
otherwise -> 9999
|
otherwise -> 9999
|
||||||
|
|
||||||
-- helpers for interacting in ghci
|
{- helpers for interacting in ghci. Examples:
|
||||||
|
|
||||||
-- | 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:
|
|
||||||
|
|
||||||
$ ghci hledger.hs
|
$ ghci hledger.hs
|
||||||
GHCi, version 6.8.2: http://www.haskell.org/ghc/ :? for help
|
GHCi, version 6.8.2: http://www.haskell.org/ghc/ :? for help
|
||||||
@ -160,5 +122,22 @@ $ ghci hledger.hs
|
|||||||
> accounts l
|
> accounts l
|
||||||
> accountnamed "assets"
|
> 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