113 lines
4.9 KiB
Haskell
113 lines
4.9 KiB
Haskell
{-|
|
|
|
|
A ledger-compatible @register@ command.
|
|
|
|
-}
|
|
|
|
module RegisterCommand
|
|
where
|
|
import qualified Data.Map as Map
|
|
import Data.Map ((!))
|
|
import Ledger
|
|
import Options
|
|
|
|
|
|
-- | Print a register report.
|
|
register :: [Opt] -> [String] -> Ledger -> IO ()
|
|
register opts args l = putStr $ showRegisterReport opts args l
|
|
|
|
{- |
|
|
Generate the register report. Each ledger entry is displayed as two or
|
|
more lines like this:
|
|
|
|
@
|
|
date (10) description (20) account (22) amount (11) balance (12)
|
|
DDDDDDDDDD dddddddddddddddddddd aaaaaaaaaaaaaaaaaaaaaa AAAAAAAAAAA AAAAAAAAAAAA
|
|
aaaaaaaaaaaaaaaaaaaaaa AAAAAAAAAAA AAAAAAAAAAAA
|
|
... ... ...
|
|
@
|
|
-}
|
|
showRegisterReport :: [Opt] -> [String] -> Ledger -> String
|
|
showRegisterReport opts args l
|
|
| interval == NoInterval = showtxns ts nulltxn nullmixedamt
|
|
| otherwise = showtxns summaryts nulltxn nullmixedamt
|
|
where
|
|
interval = intervalFromOpts opts
|
|
ts = filter (not . isZeroMixedAmount . amount) $ filter (matchdisplayopt dopt) $ filter matchapats $ ledgerTransactions l
|
|
matchapats t = matchpats apats $ account t
|
|
apats = fst $ parseAccountDescriptionArgs opts args
|
|
matchdisplayopt Nothing t = True
|
|
matchdisplayopt (Just e) t = (fromparse $ parsewith datedisplayexpr e) t
|
|
dopt = displayFromOpts opts
|
|
empty = Empty `elem` opts
|
|
summaryts = concat $ map (\(n,s) -> summarise n s (filter (isTransactionInDateSpan s) ts)) $ zip [1..] spans
|
|
spans = splitSpan interval (ledgerDateSpan l)
|
|
-- generate a grouped set of summary transactions for this date span
|
|
summarise :: Int -> DateSpan -> [Transaction] -> [Transaction]
|
|
summarise _ _ [] = []
|
|
summarise n (DateSpan b e) ts = summarytxns (b',e') n empty ts
|
|
where
|
|
b' = fromMaybe (date $ head ts) b
|
|
e' = fromMaybe (date $ last ts) e
|
|
|
|
-- | Does the given transaction fall within the given date span ?
|
|
isTransactionInDateSpan :: DateSpan -> Transaction -> Bool
|
|
isTransactionInDateSpan (DateSpan Nothing Nothing) _ = True
|
|
isTransactionInDateSpan (DateSpan Nothing (Just e)) (Transaction{date=d}) = d<e
|
|
isTransactionInDateSpan (DateSpan (Just b) Nothing) (Transaction{date=d}) = d>=b
|
|
isTransactionInDateSpan (DateSpan (Just b) (Just e)) (Transaction{date=d}) = d>=b && d<e
|
|
|
|
-- | Convert a date span and a list of transactions within that date span
|
|
-- to a new list of transactions aggregated by account, which when
|
|
-- rendered by showtxns will display a summary for the date span. Both
|
|
-- ends of the date span must be specified so we pass a tuple of dates.
|
|
-- As usual with date spans the second date is exclusive, but when
|
|
-- rendering we will show the previous (inclusive) date.
|
|
-- A unique entryno value is provided so that these dummy transactions
|
|
-- will be rendered as one entry. Also the showempty flag is provided to
|
|
-- control display of zero-balance accounts.
|
|
summarytxns :: (Day,Day) -> Int -> Bool -> [Transaction] -> [Transaction]
|
|
summarytxns (b,e) entryno showempty ts = summaryts'
|
|
where
|
|
summaryts'
|
|
| showempty = summaryts
|
|
| otherwise = filter (not . isZeroMixedAmount . amount) summaryts
|
|
summaryts = [templtxn{account=a,amount=balmap ! a} | a <- anames]
|
|
templtxn = nulltxn{entryno=entryno,date=b,description="- "++(showDate eprev)}
|
|
eprev = addDays (-1) e
|
|
anames = sort $ nub $ map account ts
|
|
-- from cacheLedger:
|
|
sortedts = sortBy (comparing account) ts
|
|
groupedts = groupBy (\t1 t2 -> account t1 == account t2) sortedts
|
|
txnmap = Map.union
|
|
(Map.fromList [(account $ head g, g) | g <- groupedts])
|
|
(Map.fromList [(a,[]) | a <- anames])
|
|
txnsof = (txnmap !)
|
|
subacctsof a = filter (a `isAccountNamePrefixOf`) anames
|
|
subtxnsof a = concat [txnsof a | a <- [a] ++ subacctsof a]
|
|
balmap = Map.union
|
|
(Map.fromList [(a,(sumTransactions $ subtxnsof a)) | a <- anames])
|
|
(Map.fromList [(a,Mixed []) | a <- anames])
|
|
--
|
|
|
|
-- | Show transactions one per line, with each date/description appearing
|
|
-- only once, and a running balance.
|
|
showtxns [] _ _ = ""
|
|
showtxns (t@Transaction{amount=a}:ts) tprev bal = this ++ showtxns ts t bal'
|
|
where
|
|
this = showtxn (t `issame` tprev) t bal'
|
|
issame t1 t2 = entryno t1 == entryno t2
|
|
bal' = bal + amount t
|
|
|
|
-- | Show one transaction line and balance with or without the entry details.
|
|
showtxn :: Bool -> Transaction -> MixedAmount -> String
|
|
showtxn omitdesc t b = concatBottomPadded [entrydesc ++ txn ++ " ", bal] ++ "\n"
|
|
where
|
|
entrydesc = if omitdesc then replicate 32 ' ' else printf "%s %s " date desc
|
|
date = showDate $ da
|
|
desc = printf "%-20s" $ elideRight 20 de :: String
|
|
txn = showRawTransaction $ RawTransaction a amt "" tt
|
|
bal = padleft 12 (showMixedAmountOrZero b)
|
|
Transaction{date=da,description=de,account=a,amount=amt,ttype=tt} = t
|
|
|