slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

big refactoring, do filtering afresh in each command

Browse Source 
We now do data filtering/massage as late as possible, not just once at
startup. This should work better for multiple commands, as with web or ui.
The basic benchmark seems at least as good as before thanks to laziness.
This commit is contained in:
Simon Michael 2009-12-21 05:23:07 +00:00
parent 7bd14a367a
commit a2b8faa4d6
17 changed files with 418 additions and 288 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
Commands/Add.hs
View File

@ -154,8 +154,9 @@ appendToLedgerFile l s =
registerFromString :: String -> IO String registerFromString :: String -> IO String
registerFromString s = do registerFromString s = do
now <- getCurrentLocalTime now <- getCurrentLocalTime
l <- ledgerFromStringWithOpts [] [] now s l <- ledgerFromStringWithOpts [] s
return $ showRegisterReport [Empty] [] l return $ showRegisterReport opts (optsToFilterSpec opts [] now) l
where opts = [Empty]
-- | Return a similarity measure, from 0 to 1, for two strings. -- | Return a similarity measure, from 0 to 1, for two strings.
-- This is Simon White's letter pairs algorithm from -- This is Simon White's letter pairs algorithm from

22
Commands/Balance.hs
View File

@ -102,6 +102,7 @@ import Ledger.Types
import Ledger.Amount import Ledger.Amount
import Ledger.AccountName import Ledger.AccountName
import Ledger.Posting import Ledger.Posting
import Ledger.Journal
import Ledger.Ledger import Ledger.Ledger
import Options import Options
import System.IO.UTF8 import System.IO.UTF8
@ -109,23 +110,28 @@ import System.IO.UTF8
-- | Print a balance report. -- | Print a balance report.
balance :: [Opt] -> [String] -> Ledger -> IO () balance :: [Opt] -> [String] -> Ledger -> IO ()
balance opts args = putStr . showBalanceReport opts args balance opts args l = do
t <- getCurrentLocalTime
putStr $ showBalanceReport opts (optsToFilterSpec opts args t) l
-- | Generate a balance report with the specified options for this ledger. -- | Generate a balance report with the specified options for this ledger.
showBalanceReport :: [Opt] -> [String] -> Ledger -> String showBalanceReport :: [Opt] -> FilterSpec -> Ledger -> String
showBalanceReport opts _ l = acctsstr ++ totalstr showBalanceReport opts filterspec l@Ledger{journal=j} = acctsstr ++ totalstr
where where
l' = l{journal=j',accountnametree=ant,accountmap=amap} -- like cacheLedger
where (ant, amap) = crunchJournal j'
j' = filterJournalPostings filterspec{depth=Nothing} j
acctsstr = unlines $ map showacct interestingaccts acctsstr = unlines $ map showacct interestingaccts
where where
showacct = showInterestingAccount l interestingaccts showacct = showInterestingAccount l' interestingaccts
interestingaccts = filter (isInteresting opts l) acctnames interestingaccts = filter (isInteresting opts l') acctnames
acctnames = sort $ tail $ flatten $ treemap aname accttree acctnames = sort $ tail $ flatten $ treemap aname accttree
accttree = ledgerAccountTree (depthFromOpts opts) l accttree = ledgerAccountTree (fromMaybe 99999 $ depthFromOpts opts) l'
totalstr | NoTotal `elem` opts = "" totalstr | NoTotal `elem` opts = ""
| notElem Empty opts && isZeroMixedAmount total = "" | notElem Empty opts && isZeroMixedAmount total = ""
| otherwise = printf "--------------------\n%s\n" $ padleft 20 $ showMixedAmountWithoutPrice total | otherwise = printf "--------------------\n%s\n" $ padleft 20 $ showMixedAmountWithoutPrice total
where where
total = sum $ map abalance $ ledgerTopAccounts l total = sum $ map abalance $ ledgerTopAccounts l'
-- | Display one line of the balance report with appropriate indenting and eliding. -- | Display one line of the balance report with appropriate indenting and eliding.
showInterestingAccount :: Ledger -> [AccountName] -> AccountName -> String showInterestingAccount :: Ledger -> [AccountName] -> AccountName -> String
@ -147,7 +153,7 @@ isInteresting opts l a
| numinterestingsubs==1 && not atmaxdepth = notlikesub | numinterestingsubs==1 && not atmaxdepth = notlikesub
| otherwise = notzero || emptyflag | otherwise = notzero || emptyflag
where where
atmaxdepth = accountNameLevel a == depthFromOpts opts atmaxdepth = isJust d && Just (accountNameLevel a) == d where d = depthFromOpts opts
emptyflag = Empty `elem` opts emptyflag = Empty `elem` opts
acct = ledgerAccount l a acct = ledgerAccount l a
notzero = not $ isZeroMixedAmount inclbalance where inclbalance = abalance acct notzero = not $ isZeroMixedAmount inclbalance where inclbalance = abalance acct

12
Commands/Histogram.hs
View File

@ -17,10 +17,12 @@ barchar = '*'
-- | Print a histogram of some statistic per reporting interval, such as -- | Print a histogram of some statistic per reporting interval, such as
-- number of postings per day. -- number of postings per day.
histogram :: [Opt] -> [String] -> Ledger -> IO () histogram :: [Opt] -> [String] -> Ledger -> IO ()
histogram opts args = putStr . showHistogram opts args histogram opts args l = do
t <- getCurrentLocalTime
putStr $ showHistogram opts (optsToFilterSpec opts args t) l
showHistogram :: [Opt] -> [String] -> Ledger -> String showHistogram :: [Opt] -> FilterSpec -> Ledger -> String
showHistogram opts args l = concatMap (printDayWith countBar) dayps showHistogram opts filterspec l = concatMap (printDayWith countBar) dayps
where where
i = intervalFromOpts opts i = intervalFromOpts opts
interval | i == NoInterval = Daily interval | i == NoInterval = Daily
@ -35,10 +37,10 @@ showHistogram opts args l = concatMap (printDayWith countBar) dayps
| Empty `elem` opts = id | Empty `elem` opts = id
| otherwise = filter (not . isZeroMixedAmount . pamount) | otherwise = filter (not . isZeroMixedAmount . pamount)
matchapats = matchpats apats . paccount matchapats = matchpats apats . paccount
(apats,_) = parsePatternArgs args apats = acctpats filterspec
filterdepth | interval == NoInterval = filter (\p -> accountNameLevel (paccount p) <= depth) filterdepth | interval == NoInterval = filter (\p -> accountNameLevel (paccount p) <= depth)
| otherwise = id | otherwise = id
depth = depthFromOpts opts depth = fromMaybe 99999 $ depthFromOpts opts
printDayWith f (DateSpan b _, ts) = printf "%s %s\n" (show $ fromJust b) (f ts) printDayWith f (DateSpan b _, ts) = printf "%s %s\n" (show $ fromJust b) (f ts)

21
Commands/Print.hs
View File

@ -14,16 +14,13 @@ import System.IO.UTF8
-- | Print ledger transactions in standard format. -- | Print ledger transactions in standard format.
print' :: [Opt] -> [String] -> Ledger -> IO () print' :: [Opt] -> [String] -> Ledger -> IO ()
print' opts args = putStr . showTransactions opts args print' opts args l = do
t <- getCurrentLocalTime
putStr $ showTransactions (optsToFilterSpec opts args t) l
showTransactions :: [Opt] -> [String] -> Ledger -> String showTransactions :: FilterSpec -> Ledger -> String
showTransactions opts args l = concatMap (showTransactionForPrint effective) txns showTransactions filterspec l =
where concatMap (showTransactionForPrint effective) $ sortBy (comparing tdate) txns
txns = sortBy (comparing tdate) $ where
jtxns $ effective = EffectiveDate == whichdate filterspec
filterJournalPostingsByDepth depth $ txns = jtxns $ filterJournalTransactions filterspec $ journal l
filterJournalPostingsByAccount apats $
journal l
depth = depthFromOpts opts
effective = Effective `elem` opts
(apats,_) = parsePatternArgs args

84
Commands/Register.hs
View File

@ -14,44 +14,33 @@ import System.IO.UTF8
-- | Print a register report. -- | Print a register report.
register :: [Opt] -> [String] -> Ledger -> IO () register :: [Opt] -> [String] -> Ledger -> IO ()
register opts args = putStr . showRegisterReport opts args register opts args l = do
t <- getCurrentLocalTime
putStr $ showRegisterReport opts (optsToFilterSpec opts args t) l
{- | -- | Generate the register report, which is a list of postings with transaction
Generate the register report. Each ledger entry is displayed as two or -- info and a running balance.
more lines like this: showRegisterReport :: [Opt] -> FilterSpec -> Ledger -> String
showRegisterReport opts filterspec l
@ | interval == NoInterval = showpostings displayedps nullposting startbal
date (10) description (20) account (22) amount (11) balance (12) | otherwise = showpostings summaryps nullposting startbal
DDDDDDDDDD dddddddddddddddddddd aaaaaaaaaaaaaaaaaaaaaa AAAAAAAAAAA AAAAAAAAAAAA
aaaaaaaaaaaaaaaaaaaaaa AAAAAAAAAAA AAAAAAAAAAAA
... ... ...
@
-}
showRegisterReport :: [Opt] -> [String] -> Ledger -> String
showRegisterReport opts args l
| interval == NoInterval = showps displayedps nullposting startbal
| otherwise = showps summaryps nullposting startbal
where where
interval = intervalFromOpts opts
ps = sortBy (comparing postingDate) $ filterempties $ filterPostings apats $ filterdepth $ ledgerPostings l
filterdepth | interval == NoInterval = filter (\p -> accountNameLevel (paccount p) <= depth)
| otherwise = id
filterempties
| Empty `elem` opts = id
| otherwise = filter (not . isZeroMixedAmount . pamount)
(precedingps, ps') = break (matchdisplayopt dopt) ps
(displayedps, _) = span (matchdisplayopt dopt) ps'
startbal = sumPostings precedingps startbal = sumPostings precedingps
(apats,_) = parsePatternArgs args (displayedps, _) = span displayExprMatches restofps
matchdisplayopt Nothing _ = True (precedingps, restofps) = break displayExprMatches sortedps
matchdisplayopt (Just e) p = (fromparse $ parsewith datedisplayexpr e) p sortedps = sortBy (comparing postingDate) ps
dopt = displayFromOpts opts ps = journalPostings $ filterJournalPostings filterspec $ journal l
empty = Empty `elem` opts
depth = depthFromOpts opts
summaryps = concatMap summarisespan spans summaryps = concatMap summarisespan spans
summarisespan s = summarisePostingsInDateSpan s depth empty (postingsinspan s) summarisespan s = summarisePostingsInDateSpan s depth empty (postingsinspan s)
postingsinspan s = filter (isPostingInDateSpan s) displayedps postingsinspan s = filter (isPostingInDateSpan s) displayedps
spans = splitSpan interval (ledgerDateSpan l) spans = splitSpan interval (ledgerDateSpan l)
interval = intervalFromOpts opts
empty = Empty `elem` opts
depth = depthFromOpts opts
dispexpr = displayExprFromOpts opts
displayExprMatches p = case dispexpr of
Nothing -> True
Just e -> (fromparse $ parsewith datedisplayexpr e) p
-- | Given a date span (representing a reporting interval) and a list of -- | Given a date span (representing a reporting interval) and a list of
-- postings within it: aggregate the postings so there is only one per -- postings within it: aggregate the postings so there is only one per
@ -66,7 +55,7 @@ showRegisterReport opts args l
-- --
-- The showempty flag forces the display of a zero-posting span -- The showempty flag forces the display of a zero-posting span
-- and also zero-posting accounts within the span. -- and also zero-posting accounts within the span.
summarisePostingsInDateSpan :: DateSpan -> Int -> Bool -> [Posting] -> [Posting] summarisePostingsInDateSpan :: DateSpan -> Maybe Int -> Bool -> [Posting] -> [Posting]
summarisePostingsInDateSpan (DateSpan b e) depth showempty ps summarisePostingsInDateSpan (DateSpan b e) depth showempty ps
| null ps && showempty = [p] | null ps && showempty = [p]
| null ps = [] | null ps = []
@ -82,29 +71,34 @@ summarisePostingsInDateSpan (DateSpan b e) depth showempty ps
anames = sort $ nub $ map paccount ps anames = sort $ nub $ map paccount ps
-- aggregate balances by account, like cacheLedger, then do depth-clipping -- aggregate balances by account, like cacheLedger, then do depth-clipping
(_,_,exclbalof,inclbalof) = groupPostings ps (_,_,exclbalof,inclbalof) = groupPostings ps
clippedanames = clipAccountNames depth anames clippedanames = nub $ map (clipAccountName d) anames
isclipped a = accountNameLevel a >= depth isclipped a = accountNameLevel a >= d
d = fromMaybe 99999 $ depth
balancetoshowfor a = balancetoshowfor a =
(if isclipped a then inclbalof else exclbalof) (if null a then "top" else a) (if isclipped a then inclbalof else exclbalof) (if null a then "top" else a)
summaryps = [p{paccount=a,pamount=balancetoshowfor a} | a <- clippedanames] summaryps = [p{paccount=a,pamount=balancetoshowfor a} | a <- clippedanames]
clipAccountNames :: Int -> [AccountName] -> [AccountName] {- |
clipAccountNames d as = nub $ map (clip d) as Show postings one per line, plus transaction info for the first posting of
where clip d = accountNameFromComponents . take d . accountNameComponents each transaction, and a running balance. Eg:
-- | Show postings one per line, along with transaction info for the first @
-- posting of each transaction, and a running balance. date (10) description (20) account (22) amount (11) balance (12)
showps :: [Posting] -> Posting -> MixedAmount -> String DDDDDDDDDD dddddddddddddddddddd aaaaaaaaaaaaaaaaaaaaaa AAAAAAAAAAA AAAAAAAAAAAA
showps [] _ _ = "" aaaaaaaaaaaaaaaaaaaaaa AAAAAAAAAAA AAAAAAAAAAAA
showps (p:ps) pprev bal = this ++ showps ps p bal' @
-}
showpostings :: [Posting] -> Posting -> MixedAmount -> String
showpostings [] _ _ = ""
showpostings (p:ps) pprev bal = this ++ showpostings ps p bal'
where where
this = showp isfirst p bal' this = showposting isfirst p bal'
isfirst = ptransaction p /= ptransaction pprev isfirst = ptransaction p /= ptransaction pprev
bal' = bal + pamount p bal' = bal + pamount p
-- | Show one posting and running balance, with or without transaction info. -- | Show one posting and running balance, with or without transaction info.
showp :: Bool -> Posting -> MixedAmount -> String showposting :: Bool -> Posting -> MixedAmount -> String
showp withtxninfo p b = concatBottomPadded [txninfo ++ pstr ++ " ", bal] ++ "\n" showposting withtxninfo p b = concatBottomPadded [txninfo ++ pstr ++ " ", bal] ++ "\n"
where where
ledger3ishlayout = False ledger3ishlayout = False
datedescwidth = if ledger3ishlayout then 34 else 32 datedescwidth = if ledger3ishlayout then 34 else 32

52
Commands/UI.hs
View File

@ -52,7 +52,8 @@ ui opts args l = do
v <- mkVty v <- mkVty
DisplayRegion w h <- display_bounds $ terminal v DisplayRegion w h <- display_bounds $ terminal v
let opts' = SubTotal:opts let opts' = SubTotal:opts
let a = enter BalanceScreen t <- getCurrentLocalTime
let a = enter t BalanceScreen
AppState { AppState {
av=v av=v
,aw=fromIntegral w ,aw=fromIntegral w
@ -71,15 +72,16 @@ go :: AppState -> IO ()
go a@AppState{av=av,aopts=opts} = do go a@AppState{av=av,aopts=opts} = do
when (notElem DebugNoUI opts) $ update av (renderScreen a) when (notElem DebugNoUI opts) $ update av (renderScreen a)
k <- next_event av k <- next_event av
t <- getCurrentLocalTime
case k of case k of
EvResize x y -> go $ resize x y a EvResize x y -> go $ resize x y a
EvKey (KASCII 'l') [MCtrl] -> refresh av >> go a{amsg=helpmsg} EvKey (KASCII 'l') [MCtrl] -> refresh av >> go a{amsg=helpmsg}
EvKey (KASCII 'b') [] -> go $ resetTrailAndEnter BalanceScreen a EvKey (KASCII 'b') [] -> go $ resetTrailAndEnter t BalanceScreen a
EvKey (KASCII 'r') [] -> go $ resetTrailAndEnter RegisterScreen a EvKey (KASCII 'r') [] -> go $ resetTrailAndEnter t RegisterScreen a
EvKey (KASCII 'p') [] -> go $ resetTrailAndEnter PrintScreen a EvKey (KASCII 'p') [] -> go $ resetTrailAndEnter t PrintScreen a
EvKey KRight [] -> go $ drilldown a EvKey KRight [] -> go $ drilldown t a
EvKey KEnter [] -> go $ drilldown a EvKey KEnter [] -> go $ drilldown t a
EvKey KLeft [] -> go $ backout a EvKey KLeft [] -> go $ backout t a
EvKey KUp [] -> go $ moveUpAndPushEdge a EvKey KUp [] -> go $ moveUpAndPushEdge a
EvKey KDown [] -> go $ moveDownAndPushEdge a EvKey KDown [] -> go $ moveDownAndPushEdge a
EvKey KHome [] -> go $ moveToTop a EvKey KHome [] -> go $ moveToTop a
@ -208,30 +210,30 @@ screen :: AppState -> Screen
screen a = scr where (Loc scr _ _) = loc a screen a = scr where (Loc scr _ _) = loc a
-- | Enter a new screen, saving the old ui location on the stack. -- | Enter a new screen, saving the old ui location on the stack.
enter :: Screen -> AppState -> AppState enter :: LocalTime -> Screen -> AppState -> AppState
enter scr@BalanceScreen a = updateData $ pushLoc Loc{scr=scr,sy=0,cy=0} a enter t scr@BalanceScreen a = updateData t $ pushLoc Loc{scr=scr,sy=0,cy=0} a
enter scr@RegisterScreen a = updateData $ pushLoc Loc{scr=scr,sy=0,cy=0} a enter t scr@RegisterScreen a = updateData t $ pushLoc Loc{scr=scr,sy=0,cy=0} a
enter scr@PrintScreen a = updateData $ pushLoc Loc{scr=scr,sy=0,cy=0} a enter t scr@PrintScreen a = updateData t $ pushLoc Loc{scr=scr,sy=0,cy=0} a
resetTrailAndEnter scr = enter scr . clearLocs resetTrailAndEnter t scr = enter t scr . clearLocs
-- | Regenerate the display data appropriate for the current screen. -- | Regenerate the display data appropriate for the current screen.
updateData :: AppState -> AppState updateData :: LocalTime -> AppState -> AppState
updateData a@AppState{aopts=opts,aargs=args,aledger=l} = updateData t a@AppState{aopts=opts,aargs=args,aledger=l} =
case screen a of case screen a of
BalanceScreen -> a{abuf=lines $ showBalanceReport opts [] l, aargs=[]} BalanceScreen -> a{abuf=lines $ showBalanceReport opts (optsToFilterSpec opts args t) l, aargs=[]}
RegisterScreen -> a{abuf=lines $ showRegisterReport opts args l} RegisterScreen -> a{abuf=lines $ showRegisterReport opts (optsToFilterSpec opts args t) l}
PrintScreen -> a{abuf=lines $ showTransactions opts args l} PrintScreen -> a{abuf=lines $ showTransactions (optsToFilterSpec opts args t) l}
backout :: AppState -> AppState backout :: LocalTime -> AppState -> AppState
backout a | screen a == BalanceScreen = a backout t a | screen a == BalanceScreen = a
| otherwise = updateData $ popLoc a | otherwise = updateData t $ popLoc a
drilldown :: AppState -> AppState drilldown :: LocalTime -> AppState -> AppState
drilldown a = drilldown t a =
case screen a of case screen a of
BalanceScreen -> enter RegisterScreen a{aargs=[currentAccountName a]} BalanceScreen -> enter t RegisterScreen a{aargs=[currentAccountName a]}
RegisterScreen -> scrollToTransaction e $ enter PrintScreen a RegisterScreen -> scrollToTransaction e $ enter t PrintScreen a
PrintScreen -> a PrintScreen -> a
where e = currentTransaction a where e = currentTransaction a
@ -278,7 +280,7 @@ currentTransaction a@AppState{aledger=l,abuf=buf} = ptransaction p
where where
p = safehead nullposting $ filter ismatch $ ledgerPostings l p = safehead nullposting $ filter ismatch $ ledgerPostings l
ismatch p = postingDate p == parsedate (take 10 datedesc) ismatch p = postingDate p == parsedate (take 10 datedesc)
&& take 70 (showp False p nullmixedamt) == (datedesc ++ acctamt) && take 70 (showposting False p nullmixedamt) == (datedesc ++ acctamt)
datedesc = take 32 $ fromMaybe "" $ find (not . (" " `isPrefixOf`)) $ safehead "" rest : reverse above datedesc = take 32 $ fromMaybe "" $ find (not . (" " `isPrefixOf`)) $ safehead "" rest : reverse above
acctamt = drop 32 $ safehead "" rest acctamt = drop 32 $ safehead "" rest
safehead d ls = if null ls then d else head ls safehead d ls = if null ls then d else head ls

25
Commands/Web.hs
View File

@ -47,7 +47,8 @@ import Commands.Histogram
import Commands.Print import Commands.Print
import Commands.Register import Commands.Register
import Ledger import Ledger
import Utils (openBrowserOn, readLedgerWithOpts) import Utils (openBrowserOn)
import Ledger.IO (readLedger)
-- import Debug.Trace -- import Debug.Trace
-- strace :: Show a => a -> a -- strace :: Show a => a -> a
@ -92,7 +93,7 @@ ledgerFileReadTime l = filereadtime $ journal l
reload :: Ledger -> IO Ledger reload :: Ledger -> IO Ledger
reload l = do reload l = do
l' <- readLedgerWithOpts [] [] (filepath $ journal l) l' <- readLedger (filepath $ journal l)
putValue "hledger" "ledger" l' putValue "hledger" "ledger" l'
return l' return l'
@ -115,6 +116,7 @@ server :: [Opt] -> [String] -> Ledger -> IO ()
server opts args l = server opts args l =
-- server initialisation -- server initialisation
withStore "hledger" $ do -- IO () withStore "hledger" $ do -- IO ()
t <- getCurrentLocalTime
webfiles <- getDataFileName "web" webfiles <- getDataFileName "web"
putValue "hledger" "ledger" l putValue "hledger" "ledger" l
-- XXX hack-happstack abstraction leak -- XXX hack-happstack abstraction leak
@ -130,14 +132,14 @@ server opts args l =
l' <- fromJust `fmap` getValue "hledger" "ledger" l' <- fromJust `fmap` getValue "hledger" "ledger"
l'' <- reloadIfChanged opts' args' l' l'' <- reloadIfChanged opts' args' l'
-- declare path-specific request handlers -- declare path-specific request handlers
let command :: [String] -> ([Opt] -> [String] -> Ledger -> String) -> AppUnit let command :: [String] -> ([Opt] -> FilterSpec -> Ledger -> String) -> AppUnit
command msgs f = string msgs $ f opts' args' l'' command msgs f = string msgs $ f opts' (optsToFilterSpec opts' args' t) l''
(loli $ -- State Loli () -> (Env -> IO Response) (loli $ -- State Loli () -> (Env -> IO Response)
do do
get "/balance" $ command [] showBalanceReport -- String -> ReaderT Env (StateT Response IO) () -> State Loli () get "/balance" $ command [] showBalanceReport -- String -> ReaderT Env (StateT Response IO) () -> State Loli ()
get "/register" $ command [] showRegisterReport get "/register" $ command [] showRegisterReport
get "/histogram" $ command [] showHistogram get "/histogram" $ command [] showHistogram
get "/transactions" $ ledgerpage [] l'' (showTransactions opts' args') get "/transactions" $ ledgerpage [] l'' (showTransactions (optsToFilterSpec opts' args' t))
post "/transactions" $ handleAddform l'' post "/transactions" $ handleAddform l''
get "/env" $ getenv >>= (text . show) get "/env" $ getenv >>= (text . show)
get "/params" $ getenv >>= (text . show . Hack.Contrib.Request.params) get "/params" $ getenv >>= (text . show . Hack.Contrib.Request.params)
@ -284,7 +286,8 @@ handleAddform :: Ledger -> AppUnit
handleAddform l = do handleAddform l = do
env <- getenv env <- getenv
d <- io getCurrentDay d <- io getCurrentDay
handle $ validate env d t <- io getCurrentLocalTime
handle t $ validate env d
where where
validate :: Hack.Env -> Day -> Failing Transaction validate :: Hack.Env -> Day -> Failing Transaction
validate env today = validate env today =
@ -337,10 +340,10 @@ handleAddform l = do
False -> Failure errs False -> Failure errs
True -> Success t' True -> Success t'
handle :: Failing Transaction -> AppUnit handle :: LocalTime -> Failing Transaction -> AppUnit
handle (Failure errs) = hsp errs addform handle _ (Failure errs) = hsp errs addform
handle (Success t) = do handle ti (Success t) = do
io $ ledgerAddTransaction l t >> reload l io $ ledgerAddTransaction l t >> reload l
ledgerpage [msg] l (showTransactions [] []) ledgerpage [msg] l (showTransactions (optsToFilterSpec [] [] ti))
where msg = printf "Added transaction:\n%s" (show t) where msg = printf "Added transaction:\n%s" (show t)

4
Ledger/AccountName.hs
View File

@ -73,6 +73,8 @@ accountNameTreeFrom1 accts =
accounttreesfrom as = [Node a (accounttreesfrom $ subs a) | a <- as] accounttreesfrom as = [Node a (accounttreesfrom $ subs a) | a <- as]
subs = subAccountNamesFrom (expandAccountNames accts) subs = subAccountNamesFrom (expandAccountNames accts)
nullaccountnametree = Node "top" []
accountNameTreeFrom2 accts = accountNameTreeFrom2 accts =
Node "top" $ unfoldForest (\a -> (a, subs a)) $ topAccountNames accts Node "top" $ unfoldForest (\a -> (a, subs a)) $ topAccountNames accts
where where
@ -164,4 +166,6 @@ elideAccountName width s =
| length ss > 1 = elideparts width (done++[take 2 $ head ss]) (tail ss) | length ss > 1 = elideparts width (done++[take 2 $ head ss]) (tail ss)
| otherwise = done++ss | otherwise = done++ss
clipAccountName :: Int -> AccountName -> AccountName
clipAccountName n = accountNameFromComponents . take n . accountNameComponents

68
Ledger/IO.hs
View File

@ -5,11 +5,11 @@ Utilities for doing I/O with ledger files.
module Ledger.IO module Ledger.IO
where where
import Control.Monad.Error import Control.Monad.Error
import Ledger.Ledger (cacheLedger) import Ledger.Ledger (cacheLedger', nullledger)
import Ledger.Parse (parseLedger) import Ledger.Parse (parseLedger)
import Ledger.Journal (canonicaliseAmounts,filterJournal,journalSelectingDate) import Ledger.Types (FilterSpec(..),WhichDate(..),Journal(..),Ledger(..))
import Ledger.Types (FilterSpec(..),WhichDate(..),DateSpan(..),Journal(..),Ledger(..))
import Ledger.Utils (getCurrentLocalTime) import Ledger.Utils (getCurrentLocalTime)
import Ledger.Dates (nulldatespan)
import System.Directory (getHomeDirectory) import System.Directory (getHomeDirectory)
import System.Environment (getEnv) import System.Environment (getEnv)
import System.IO import System.IO
@ -23,14 +23,16 @@ ledgerdefaultfilename = ".ledger"
timelogdefaultfilename = ".timelog" timelogdefaultfilename = ".timelog"
nullfilterspec = FilterSpec { nullfilterspec = FilterSpec {
datespan=DateSpan Nothing Nothing datespan=nulldatespan
,cleared=Nothing ,cleared=Nothing
,real=False ,real=False
,costbasis=False ,empty=False
,acctpats=[] ,costbasis=False
,descpats=[] ,acctpats=[]
,whichdate=ActualDate ,descpats=[]
} ,whichdate=ActualDate
,depth=Nothing
}
-- | Get the user's default ledger file path. -- | Get the user's default ledger file path.
myLedgerPath :: IO String myLedgerPath :: IO String
@ -58,16 +60,20 @@ myTimelog = myTimelogPath >>= readLedger
-- | Read a ledger from this file, with no filtering, or give an error. -- | Read a ledger from this file, with no filtering, or give an error.
readLedger :: FilePath -> IO Ledger readLedger :: FilePath -> IO Ledger
readLedger = readLedgerWithFilterSpec nullfilterspec readLedger f = do
-- | Read a ledger from this file, filtering according to the filter spec.,
-- | or give an error.
readLedgerWithFilterSpec :: FilterSpec -> FilePath -> IO Ledger
readLedgerWithFilterSpec fspec f = do
s <- readFile f
t <- getClockTime t <- getClockTime
rl <- journalFromString s s <- readFile f
return $ filterAndCacheLedger fspec s rl{filepath=f, filereadtime=t} j <- journalFromString s
return $ cacheLedger' $ nullledger{journaltext=s,journal=j{filepath=f,filereadtime=t}}
-- -- | Read a ledger from this file, filtering according to the filter spec.,
-- -- | or give an error.
-- readLedgerWithFilterSpec :: FilterSpec -> FilePath -> IO Ledger
-- readLedgerWithFilterSpec fspec f = do
-- s <- readFile f
-- t <- getClockTime
-- rl <- journalFromString s
-- return $ filterAndCacheLedger fspec s rl{filepath=f, filereadtime=t}
-- | Read a Journal from the given string, using the current time as -- | Read a Journal from the given string, using the current time as
-- reference time, or give a parse error. -- reference time, or give a parse error.
@ -76,18 +82,16 @@ journalFromString s = do
t <- getCurrentLocalTime t <- getCurrentLocalTime
liftM (either error id) $ runErrorT $ parseLedger t "(string)" s liftM (either error id) $ runErrorT $ parseLedger t "(string)" s
-- | Convert a Journal to a canonicalised, cached and filtered Ledger. -- -- | Convert a Journal to a canonicalised, cached and filtered Ledger.
filterAndCacheLedger :: FilterSpec -> String -> Journal -> Ledger -- filterAndCacheLedger :: FilterSpec -> String -> Journal -> Ledger
filterAndCacheLedger (FilterSpec{datespan=datespan,cleared=cleared,real=real, -- filterAndCacheLedger _ -- filterspec
costbasis=costbasis,acctpats=acctpats, -- rawtext
descpats=descpats,whichdate=whichdate}) -- j =
rawtext -- (cacheLedger $
rl = -- -- journalSelectingDate whichdate $
(cacheLedger acctpats -- j
$ filterJournal datespan descpats cleared real -- -- filterJournalPostings filterspec $ filterJournalTransactions filterspec j
$ journalSelectingDate whichdate -- ){journaltext=rawtext}
$ canonicaliseAmounts costbasis rl
){journaltext=rawtext}
-- -- | Expand ~ in a file path (does not handle ~name). -- -- | Expand ~ in a file path (does not handle ~name).
-- tildeExpand :: FilePath -> IO FilePath -- tildeExpand :: FilePath -> IO FilePath

173
Ledger/Journal.hs
View File

@ -1,6 +1,8 @@
{-| {-|
A 'Journal' is a parsed ledger file. A 'Journal' is a parsed ledger file, containing 'Transaction's.
It can be filtered and massaged in various ways, then \"crunched\"
to form a 'Ledger'.
-} -}
@ -19,14 +21,14 @@ import Ledger.TimeLog
instance Show Journal where instance Show Journal where
show l = printf "Journal with %d transactions, %d accounts: %s" show j = printf "Journal with %d transactions, %d accounts: %s"
(length (jtxns l) + (length (jtxns j) +
length (jmodifiertxns l) + length (jmodifiertxns j) +
length (jperiodictxns l)) length (jperiodictxns j))
(length accounts) (length accounts)
(show accounts) (show accounts)
-- ++ (show $ journalTransactions l) -- ++ (show $ journalTransactions l)
where accounts = flatten $ journalAccountNameTree l where accounts = flatten $ journalAccountNameTree j
nulljournal :: Journal nulljournal :: Journal
nulljournal = Journal { jmodifiertxns = [] nulljournal = Journal { jmodifiertxns = []
@ -66,15 +68,51 @@ journalAccountNames = sort . expandAccountNames . journalAccountNamesUsed
journalAccountNameTree :: Journal -> Tree AccountName journalAccountNameTree :: Journal -> Tree AccountName
journalAccountNameTree = accountNameTreeFrom . journalAccountNames journalAccountNameTree = accountNameTreeFrom . journalAccountNames
-- | Remove ledger transactions we are not interested in. -- Various kinds of filtering on journals. We do it differently depending
-- Keep only those which fall between the begin and end dates, and match -- on the command.
-- the description pattern, and are cleared or real if those options are active.
filterJournal :: DateSpan -> [String] -> Maybe Bool -> Bool -> Journal -> Journal -- | Keep only transactions we are interested in, as described by
filterJournal span pats clearedonly realonly = -- the filter specification. May also massage the data a little.
filterJournalPostingsByRealness realonly . filterJournalTransactions :: FilterSpec -> Journal -> Journal
filterJournalPostingsByClearedStatus clearedonly . filterJournalTransactions FilterSpec{datespan=datespan
filterJournalTransactionsByDate span . ,cleared=cleared
filterJournalTransactionsByDescription pats -- ,real=real
-- ,empty=empty
-- ,costbasis=_
,acctpats=apats
,descpats=dpats
,whichdate=whichdate
,depth=depth
} =
filterJournalTransactionsByClearedStatus cleared .
filterJournalPostingsByDepth depth .
filterJournalTransactionsByAccount apats .
filterJournalTransactionsByDescription dpats .
filterJournalTransactionsByDate datespan .
journalSelectingDate whichdate
-- | Keep only postings we are interested in, as described by
-- the filter specification. May also massage the data a little.
-- This can leave unbalanced transactions.
filterJournalPostings :: FilterSpec -> Journal -> Journal
filterJournalPostings FilterSpec{datespan=datespan
,cleared=cleared
,real=real
,empty=empty
-- ,costbasis=costbasis
,acctpats=apats
,descpats=dpats
,whichdate=whichdate
,depth=depth
} =
filterJournalPostingsByRealness real .
filterJournalPostingsByClearedStatus cleared .
filterJournalPostingsByEmpty empty .
filterJournalPostingsByDepth depth .
filterJournalPostingsByAccount apats .
filterJournalTransactionsByDescription dpats .
filterJournalTransactionsByDate datespan .
journalSelectingDate whichdate
-- | Keep only ledger transactions whose description matches the description patterns. -- | Keep only ledger transactions whose description matches the description patterns.
filterJournalTransactionsByDescription :: [String] -> Journal -> Journal filterJournalTransactionsByDescription :: [String] -> Journal -> Journal
@ -93,43 +131,69 @@ filterJournalTransactionsByDate (DateSpan begin end) (Journal ms ps ts tls hs f
-- | Keep only ledger transactions which have the requested -- | Keep only ledger transactions which have the requested
-- cleared/uncleared status, if there is one. -- cleared/uncleared status, if there is one.
filterJournalTransactionsByClearedStatus :: Maybe Bool -> Journal -> Journal
filterJournalTransactionsByClearedStatus Nothing j = j
filterJournalTransactionsByClearedStatus (Just val) (Journal ms ps ts tls hs f fp ft) =
Journal ms ps (filter ((==val).tstatus) ts) tls hs f fp ft
-- | Keep only postings which have the requested cleared/uncleared status,
-- if there is one.
filterJournalPostingsByClearedStatus :: Maybe Bool -> Journal -> Journal filterJournalPostingsByClearedStatus :: Maybe Bool -> Journal -> Journal
filterJournalPostingsByClearedStatus Nothing j = j filterJournalPostingsByClearedStatus Nothing j = j
filterJournalPostingsByClearedStatus (Just val) (Journal ms ps ts tls hs f fp ft) = filterJournalPostingsByClearedStatus (Just c) j@Journal{jtxns=ts} = j{jtxns=map filterpostings ts}
Journal ms ps (filter ((==val).tstatus) ts) tls hs f fp ft where filterpostings t@Transaction{tpostings=ps} = t{tpostings=filter ((==c) . postingCleared) ps}
-- | Strip out any virtual postings, if the flag is true, otherwise do -- | Strip out any virtual postings, if the flag is true, otherwise do
-- no filtering. -- no filtering.
filterJournalPostingsByRealness :: Bool -> Journal -> Journal filterJournalPostingsByRealness :: Bool -> Journal -> Journal
filterJournalPostingsByRealness False l = l filterJournalPostingsByRealness False l = l
filterJournalPostingsByRealness True (Journal mts pts ts tls hs f fp ft) = filterJournalPostingsByRealness True (Journal mts pts ts tls hs f fp ft) =
Journal mts pts (map filtertxns ts) tls hs f fp ft Journal mts pts (map filterpostings ts) tls hs f fp ft
where filtertxns t@Transaction{tpostings=ps} = t{tpostings=filter isReal ps} where filterpostings t@Transaction{tpostings=ps} = t{tpostings=filter isReal ps}
-- | Strip out any postings with zero amount, unless the flag is true.
filterJournalPostingsByEmpty :: Bool -> Journal -> Journal
filterJournalPostingsByEmpty True l = l
filterJournalPostingsByEmpty False (Journal mts pts ts tls hs f fp ft) =
Journal mts pts (map filterpostings ts) tls hs f fp ft
where filterpostings t@Transaction{tpostings=ps} = t{tpostings=filter (not . isEmptyPosting) ps}
-- | Keep only transactions which affect accounts deeper than the specified depth.
filterJournalTransactionsByDepth :: Maybe Int -> Journal -> Journal
filterJournalTransactionsByDepth Nothing j = j
filterJournalTransactionsByDepth (Just d) j@Journal{jtxns=ts} =
j{jtxns=(filter (any ((<= d+1) . accountNameLevel . paccount) . tpostings) ts)}
-- | Strip out any postings to accounts deeper than the specified depth -- | Strip out any postings to accounts deeper than the specified depth
-- (and any ledger transactions which have no postings as a result). -- (and any ledger transactions which have no postings as a result).
filterJournalPostingsByDepth :: Int -> Journal -> Journal filterJournalPostingsByDepth :: Maybe Int -> Journal -> Journal
filterJournalPostingsByDepth depth (Journal mts pts ts tls hs f fp ft) = filterJournalPostingsByDepth Nothing j = j
filterJournalPostingsByDepth (Just d) (Journal mts pts ts tls hs f fp ft) =
Journal mts pts (filter (not . null . tpostings) $ map filtertxns ts) tls hs f fp ft Journal mts pts (filter (not . null . tpostings) $ map filtertxns ts) tls hs f fp ft
where filtertxns t@Transaction{tpostings=ps} = where filtertxns t@Transaction{tpostings=ps} =
t{tpostings=filter ((<= depth) . accountNameLevel . paccount) ps} t{tpostings=filter ((<= d) . accountNameLevel . paccount) ps}
-- | Keep only ledger transactions which affect accounts matched by the account patterns. -- | Keep only transactions which affect accounts matched by the account patterns.
filterJournalPostingsByAccount :: [String] -> Journal -> Journal filterJournalTransactionsByAccount :: [String] -> Journal -> Journal
filterJournalPostingsByAccount apats (Journal ms ps ts tls hs f fp ft) = filterJournalTransactionsByAccount apats (Journal ms ps ts tls hs f fp ft) =
Journal ms ps (filter (any (matchpats apats . paccount) . tpostings) ts) tls hs f fp ft Journal ms ps (filter (any (matchpats apats . paccount) . tpostings) ts) tls hs f fp ft
-- | Convert this ledger's transactions' primary date to either their -- | Keep only postings which affect accounts matched by the account patterns.
-- This can leave transactions unbalanced.
filterJournalPostingsByAccount :: [String] -> Journal -> Journal
filterJournalPostingsByAccount apats j@Journal{jtxns=ts} = j{jtxns=map filterpostings ts}
where filterpostings t@Transaction{tpostings=ps} = t{tpostings=filter (matchpats apats . paccount) ps}
-- | Convert this journal's transactions' primary date to either the
-- actual or effective date. -- actual or effective date.
journalSelectingDate :: WhichDate -> Journal -> Journal journalSelectingDate :: WhichDate -> Journal -> Journal
journalSelectingDate ActualDate j = j journalSelectingDate ActualDate j = j
journalSelectingDate EffectiveDate j = journalSelectingDate EffectiveDate j =
j{jtxns=map (ledgerTransactionWithDate EffectiveDate) $ jtxns j} j{jtxns=map (ledgerTransactionWithDate EffectiveDate) $ jtxns j}
-- | Give all a ledger's amounts their canonical display settings. That -- | Convert all the journal's amounts to their canonical display settings.
-- is, in each commodity, amounts will use the display settings of the -- Ie, in each commodity, amounts will use the display settings of the first
-- first amount detected, and the greatest precision of the amounts -- amount detected, and the greatest precision of the amounts detected.
-- detected.
-- Also, missing unit prices are added if known from the price history. -- Also, missing unit prices are added if known from the price history.
-- Also, amounts are converted to cost basis if that flag is active. -- Also, amounts are converted to cost basis if that flag is active.
-- XXX refactor -- XXX refactor
@ -210,3 +274,52 @@ matchpats pats str =
negateprefix = "not:" negateprefix = "not:"
isnegativepat = (negateprefix `isPrefixOf`) isnegativepat = (negateprefix `isPrefixOf`)
abspat pat = if isnegativepat pat then drop (length negateprefix) pat else pat abspat pat = if isnegativepat pat then drop (length negateprefix) pat else pat
-- | Calculate the account tree and account balances from a journal's
-- postings, and return the results for efficient lookup.
crunchJournal :: Journal -> (Tree AccountName, Map.Map AccountName Account)
crunchJournal j = (ant,amap)
where
(ant,psof,_,inclbalof) = (groupPostings . journalPostings) j
amap = Map.fromList [(a, acctinfo a) | a <- flatten ant]
acctinfo a = Account a (psof a) (inclbalof a)
-- | Given a list of postings, return an account name tree and three query
-- functions that fetch postings, balance, and subaccount-including
-- balance by account name. This factors out common logic from
-- cacheLedger and summarisePostingsInDateSpan.
groupPostings :: [Posting] -> (Tree AccountName,
(AccountName -> [Posting]),
(AccountName -> MixedAmount),
(AccountName -> MixedAmount))
groupPostings ps = (ant,psof,exclbalof,inclbalof)
where
anames = sort $ nub $ map paccount ps
ant = accountNameTreeFrom $ expandAccountNames anames
allanames = flatten ant
pmap = Map.union (postingsByAccount ps) (Map.fromList [(a,[]) | a <- allanames])
psof = (pmap !)
balmap = Map.fromList $ flatten $ calculateBalances ant psof
exclbalof = fst . (balmap !)
inclbalof = snd . (balmap !)
-- | Add subaccount-excluding and subaccount-including balances to a tree
-- of account names somewhat efficiently, given a function that looks up
-- transactions by account name.
calculateBalances :: Tree AccountName -> (AccountName -> [Posting]) -> Tree (AccountName, (MixedAmount, MixedAmount))
calculateBalances ant psof = addbalances ant
where
addbalances (Node a subs) = Node (a,(bal,bal+subsbal)) subs'
where
bal = sumPostings $ psof a
subsbal = sum $ map (snd . snd . root) subs'
subs' = map addbalances subs
-- | Convert a list of postings to a map from account name to that
-- account's postings.
postingsByAccount :: [Posting] -> Map.Map AccountName [Posting]
postingsByAccount ps = m'
where
sortedps = sortBy (comparing paccount) ps
groupedps = groupBy (\p1 p2 -> paccount p1 == paccount p2) sortedps
m' = Map.fromList [(paccount $ head g, g) | g <- groupedps]

65
Ledger/Ledger.hs
View File

@ -54,7 +54,7 @@ aliases for easier interaction. Here's an example:
module Ledger.Ledger module Ledger.Ledger
where where
import qualified Data.Map as Map import qualified Data.Map as Map
import Data.Map ((!)) import Data.Map ((!), fromList)
import Ledger.Utils import Ledger.Utils
import Ledger.Types import Ledger.Types
import Ledger.Account () import Ledger.Account ()
@ -71,56 +71,25 @@ instance Show Ledger where
(length $ accountnames l) (length $ accountnames l)
(showtree $ accountnametree l) (showtree $ accountnametree l)
-- | Convert a journal to a more efficient cached ledger, described above. nullledger :: Ledger
cacheLedger :: [String] -> Journal -> Ledger nullledger = Ledger{
cacheLedger apats j = Ledger{journaltext="",journal=j,accountnametree=ant,accountmap=acctmap} journaltext = "",
where journal = nulljournal,
(ant,psof,_,inclbalof) = groupPostings $ filterPostings apats $ journalPostings j accountnametree = nullaccountnametree,
acctmap = Map.fromList [(a, mkacct a) | a <- flatten ant] accountmap = fromList []
where mkacct a = Account a (psof a) (inclbalof a) }
-- | Given a list of postings, return an account name tree and three query -- | Convert a journal to a more efficient cached ledger, described above.
-- functions that fetch postings, balance, and subaccount-including cacheLedger :: Journal -> Ledger
-- balance by account name. This factors out common logic from cacheLedger j = nullledger{journal=j,accountnametree=ant,accountmap=amap}
-- cacheLedger and summarisePostingsInDateSpan. where (ant, amap) = crunchJournal j
groupPostings :: [Posting] -> (Tree AccountName,
(AccountName -> [Posting]),
(AccountName -> MixedAmount),
(AccountName -> MixedAmount))
groupPostings ps = (ant,psof,exclbalof,inclbalof)
where
anames = sort $ nub $ map paccount ps
ant = accountNameTreeFrom $ expandAccountNames anames
allanames = flatten ant
pmap = Map.union (postingsByAccount ps) (Map.fromList [(a,[]) | a <- allanames])
psof = (pmap !)
balmap = Map.fromList $ flatten $ calculateBalances ant psof
exclbalof = fst . (balmap !)
inclbalof = snd . (balmap !)
-- | Add subaccount-excluding and subaccount-including balances to a tree -- | Add (or recalculate) the cached journal info in a ledger.
-- of account names somewhat efficiently, given a function that looks up cacheLedger' :: Ledger -> CachedLedger
-- transactions by account name. cacheLedger' l = l{accountnametree=ant,accountmap=amap}
calculateBalances :: Tree AccountName -> (AccountName -> [Posting]) -> Tree (AccountName, (MixedAmount, MixedAmount)) where (ant, amap) = crunchJournal $ journal l
calculateBalances ant psof = addbalances ant
where
addbalances (Node a subs) = Node (a,(bal,bal+subsbal)) subs'
where
bal = sumPostings $ psof a
subsbal = sum $ map (snd . snd . root) subs'
subs' = map addbalances subs
-- | Convert a list of postings to a map from account name to that type CachedLedger = Ledger
-- account's postings.
postingsByAccount :: [Posting] -> Map.Map AccountName [Posting]
postingsByAccount ps = m'
where
sortedps = sortBy (comparing paccount) ps
groupedps = groupBy (\p1 p2 -> paccount p1 == paccount p2) sortedps
m' = Map.fromList [(paccount $ head g, g) | g <- groupedps]
filterPostings :: [String] -> [Posting] -> [Posting]
filterPostings apats = filter (matchpats apats . paccount)
-- | List a ledger's account names. -- | List a ledger's account names.
ledgerAccountNames :: Ledger -> [AccountName] ledgerAccountNames :: Ledger -> [AccountName]

7
Ledger/Posting.hs
View File

@ -73,9 +73,16 @@ sumPostings = sum . map pamount
postingDate :: Posting -> Day postingDate :: Posting -> Day
postingDate p = maybe nulldate tdate $ ptransaction p postingDate p = maybe nulldate tdate $ ptransaction p
postingCleared :: Posting -> Bool
postingCleared p = maybe False tstatus $ ptransaction p
-- | Does this posting fall within the given date span ? -- | Does this posting fall within the given date span ?
isPostingInDateSpan :: DateSpan -> Posting -> Bool isPostingInDateSpan :: DateSpan -> Posting -> Bool
isPostingInDateSpan (DateSpan Nothing Nothing) _ = True isPostingInDateSpan (DateSpan Nothing Nothing) _ = True
isPostingInDateSpan (DateSpan Nothing (Just e)) p = postingDate p < e isPostingInDateSpan (DateSpan Nothing (Just e)) p = postingDate p < e
isPostingInDateSpan (DateSpan (Just b) Nothing) p = postingDate p >= b isPostingInDateSpan (DateSpan (Just b) Nothing) p = postingDate p >= b
isPostingInDateSpan (DateSpan (Just b) (Just e)) p = d >= b && d < e where d = postingDate p isPostingInDateSpan (DateSpan (Just b) (Just e)) p = d >= b && d < e where d = postingDate p
isEmptyPosting :: Posting -> Bool
isEmptyPosting = isZeroMixedAmount . pamount

5
Ledger/Transaction.hs
View File

@ -129,13 +129,14 @@ nonzerobalanceerror = "could not balance this transaction, amounts do not add up
-- | Convert the primary date to either the actual or effective date. -- | Convert the primary date to either the actual or effective date.
ledgerTransactionWithDate :: WhichDate -> Transaction -> Transaction ledgerTransactionWithDate :: WhichDate -> Transaction -> Transaction
ledgerTransactionWithDate ActualDate t = t ledgerTransactionWithDate ActualDate t = t
ledgerTransactionWithDate EffectiveDate t = t{tdate=fromMaybe (tdate t) (teffectivedate t)} ledgerTransactionWithDate EffectiveDate t = txnTieKnot t{tdate=fromMaybe (tdate t) (teffectivedate t)}
-- | Ensure a transaction's postings refer to it as their transaction. -- | Ensure a transaction's postings refer back to it.
txnTieKnot :: Transaction -> Transaction txnTieKnot :: Transaction -> Transaction
txnTieKnot t@Transaction{tpostings=ps} = t{tpostings=map (settxn t) ps} txnTieKnot t@Transaction{tpostings=ps} = t{tpostings=map (settxn t) ps}
-- | Set a posting's parent transaction. -- | Set a posting's parent transaction.
settxn :: Transaction -> Posting -> Posting settxn :: Transaction -> Posting -> Posting
settxn t p = p{ptransaction=Just t} settxn t p = p{ptransaction=Just t}

9
Ledger/Types.hs
View File

@ -37,7 +37,7 @@ import Data.Typeable (Typeable)
type SmartDate = (String,String,String) type SmartDate = (String,String,String)
data WhichDate = ActualDate | EffectiveDate data WhichDate = ActualDate | EffectiveDate deriving (Eq,Show)
data DateSpan = DateSpan (Maybe Day) (Maybe Day) deriving (Eq,Show,Ord) data DateSpan = DateSpan (Maybe Day) (Maybe Day) deriving (Eq,Show,Ord)
@ -81,7 +81,7 @@ data Posting = Posting {
data Transaction = Transaction { data Transaction = Transaction {
tdate :: Day, tdate :: Day,
teffectivedate :: Maybe Day, teffectivedate :: Maybe Day,
tstatus :: Bool, tstatus :: Bool, -- XXX tcleared ?
tcode :: String, tcode :: String,
tdescription :: String, tdescription :: String,
tcomment :: String, tcomment :: String,
@ -138,13 +138,16 @@ data Ledger = Ledger {
} deriving Typeable } deriving Typeable
-- | A generic, pure specification of how to filter transactions/postings. -- | A generic, pure specification of how to filter transactions/postings.
-- This exists to keep app-specific options out of the hledger library.
data FilterSpec = FilterSpec { data FilterSpec = FilterSpec {
datespan :: DateSpan -- ^ only include if in this date span datespan :: DateSpan -- ^ only include if in this date span
,cleared :: Maybe Bool -- ^ only include if cleared\/uncleared\/don't care ,cleared :: Maybe Bool -- ^ only include if cleared\/uncleared\/don't care
,real :: Bool -- ^ only include if real\/don't care ,real :: Bool -- ^ only include if real\/don't care
,empty :: Bool -- ^ include if empty (ie amount is zero)
,costbasis :: Bool -- ^ convert all amounts to cost basis ,costbasis :: Bool -- ^ convert all amounts to cost basis
,acctpats :: [String] -- ^ only include if matching these account patterns ,acctpats :: [String] -- ^ only include if matching these account patterns
,descpats :: [String] -- ^ only include if matching these description patterns ,descpats :: [String] -- ^ only include if matching these description patterns
,whichdate :: WhichDate -- ^ which dates to use (actual or effective) ,whichdate :: WhichDate -- ^ which dates to use (actual or effective)
} ,depth :: Maybe Int
} deriving (Show)

15
Options.hs
View File

@ -197,15 +197,15 @@ intervalFromOpts opts =
intervalopts = reverse $ filter (`elem` [WeeklyOpt,MonthlyOpt,QuarterlyOpt,YearlyOpt]) opts intervalopts = reverse $ filter (`elem` [WeeklyOpt,MonthlyOpt,QuarterlyOpt,YearlyOpt]) opts
-- | Get the value of the (last) depth option, if any, otherwise a large number. -- | Get the value of the (last) depth option, if any, otherwise a large number.
depthFromOpts :: [Opt] -> Int depthFromOpts :: [Opt] -> Maybe Int
depthFromOpts opts = fromMaybe 9999 $ listtomaybeint $ optValuesForConstructor Depth opts depthFromOpts opts = listtomaybeint $ optValuesForConstructor Depth opts
where where
listtomaybeint [] = Nothing listtomaybeint [] = Nothing
listtomaybeint vs = Just $ read $ last vs listtomaybeint vs = Just $ read $ last vs
-- | Get the value of the (last) display option, if any. -- | Get the value of the (last) display option, if any.
displayFromOpts :: [Opt] -> Maybe String displayExprFromOpts :: [Opt] -> Maybe String
displayFromOpts opts = listtomaybe $ optValuesForConstructor Display opts displayExprFromOpts opts = listtomaybe $ optValuesForConstructor Display opts
where where
listtomaybe [] = Nothing listtomaybe [] = Nothing
listtomaybe vs = Just $ last vs listtomaybe vs = Just $ last vs
@ -247,10 +247,17 @@ optsToFilterSpec opts args t = FilterSpec {
datespan=dateSpanFromOpts (localDay t) opts datespan=dateSpanFromOpts (localDay t) opts
,cleared=clearedValueFromOpts opts ,cleared=clearedValueFromOpts opts
,real=Real `elem` opts ,real=Real `elem` opts
,empty=Empty `elem` opts
,costbasis=CostBasis `elem` opts ,costbasis=CostBasis `elem` opts
,acctpats=apats ,acctpats=apats
,descpats=dpats ,descpats=dpats
,whichdate = if Effective `elem` opts then EffectiveDate else ActualDate ,whichdate = if Effective `elem` opts then EffectiveDate else ActualDate
,depth = depthFromOpts opts
} }
where (apats,dpats) = parsePatternArgs args where (apats,dpats) = parsePatternArgs args
-- currentLocalTimeFromOpts opts = listtomaybe $ optValuesForConstructor CurrentLocalTime opts
-- where
-- listtomaybe [] = Nothing
-- listtomaybe vs = Just $ last vs

92
Tests.hs
View File

@ -155,7 +155,8 @@ tests = [
,"balance report tests" ~: ,"balance report tests" ~:
let (opts,args) `gives` es = do let (opts,args) `gives` es = do
l <- sampleledgerwithopts opts args l <- sampleledgerwithopts opts args
showBalanceReport opts args l `is` unlines es t <- getCurrentLocalTime
showBalanceReport opts (optsToFilterSpec opts args t) l `is` unlines es
in TestList in TestList
[ [
@ -275,30 +276,28 @@ tests = [
] ]
,"balance report with cost basis" ~: do ,"balance report with cost basis" ~: do
rl <- journalFromString $ unlines j <- journalFromString $ unlines
["" [""
,"2008/1/1 test " ,"2008/1/1 test "
," a:b 10h @ $50" ," a:b 10h @ $50"
," c:d " ," c:d "
,"" ,""
] ]
let l = cacheLedger [] $ let j' = canonicaliseAmounts True j -- enable cost basis adjustment
filterJournal (DateSpan Nothing Nothing) [] Nothing False $ showBalanceReport [] nullfilterspec nullledger{journal=j'} `is`
canonicaliseAmounts True rl -- enable cost basis adjustment
showBalanceReport [] [] l `is`
unlines unlines
[" $500 a:b" [" $500 a:b"
," $-500 c:d" ," $-500 c:d"
] ]
,"balance report elides zero-balance root account(s)" ~: do ,"balance report elides zero-balance root account(s)" ~: do
l <- ledgerFromStringWithOpts [] [] sampletime l <- ledgerFromStringWithOpts []
(unlines (unlines
["2008/1/1 one" ["2008/1/1 one"
," test:a 1" ," test:a 1"
," test:b" ," test:b"
]) ])
showBalanceReport [] [] l `is` showBalanceReport [] nullfilterspec l `is`
unlines unlines
[" 1 test:a" [" 1 test:a"
," -1 test:b" ," -1 test:b"
@ -331,7 +330,7 @@ tests = [
Left _ -> error "should not happen") Left _ -> error "should not happen")
,"cacheLedger" ~: ,"cacheLedger" ~:
length (Map.keys $ accountmap $ cacheLedger [] journal7) `is` 15 length (Map.keys $ accountmap $ cacheLedger journal7) `is` 15
,"canonicaliseAmounts" ~: ,"canonicaliseAmounts" ~:
"use the greatest precision" ~: "use the greatest precision" ~:
@ -482,8 +481,8 @@ tests = [
parseWithCtx emptyCtx ledgerposting rawposting1_str `parseis` rawposting1 parseWithCtx emptyCtx ledgerposting rawposting1_str `parseis` rawposting1
,"parsedate" ~: do ,"parsedate" ~: do
parsedate "2008/02/03" `is` parsetimewith "%Y/%m/%d" "2008/02/03" sampledate parsedate "2008/02/03" `is` parsetimewith "%Y/%m/%d" "2008/02/03" date1
parsedate "2008-02-03" `is` parsetimewith "%Y/%m/%d" "2008/02/03" sampledate parsedate "2008-02-03" `is` parsetimewith "%Y/%m/%d" "2008/02/03" date1
,"period expressions" ~: do ,"period expressions" ~: do
let todaysdate = parsedate "2008/11/26" let todaysdate = parsedate "2008/11/26"
@ -501,7 +500,8 @@ tests = [
do do
let args = ["expenses"] let args = ["expenses"]
l <- sampleledgerwithopts [] args l <- sampleledgerwithopts [] args
showTransactions [] args l `is` unlines t <- getCurrentLocalTime
showTransactions (optsToFilterSpec [] args t) l `is` unlines
["2008/06/03 * eat & shop" ["2008/06/03 * eat & shop"
," expenses:food $1" ," expenses:food $1"
," expenses:supplies $1" ," expenses:supplies $1"
@ -512,7 +512,8 @@ tests = [
, "print report with depth arg" ~: , "print report with depth arg" ~:
do do
l <- sampleledger l <- sampleledger
showTransactions [Depth "2"] [] l `is` unlines t <- getCurrentLocalTime
showTransactions (optsToFilterSpec [Depth "2"] [] t) l `is` unlines
["2008/01/01 income" ["2008/01/01 income"
," income:salary $-1" ," income:salary $-1"
,"" ,""
@ -546,7 +547,7 @@ tests = [
"register report with no args" ~: "register report with no args" ~:
do do
l <- sampleledger l <- sampleledger
showRegisterReport [] [] l `is` unlines showRegisterReport [] (optsToFilterSpec [] [] t1) l `is` unlines
["2008/01/01 income assets:bank:checking $1 $1" ["2008/01/01 income assets:bank:checking $1 $1"
," income:salary $-1 0" ," income:salary $-1 0"
,"2008/06/01 gift assets:bank:checking $1 $1" ,"2008/06/01 gift assets:bank:checking $1 $1"
@ -560,10 +561,11 @@ tests = [
," assets:bank:checking $-1 0" ," assets:bank:checking $-1 0"
] ]
,"register report with cleared arg" ~: ,"register report with cleared option" ~:
do do
l <- ledgerFromStringWithOpts [Cleared] [] sampletime sample_ledger_str let opts = [Cleared]
showRegisterReport [Cleared] [] l `is` unlines l <- ledgerFromStringWithOpts opts sample_ledger_str
showRegisterReport opts (optsToFilterSpec opts [] t1) l `is` unlines
["2008/06/03 eat & shop expenses:food $1 $1" ["2008/06/03 eat & shop expenses:food $1 $1"
," expenses:supplies $1 $2" ," expenses:supplies $1 $2"
," assets:cash $-2 0" ," assets:cash $-2 0"
@ -571,10 +573,11 @@ tests = [
," assets:bank:checking $-1 0" ," assets:bank:checking $-1 0"
] ]
,"register report with uncleared arg" ~: ,"register report with uncleared option" ~:
do do
l <- ledgerFromStringWithOpts [UnCleared] [] sampletime sample_ledger_str let opts = [UnCleared]
showRegisterReport [UnCleared] [] l `is` unlines l <- ledgerFromStringWithOpts opts sample_ledger_str
showRegisterReport opts (optsToFilterSpec opts [] t1) l `is` unlines
["2008/01/01 income assets:bank:checking $1 $1" ["2008/01/01 income assets:bank:checking $1 $1"
," income:salary $-1 0" ," income:salary $-1 0"
,"2008/06/01 gift assets:bank:checking $1 $1" ,"2008/06/01 gift assets:bank:checking $1 $1"
@ -585,7 +588,7 @@ tests = [
,"register report sorts by date" ~: ,"register report sorts by date" ~:
do do
l <- ledgerFromStringWithOpts [] [] sampletime $ unlines l <- ledgerFromStringWithOpts [] $ unlines
["2008/02/02 a" ["2008/02/02 a"
," b 1" ," b 1"
," c" ," c"
@ -594,19 +597,19 @@ tests = [
," e 1" ," e 1"
," f" ," f"
] ]
registerdates (showRegisterReport [] [] l) `is` ["2008/01/01","2008/02/02"] registerdates (showRegisterReport [] (optsToFilterSpec [] [] t1) l) `is` ["2008/01/01","2008/02/02"]
,"register report with account pattern" ~: ,"register report with account pattern" ~:
do do
l <- sampleledger l <- sampleledger
showRegisterReport [] ["cash"] l `is` unlines showRegisterReport [] (optsToFilterSpec [] ["cash"] t1) l `is` unlines
["2008/06/03 eat & shop assets:cash $-2 $-2" ["2008/06/03 eat & shop assets:cash $-2 $-2"
] ]
,"register report with account pattern, case insensitive" ~: ,"register report with account pattern, case insensitive" ~:
do do
l <- sampleledger l <- sampleledger
showRegisterReport [] ["cAsH"] l `is` unlines showRegisterReport [] (optsToFilterSpec [] ["cAsH"] t1) l `is` unlines
["2008/06/03 eat & shop assets:cash $-2 $-2" ["2008/06/03 eat & shop assets:cash $-2 $-2"
] ]
@ -614,7 +617,8 @@ tests = [
do do
l <- sampleledger l <- sampleledger
let gives displayexpr = let gives displayexpr =
(registerdates (showRegisterReport [Display displayexpr] [] l) `is`) (registerdates (showRegisterReport opts (optsToFilterSpec opts [] t1) l) `is`)
where opts = [Display displayexpr]
"d<[2008/6/2]" `gives` ["2008/01/01","2008/06/01"] "d<[2008/6/2]" `gives` ["2008/01/01","2008/06/01"]
"d<=[2008/6/2]" `gives` ["2008/01/01","2008/06/01","2008/06/02"] "d<=[2008/6/2]" `gives` ["2008/01/01","2008/06/01","2008/06/02"]
"d=[2008/6/2]" `gives` ["2008/06/02"] "d=[2008/6/2]" `gives` ["2008/06/02"]
@ -625,15 +629,17 @@ tests = [
do do
l <- sampleledger l <- sampleledger
let periodexpr `gives` dates = do let periodexpr `gives` dates = do
lopts <- sampleledgerwithopts [Period periodexpr] [] l' <- sampleledgerwithopts opts []
registerdates (showRegisterReport [Period periodexpr] [] lopts) `is` dates registerdates (showRegisterReport opts (optsToFilterSpec opts [] t1) l') `is` dates
where opts = [Period periodexpr]
"" `gives` ["2008/01/01","2008/06/01","2008/06/02","2008/06/03","2008/12/31"] "" `gives` ["2008/01/01","2008/06/01","2008/06/02","2008/06/03","2008/12/31"]
"2008" `gives` ["2008/01/01","2008/06/01","2008/06/02","2008/06/03","2008/12/31"] "2008" `gives` ["2008/01/01","2008/06/01","2008/06/02","2008/06/03","2008/12/31"]
"2007" `gives` [] "2007" `gives` []
"june" `gives` ["2008/06/01","2008/06/02","2008/06/03"] "june" `gives` ["2008/06/01","2008/06/02","2008/06/03"]
"monthly" `gives` ["2008/01/01","2008/06/01","2008/12/01"] "monthly" `gives` ["2008/01/01","2008/06/01","2008/12/01"]
"quarterly" `gives` ["2008/01/01","2008/04/01","2008/10/01"] "quarterly" `gives` ["2008/01/01","2008/04/01","2008/10/01"]
showRegisterReport [Period "yearly"] [] l `is` unlines let opts = [Period "yearly"]
showRegisterReport opts (optsToFilterSpec opts [] t1) l `is` unlines
["2008/01/01 - 2008/12/31 assets:bank:saving $1 $1" ["2008/01/01 - 2008/12/31 assets:bank:saving $1 $1"
," assets:cash $-2 $-1" ," assets:cash $-2 $-1"
," expenses:food $1 0" ," expenses:food $1 0"
@ -642,15 +648,18 @@ tests = [
," income:salary $-1 $-1" ," income:salary $-1 $-1"
," liabilities:debts $1 0" ," liabilities:debts $1 0"
] ]
registerdates (showRegisterReport [Period "quarterly"] [] l) `is` ["2008/01/01","2008/04/01","2008/10/01"] let opts = [Period "quarterly"]
registerdates (showRegisterReport [Period "quarterly",Empty] [] l) `is` ["2008/01/01","2008/04/01","2008/07/01","2008/10/01"] registerdates (showRegisterReport opts (optsToFilterSpec opts [] t1) l) `is` ["2008/01/01","2008/04/01","2008/10/01"]
let opts = [Period "quarterly",Empty]
registerdates (showRegisterReport opts (optsToFilterSpec opts [] t1) l) `is` ["2008/01/01","2008/04/01","2008/07/01","2008/10/01"]
] ]
, "register report with depth arg" ~: , "register report with depth arg" ~:
do do
l <- sampleledger l <- sampleledger
showRegisterReport [Depth "2"] [] l `is` unlines let opts = [Depth "2"]
showRegisterReport opts (optsToFilterSpec opts [] t1) l `is` unlines
["2008/01/01 income income:salary $-1 $-1" ["2008/01/01 income income:salary $-1 $-1"
,"2008/06/01 gift income:gifts $-1 $-2" ,"2008/06/01 gift income:gifts $-1 $-2"
,"2008/06/03 eat & shop expenses:food $1 $-1" ,"2008/06/03 eat & shop expenses:food $1 $-1"
@ -723,16 +732,16 @@ tests = [
] "")) ] ""))
,"unicode in balance layout" ~: do ,"unicode in balance layout" ~: do
l <- ledgerFromStringWithOpts [] [] sampletime l <- ledgerFromStringWithOpts []
"2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n" "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n"
showBalanceReport [] [] l `is` unlines showBalanceReport [] (optsToFilterSpec [] [] t1) l `is` unlines
[" -100 актив:наличные" [" -100 актив:наличные"
," 100 расходы:покупки"] ," 100 расходы:покупки"]
,"unicode in register layout" ~: do ,"unicode in register layout" ~: do
l <- ledgerFromStringWithOpts [] [] sampletime l <- ledgerFromStringWithOpts []
"2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n" "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n"
showRegisterReport [] [] l `is` unlines showRegisterReport [] (optsToFilterSpec [] [] t1) l `is` unlines
["2009/01/01 медвежья шкура расходы:покупки 100 100" ["2009/01/01 медвежья шкура расходы:покупки 100 100"
," актив:наличные -100 0"] ," актив:наличные -100 0"]
@ -789,7 +798,7 @@ tests = [
[mkdatespan "2008/01/01" "2008/01/01"] [mkdatespan "2008/01/01" "2008/01/01"]
,"subAccounts" ~: do ,"subAccounts" ~: do
l <- sampleledger l <- liftM cacheLedger' sampleledger
let a = ledgerAccount l "assets" let a = ledgerAccount l "assets"
map aname (ledgerSubAccounts l a) `is` ["assets:bank","assets:cash"] map aname (ledgerSubAccounts l a) `is` ["assets:bank","assets:cash"]
@ -839,10 +848,11 @@ tests = [
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- test data -- test data
sampledate = parsedate "2008/11/26" date1 = parsedate "2008/11/26"
sampletime = LocalTime sampledate midday t1 = LocalTime date1 midday
sampleledger = ledgerFromStringWithOpts [] [] sampletime sample_ledger_str
sampleledgerwithopts opts args = ledgerFromStringWithOpts opts args sampletime sample_ledger_str sampleledger = ledgerFromStringWithOpts [] sample_ledger_str
sampleledgerwithopts opts _ = ledgerFromStringWithOpts opts sample_ledger_str
sample_ledger_str = unlines sample_ledger_str = unlines
["; A sample ledger file." ["; A sample ledger file."
@ -1231,7 +1241,7 @@ journal7 = Journal
"" ""
(TOD 0 0) (TOD 0 0)
ledger7 = cacheLedger [] journal7 ledger7 = cacheLedger journal7
ledger8_str = unlines ledger8_str = unlines
["2008/1/1 test " ["2008/1/1 test "

47
Utils.hs
View File

@ -9,14 +9,14 @@ module Utils
where where
import Control.Monad.Error import Control.Monad.Error
import Ledger import Ledger
import Options (Opt,ledgerFilePathFromOpts,optsToFilterSpec) import Options (Opt(..),ledgerFilePathFromOpts) -- ,optsToFilterSpec)
import System.Directory (doesFileExist) import System.Directory (doesFileExist)
import System.IO (stderr) import System.IO (stderr)
import System.IO.UTF8 (hPutStrLn) import System.IO.UTF8 (hPutStrLn)
import System.Exit import System.Exit
import System.Cmd (system) import System.Cmd (system)
import System.Info (os) import System.Info (os)
import System.Time (getClockTime) import System.Time (ClockTime,getClockTime)
-- | Parse the user's specified ledger file and run a hledger command on -- | Parse the user's specified ledger file and run a hledger command on
@ -30,30 +30,37 @@ withLedgerDo opts args cmdname cmd = do
let f' = if f == "-" then "/dev/null" else f let f' = if f == "-" then "/dev/null" else f
fileexists <- doesFileExist f fileexists <- doesFileExist f
let creating = not fileexists && cmdname == "add" let creating = not fileexists && cmdname == "add"
rawtext <- if creating then return "" else strictReadFile f'
t <- getCurrentLocalTime t <- getCurrentLocalTime
tc <- getClockTime tc <- getClockTime
let go = cmd opts args . filterAndCacheLedgerWithOpts opts args t rawtext . (\rl -> rl{filepath=f,filereadtime=tc}) txt <- if creating then return "" else strictReadFile f'
if creating then go nulljournal else (runErrorT . parseLedgerFile t) f let runcmd = cmd opts args . mkLedger opts f tc txt
>>= flip either go if creating
(\e -> hPutStrLn stderr e >> exitWith (ExitFailure 1)) then runcmd nulljournal
else (runErrorT . parseLedgerFile t) f >>= either parseerror runcmd
where parseerror e = hPutStrLn stderr e >> exitWith (ExitFailure 1)
mkLedger :: [Opt] -> FilePath -> ClockTime -> String -> Journal -> Ledger
mkLedger opts f tc txt j = nullledger{journaltext=txt,journal=j'}
where j' = (canonicaliseAmounts costbasis j){filepath=f,filereadtime=tc}
costbasis=CostBasis `elem` opts
-- | Get a Ledger from the given string and options, or raise an error. -- | Get a Ledger from the given string and options, or raise an error.
ledgerFromStringWithOpts :: [Opt] -> [String] -> LocalTime -> String -> IO Ledger ledgerFromStringWithOpts :: [Opt] -> String -> IO Ledger
ledgerFromStringWithOpts opts args reftime s = ledgerFromStringWithOpts opts s = do
liftM (filterAndCacheLedgerWithOpts opts args reftime s) $ journalFromString s tc <- getClockTime
j <- journalFromString s
return $ mkLedger opts "" tc s j
-- | Read a Ledger from the given file, filtering according to the -- -- | Read a Ledger from the given file, or give an error.
-- options, or give an error. -- readLedgerWithOpts :: [Opt] -> [String] -> FilePath -> IO Ledger
readLedgerWithOpts :: [Opt] -> [String] -> FilePath -> IO Ledger -- readLedgerWithOpts opts args f = do
readLedgerWithOpts opts args f = do -- t <- getCurrentLocalTime
t <- getCurrentLocalTime -- readLedger f
readLedgerWithFilterSpec (optsToFilterSpec opts args t) f
-- | Convert a Journal to a canonicalised, cached and filtered Ledger -- -- | Convert a Journal to a canonicalised, cached and filtered Ledger
-- based on the command-line options/arguments and a reference time. -- -- based on the command-line options/arguments and a reference time.
filterAndCacheLedgerWithOpts :: [Opt] -> [String] -> LocalTime -> String -> Journal -> Ledger -- filterAndCacheLedgerWithOpts :: [Opt] -> [String] -> LocalTime -> String -> Journal -> Ledger
filterAndCacheLedgerWithOpts opts args = filterAndCacheLedger . optsToFilterSpec opts args -- filterAndCacheLedgerWithOpts opts args = filterAndCacheLedger . optsToFilterSpec opts args
-- | Attempt to open a web browser on the given url, all platforms. -- | Attempt to open a web browser on the given url, all platforms.
openBrowserOn :: String -> IO ExitCode openBrowserOn :: String -> IO ExitCode