mirror of
https://github.com/simonmichael/hledger.git
synced 2024-11-08 07:09:28 +03:00
big overhaul of options, support -f-, rudimentary timelog file handling
This commit is contained in:
parent
987659e3d4
commit
510d39095c
@ -4,7 +4,7 @@ module Models (
|
||||
module AccountName,
|
||||
module Transaction,
|
||||
module Entry,
|
||||
module TimeLogEntry,
|
||||
module TimeLog,
|
||||
module EntryTransaction,
|
||||
module Ledger,
|
||||
module Account
|
||||
@ -16,7 +16,7 @@ import BasicTypes
|
||||
import AccountName
|
||||
import Transaction
|
||||
import Entry
|
||||
import TimeLogEntry
|
||||
import TimeLog
|
||||
import EntryTransaction
|
||||
import Ledger
|
||||
import Account
|
||||
|
128
Options.hs
128
Options.hs
@ -1,86 +1,76 @@
|
||||
|
||||
module Options (module Options, usageInfo)
|
||||
module Options
|
||||
where
|
||||
import System.Console.GetOpt
|
||||
import System.Directory
|
||||
import System.Environment (getEnv)
|
||||
import Data.Maybe (fromMaybe)
|
||||
|
||||
import Utils
|
||||
|
||||
|
||||
usageHeader = "Usage: hledger [OPTIONS] register|balance [MATCHARGS]"
|
||||
|
||||
getOptions :: [String] -> IO ([Flag], [String])
|
||||
getOptions argv =
|
||||
case getOpt RequireOrder options argv of
|
||||
(o,n,[] ) -> return (o,n)
|
||||
(_,_,errs) -> ioError (userError (concat errs ++ usageInfo usageHeader options))
|
||||
usage = "Usage: hledger [OPTIONS] "++commands++" [ACCTPATTERNS] [-- DESCPATTERNS]\nOptions:"
|
||||
commands = "register|balance"
|
||||
defaultcmd = "register"
|
||||
ledgerFilePath = findFileFromOpts "~/ledger.dat" "LEDGER"
|
||||
|
||||
options :: [OptDescr Flag]
|
||||
options = [
|
||||
Option ['v'] ["version"] (NoArg Version) "show version number"
|
||||
, Option ['f'] ["file"] (OptArg readFileOpt "FILE") "ledger file, or - to read stdin"
|
||||
, Option ['s'] ["subtotal"] (NoArg ShowSubs) "balance: show sub-accounts" --; register: show subtotals"
|
||||
]
|
||||
Option ['f'] ["file"] (ReqArg File "FILE") "ledger file; - means use standard input",
|
||||
Option ['s'] ["showsubs"] (NoArg ShowSubs) "balance report: show subaccounts" -- register: show subtotals
|
||||
--Option ['V'] ["version"] (NoArg Version) "show version"
|
||||
]
|
||||
|
||||
data Flag = Version | File String | ShowSubs deriving (Show,Eq)
|
||||
|
||||
readFileOpt :: Maybe String -> Flag
|
||||
readFileOpt = File . fromMaybe "stdin"
|
||||
|
||||
getFile :: Flag -> String
|
||||
getFile (File s) = s
|
||||
getFile _ = []
|
||||
data Flag =
|
||||
File String |
|
||||
ShowSubs |
|
||||
Version
|
||||
deriving (Show,Eq)
|
||||
|
||||
getLedgerFilePath :: [Flag] -> IO String
|
||||
getLedgerFilePath opts = do
|
||||
defaultpath <- tildeExpand "~/ledger.dat"
|
||||
envordefault <- getEnv "LEDGER" `catch` \_ -> return defaultpath
|
||||
path <- tildeExpand envordefault
|
||||
return $ last $ [envordefault] ++ (filter (/= "") (map getFile opts))
|
||||
parseOptions :: [String] -> IO ([Flag], [String])
|
||||
parseOptions argv =
|
||||
case getOpt RequireOrder options argv of
|
||||
(opts,[],[]) -> return (opts, [defaultcmd])
|
||||
(opts,args,[]) -> return (opts, args)
|
||||
(_,_,errs) -> ioError (userError (concat errs ++ showusage))
|
||||
|
||||
-- ledger pattern args are a list of account patterns optionally followed
|
||||
-- by -- and a list of description patterns
|
||||
ledgerPatternArgs :: [String] -> ([String],[String])
|
||||
ledgerPatternArgs args =
|
||||
-- testoptions RequireOrder ["foo","-v"]
|
||||
-- testoptions Permute ["foo","-v"]
|
||||
-- testoptions (ReturnInOrder Arg) ["foo","-v"]
|
||||
-- testoptions Permute ["foo","--","-v"]
|
||||
-- testoptions Permute ["-?o","--name","bar","--na=baz"]
|
||||
-- testoptions Permute ["--ver","foo"]
|
||||
testoptions order cmdline = putStr $
|
||||
case getOpt order options cmdline of
|
||||
(o,n,[] ) -> "options=" ++ show o ++ " args=" ++ show n
|
||||
(_,_,errs) -> concat errs ++ showusage
|
||||
|
||||
showusage = usageInfo usage options
|
||||
|
||||
-- find a file path from options, an env var or a default value
|
||||
findFileFromOpts :: FilePath -> String -> [Flag] -> IO String
|
||||
findFileFromOpts defaultpath envvar opts = do
|
||||
envordefault <- getEnv envvar `catch` \_ -> return defaultpath
|
||||
paths <- mapM tildeExpand $ [envordefault] ++ (concatMap getfile opts)
|
||||
return $ last paths
|
||||
where
|
||||
getfile (File s) = [s]
|
||||
getfile _ = []
|
||||
|
||||
tildeExpand :: FilePath -> IO FilePath
|
||||
tildeExpand ('~':[]) = getHomeDirectory
|
||||
tildeExpand ('~':'/':xs) = getHomeDirectory >>= return . (++ ('/':xs))
|
||||
-- -- ~name, requires -fvia-C or ghc 6.8
|
||||
-- --import System.Posix.User
|
||||
-- -- tildeExpand ('~':xs) = do let (user, path) = span (/= '/') xs
|
||||
-- -- pw <- getUserEntryForName user
|
||||
-- -- return (homeDirectory pw ++ path)
|
||||
tildeExpand xs = return xs
|
||||
-- -- courtesy of allberry_b
|
||||
|
||||
-- ledger pattern args are 0 or more account patterns optionally followed
|
||||
-- by -- and 0 or more description patterns
|
||||
parseLedgerPatternArgs :: [String] -> ([String],[String])
|
||||
parseLedgerPatternArgs args =
|
||||
case "--" `elem` args of
|
||||
True -> ((takeWhile (/= "--") args), tail $ (dropWhile (/= "--") args))
|
||||
False -> (args,[])
|
||||
|
||||
getDepth :: [Flag] -> Int
|
||||
getDepth opts =
|
||||
maximum $ [1] ++ map depthval opts where
|
||||
depthval (ShowSubs) = 9999
|
||||
depthval _ = 1
|
||||
|
||||
|
||||
-- example:
|
||||
-- module Opts where
|
||||
|
||||
-- import System.Console.GetOpt
|
||||
-- import Data.Maybe ( fromMaybe )
|
||||
|
||||
-- data Flag
|
||||
-- = Verbose | Version
|
||||
-- | Input String | Output String | LibDir String
|
||||
-- deriving Show
|
||||
|
||||
-- options :: [OptDescr Flag]
|
||||
-- options =
|
||||
-- [ Option ['v'] ["verbose"] (NoArg Verbose) "chatty output on stderr"
|
||||
-- , Option ['V','?'] ["version"] (NoArg Version) "show version number"
|
||||
-- , Option ['o'] ["output"] (OptArg outp "FILE") "output FILE"
|
||||
-- , Option ['c'] [] (OptArg inp "FILE") "input FILE"
|
||||
-- , Option ['L'] ["libdir"] (ReqArg LibDir "DIR") "library directory"
|
||||
-- ]
|
||||
|
||||
-- inp,outp :: Maybe String -> Flag
|
||||
-- outp = Output . fromMaybe "stdout"
|
||||
-- inp = Input . fromMaybe "stdin"
|
||||
|
||||
-- compilerOpts :: [String] -> IO ([Flag], [String])
|
||||
-- compilerOpts argv =
|
||||
-- case getOpt Permute options argv of
|
||||
-- (o,n,[] ) -> return (o,n)
|
||||
-- (_,_,errs) -> ioError (userError (concat errs ++ usageInfo header options))
|
||||
-- where header = "Usage: ic [OPTION...] files..."
|
||||
|
78
Parse.hs
78
Parse.hs
@ -1,14 +1,46 @@
|
||||
|
||||
module 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 Utils
|
||||
import Models
|
||||
|
||||
|
||||
-- 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
|
||||
|
||||
|
||||
ledgerfile :: Parser Ledger
|
||||
ledgerfile = ledger <|> ledgerfromtimelog
|
||||
|
||||
|
||||
-- standard ledger file parser
|
||||
{-
|
||||
Here's the ledger 2.5 grammar:
|
||||
"The ledger file format is quite simple, but also very flexible. It supports
|
||||
@ -109,33 +141,6 @@ i, o, b, h
|
||||
-- parsec example: http://pandoc.googlecode.com/svn/trunk/src/Text/Pandoc/Readers/RST.hs
|
||||
-- sample data in Tests.hs
|
||||
|
||||
-- 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
|
||||
|
||||
-- ledger file parsers
|
||||
|
||||
ledger :: Parser Ledger
|
||||
ledger = do
|
||||
ledgernondatalines
|
||||
@ -245,6 +250,7 @@ whiteSpace1 :: Parser ()
|
||||
whiteSpace1 = do space; whiteSpace
|
||||
|
||||
|
||||
-- timelog file parser
|
||||
{-
|
||||
timelog grammar, from timeclock.el 2.6
|
||||
|
||||
@ -281,7 +287,16 @@ o 2007/03/10 17:26:02
|
||||
|
||||
-}
|
||||
|
||||
-- timelog file parsers
|
||||
ledgerfromtimelog :: Parser Ledger
|
||||
ledgerfromtimelog = do
|
||||
tl <- timelog
|
||||
return $ ledgerFromTimeLog tl
|
||||
|
||||
timelog :: Parser TimeLog
|
||||
timelog = do
|
||||
entries <- many timelogentry
|
||||
eof
|
||||
return $ TimeLog entries
|
||||
|
||||
timelogentry :: Parser TimeLogEntry
|
||||
timelogentry = do
|
||||
@ -306,5 +321,6 @@ printParseResult r = case r of Left e -> parseError e
|
||||
Right v -> print v
|
||||
|
||||
parseLedgerFile :: String -> IO (Either ParseError Ledger)
|
||||
parseLedgerFile f = parseFromFile ledger f
|
||||
|
||||
parseLedgerFile "-" = fmap (parse ledgerfile "-") $ hGetContents stdin
|
||||
parseLedgerFile f = parseFromFile ledgerfile f
|
||||
|
||||
|
7
TODO
7
TODO
@ -1,7 +1,10 @@
|
||||
feature: read timelog files
|
||||
timelog parser
|
||||
convert timelog entries to ledger entries
|
||||
read whole file
|
||||
handle time amounts
|
||||
fix arithmetic
|
||||
calculate time intervals
|
||||
find datetime type
|
||||
auto-generate missing clock-out
|
||||
|
||||
optimization: add CookedLedger caching txns etc.
|
||||
profile again
|
||||
|
29
Tests.hs
29
Tests.hs
@ -225,12 +225,19 @@ ledger7 = Ledger
|
||||
]
|
||||
|
||||
timelogentry1_str = "i 2007/03/11 16:19:00 hledger\n"
|
||||
timelogentry2_str = "o 2007/03/11 16:30:00\n"
|
||||
|
||||
timelogentry1 = TimeLogEntry 'i' "2007/03/11 16:19:00" "hledger"
|
||||
|
||||
timelogentry2_str = "o 2007/03/11 16:30:00\n"
|
||||
timelogentry2 = TimeLogEntry 'o' "2007/03/11 16:30:00" ""
|
||||
|
||||
|
||||
timelog1_str = concat [
|
||||
timelogentry1_str,
|
||||
timelogentry2_str
|
||||
]
|
||||
timelog1 = TimeLog [
|
||||
timelogentry1,
|
||||
timelogentry2
|
||||
]
|
||||
|
||||
|
||||
-- utils
|
||||
@ -304,14 +311,16 @@ props =
|
||||
"expenses:phone","expenses:vacation","liabilities","liabilities:credit cards",
|
||||
"liabilities:credit cards:discover"]
|
||||
,
|
||||
ledgerPatternArgs [] == ([],[])
|
||||
,ledgerPatternArgs ["a"] == (["a"],[])
|
||||
,ledgerPatternArgs ["a","b"] == (["a","b"],[])
|
||||
,ledgerPatternArgs ["a","b","--"] == (["a","b"],[])
|
||||
,ledgerPatternArgs ["a","b","--","c","b"] == (["a","b"],["c","b"])
|
||||
,ledgerPatternArgs ["--","c"] == ([],["c"])
|
||||
,ledgerPatternArgs ["--"] == ([],[])
|
||||
parseLedgerPatternArgs [] == ([],[])
|
||||
,parseLedgerPatternArgs ["a"] == (["a"],[])
|
||||
,parseLedgerPatternArgs ["a","b"] == (["a","b"],[])
|
||||
,parseLedgerPatternArgs ["a","b","--"] == (["a","b"],[])
|
||||
,parseLedgerPatternArgs ["a","b","--","c","b"] == (["a","b"],["c","b"])
|
||||
,parseLedgerPatternArgs ["--","c"] == ([],["c"])
|
||||
,parseLedgerPatternArgs ["--"] == ([],[])
|
||||
,parse' timelogentry timelogentry1_str `parseEquals` timelogentry1
|
||||
,parse' timelogentry timelogentry2_str `parseEquals` timelogentry2
|
||||
,parse' timelog timelog1_str `parseEquals` timelog1
|
||||
]
|
||||
|
||||
|
||||
|
59
TimeLog.hs
Normal file
59
TimeLog.hs
Normal file
@ -0,0 +1,59 @@
|
||||
module TimeLog
|
||||
where
|
||||
import Utils
|
||||
import BasicTypes
|
||||
import Transaction
|
||||
import Entry
|
||||
import Ledger
|
||||
|
||||
data TimeLogEntry = TimeLogEntry {
|
||||
tcode :: Char,
|
||||
tdatetime :: DateTime,
|
||||
tcomment :: String
|
||||
} deriving (Eq,Ord)
|
||||
|
||||
instance Show TimeLogEntry where
|
||||
show t = printf "%s %s %s" (show $ tcode t) (tdatetime t) (tcomment t)
|
||||
|
||||
data TimeLog = TimeLog {
|
||||
timelog_entries :: [TimeLogEntry]
|
||||
} deriving (Eq)
|
||||
|
||||
instance Show TimeLog where
|
||||
show tl = printf "TimeLog with %d entries" $ length $ timelog_entries tl
|
||||
|
||||
ledgerFromTimeLog :: TimeLog -> Ledger
|
||||
ledgerFromTimeLog tl =
|
||||
Ledger [] [] (entriesFromTimeLogEntries $ timelog_entries tl)
|
||||
|
||||
entriesFromTimeLogEntries :: [TimeLogEntry] -> [Entry]
|
||||
|
||||
entriesFromTimeLogEntries [clockin] =
|
||||
entriesFromTimeLogEntries [clockin, clockoutNowEntry]
|
||||
|
||||
entriesFromTimeLogEntries [clockin,clockout] =
|
||||
[
|
||||
Entry {
|
||||
edate = indate,
|
||||
estatus = True,
|
||||
ecode = "",
|
||||
edescription = accountname,
|
||||
etransactions = [
|
||||
Transaction accountname amount,
|
||||
Transaction "TIME" (-amount)
|
||||
]}
|
||||
]
|
||||
where
|
||||
accountname = (tcomment clockin)
|
||||
intime = tdatetime clockin
|
||||
indate = dateFrom $ tdatetime clockin
|
||||
outtime = tdatetime clockout
|
||||
amount = timeAmount $ 0 -- read $ outtime - intime
|
||||
|
||||
entriesFromTimeLogEntries many =
|
||||
(entriesFromTimeLogEntries $ take 2 many) ++
|
||||
(entriesFromTimeLogEntries $ drop 2 many)
|
||||
|
||||
clockoutNowEntry = TimeLogEntry ' ' "" ""
|
||||
timeAmount = Amount "h"
|
||||
dateFrom = id
|
12
Utils.hs
12
Utils.hs
@ -8,7 +8,6 @@ module Utils (
|
||||
quickCheck,
|
||||
)
|
||||
where
|
||||
import System.Directory
|
||||
import Data.List
|
||||
import Data.Tree
|
||||
import Debug.Trace
|
||||
@ -25,17 +24,6 @@ splitAtElement e l =
|
||||
where
|
||||
(first,rest) = break (e==) l'
|
||||
|
||||
-- courtesy of allberry_b
|
||||
tildeExpand :: FilePath -> IO FilePath
|
||||
tildeExpand ('~':[]) = getHomeDirectory
|
||||
tildeExpand ('~':'/':xs) = getHomeDirectory >>= return . (++ ('/':xs))
|
||||
-- ~name, requires -fvia-C or ghc 6.8
|
||||
--import System.Posix.User
|
||||
-- tildeExpand ('~':xs) = do let (user, path) = span (/= '/') xs
|
||||
-- pw <- getUserEntryForName user
|
||||
-- return (homeDirectory pw ++ path)
|
||||
tildeExpand xs = return xs
|
||||
|
||||
|
||||
-- tree tools
|
||||
|
||||
|
84
hledger.hs
84
hledger.hs
@ -11,6 +11,8 @@ hledger
|
||||
Tests
|
||||
Parse
|
||||
Models
|
||||
TimeLog
|
||||
TimeLogEntry
|
||||
Account
|
||||
Ledger
|
||||
EntryTransaction
|
||||
@ -22,7 +24,6 @@ hledger
|
||||
|
||||
-}
|
||||
|
||||
-- application logic & most IO
|
||||
module Main
|
||||
where
|
||||
import System
|
||||
@ -38,21 +39,43 @@ import Parse
|
||||
import Tests
|
||||
import Utils
|
||||
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
(opts, args) <- (getArgs >>= getOptions)
|
||||
if args == []
|
||||
then register [] []
|
||||
else
|
||||
let (command, args') = (head args, tail args) in
|
||||
if "reg" `isPrefixOf` command then (register opts args')
|
||||
else if "bal" `isPrefixOf` command then balance opts args'
|
||||
else if "test" `isPrefixOf` command then test
|
||||
else putStr $ usageInfo usageHeader options
|
||||
(opts, (cmd:args)) <- getArgs >>= parseOptions
|
||||
run cmd opts args
|
||||
where run cmd opts args
|
||||
| cmd `isPrefixOf` "register" = register opts args
|
||||
| cmd `isPrefixOf` "balance" = balance opts args
|
||||
| cmd `isPrefixOf` "test" = test
|
||||
| otherwise = putStr showusage
|
||||
|
||||
-- commands
|
||||
|
||||
test :: IO ()
|
||||
register :: [Flag] -> [String] -> IO ()
|
||||
register opts args = do
|
||||
doWithLedger opts $ printRegister
|
||||
where
|
||||
printRegister ledger =
|
||||
putStr $ showTransactionsWithBalances
|
||||
(ledgerTransactionsMatching (acctpats,descpats) ledger)
|
||||
0
|
||||
where (acctpats,descpats) = parseLedgerPatternArgs args
|
||||
|
||||
balance :: [Flag] -> [String] -> IO ()
|
||||
balance opts args = do
|
||||
doWithLedger opts $ printBalance
|
||||
where
|
||||
printBalance ledger =
|
||||
putStr $ showLedgerAccounts ledger acctpats showsubs maxdepth
|
||||
where
|
||||
(acctpats,_) = parseLedgerPatternArgs args
|
||||
showsubs = (ShowSubs `elem` opts)
|
||||
maxdepth = case (acctpats, showsubs) of
|
||||
([],False) -> 1
|
||||
otherwise -> 9999
|
||||
|
||||
test :: IO ()
|
||||
test = do
|
||||
hcounts <- runTestTT tests
|
||||
qcounts <- mapM quickCheck props
|
||||
@ -60,45 +83,20 @@ test = do
|
||||
where showHunitCounts c =
|
||||
reverse $ tail $ reverse ("passed " ++ (unwords $ drop 5 $ words (show c)))
|
||||
|
||||
register :: [Flag] -> [String] -> IO ()
|
||||
register opts args = do
|
||||
getLedgerFilePath opts >>= parseLedgerFile >>= doWithParsed (printRegister opts args)
|
||||
|
||||
balance :: [Flag] -> [String] -> IO ()
|
||||
balance opts args = do
|
||||
getLedgerFilePath opts >>= parseLedgerFile >>= doWithParsed (printBalance opts args)
|
||||
|
||||
-- utils
|
||||
|
||||
-- doWithLedgerFile =
|
||||
-- getLedgerFilePath >>= parseLedgerFile >>= doWithParsed
|
||||
doWithLedger :: [Flag] -> (Ledger -> IO ()) -> IO ()
|
||||
doWithLedger opts cmd = do
|
||||
ledgerFilePath opts >>= parseLedgerFile >>= doWithParsed cmd
|
||||
|
||||
doWithParsed :: Show a => (a -> IO ()) -> (Either ParseError a) -> IO ()
|
||||
doWithParsed a p = do
|
||||
case p of Left e -> parseError e
|
||||
Right v -> a v
|
||||
|
||||
printRegister :: [Flag] -> [String] -> Ledger -> IO ()
|
||||
printRegister opts args ledger = do
|
||||
putStr $ showTransactionsWithBalances
|
||||
(ledgerTransactionsMatching (acctpats,descpats) ledger)
|
||||
0
|
||||
where (acctpats,descpats) = ledgerPatternArgs args
|
||||
|
||||
printBalance :: [Flag] -> [String] -> Ledger -> IO ()
|
||||
printBalance opts args ledger = do
|
||||
putStr $ showLedgerAccounts ledger acctpats showsubs maxdepth
|
||||
where
|
||||
(acctpats,_) = ledgerPatternArgs args
|
||||
showsubs = (ShowSubs `elem` opts)
|
||||
maxdepth = case (acctpats, showsubs) of
|
||||
([],False) -> 1
|
||||
otherwise -> 9999
|
||||
|
||||
doWithParsed action parsed = do
|
||||
case parsed of Left e -> parseError e
|
||||
Right l -> action l
|
||||
|
||||
-- interactive testing:
|
||||
--
|
||||
-- p <- getLedgerFilePath [] >>= parseLedgerFile
|
||||
-- p <- ledgerFilePath [] >>= parseLedgerFile
|
||||
-- let l = either (\_ -> Ledger [] [] []) id p
|
||||
-- let ant = ledgerAccountNameTree l
|
||||
-- let at = ledgerAccountTreeMatching l [] True 999
|
||||
|
Loading…
Reference in New Issue
Block a user