support reporting intervals in period expressions and register report, and -W/-M/-D
This commit is contained in:
Simon Michael
parent
805c2dddd3
commit
41a3fb91d5
115
Ledger/Dates.hs
115
Ledger/Dates.hs
@ -8,8 +8,11 @@ We represent these as a triple of strings like ("2008","12",""),
|
||||
("","","tomorrow"), ("","last","week").
|
||||
|
||||
A 'DateSpan' is the span of time between two specific calendar dates, or
|
||||
possibly an open-ended span where one or both dates are missing. We use
|
||||
this term since "period" and "interval" are ambiguous.
|
||||
an open-ended span where one or both dates are unspecified. (A date span
|
||||
with both ends unspecified matches all dates.)
|
||||
|
||||
An 'Interval' is ledger's "reporting interval" - weekly, monthly,
|
||||
quarterly, etc.
|
||||
|
||||
-}
|
||||
|
||||
@ -53,10 +56,32 @@ elapsedSeconds t1 t2 = realToFrac $ diffUTCTime t1 t2
|
||||
dayToUTC :: Day -> UTCTime
|
||||
dayToUTC d = localTimeToUTC utc (LocalTime d midnight)
|
||||
|
||||
-- | Convert a period expression to a date span using the provided reference date.
|
||||
spanFromPeriodExpr refdate = fromparse . parsewith (periodexpr refdate)
|
||||
-- | Split a DateSpan into one or more consecutive spans at the specified interval.
|
||||
splitSpan :: Interval -> DateSpan -> [DateSpan]
|
||||
splitSpan i (DateSpan Nothing Nothing) = [DateSpan Nothing Nothing]
|
||||
splitSpan NoInterval s = [s]
|
||||
splitSpan Daily s = splitspan start next s where (start,next) = (startofday,nextday)
|
||||
splitSpan Weekly s = splitspan start next s where (start,next) = (startofweek,nextweek)
|
||||
splitSpan Monthly s = splitspan start next s where (start,next) = (startofmonth,nextmonth)
|
||||
splitSpan Quarterly s = splitspan start next s where (start,next) = (startofquarter,nextquarter)
|
||||
splitSpan Yearly s = splitspan start next s where (start,next) = (startofyear,nextyear)
|
||||
|
||||
splitspan _ _ (DateSpan Nothing Nothing) = []
|
||||
splitspan startof next (DateSpan Nothing (Just e)) = [DateSpan (Just $ startof e) (Just $ next $ startof e)]
|
||||
splitspan startof next (DateSpan (Just b) Nothing) = [DateSpan (Just $ startof b) (Just $ next $ startof b)]
|
||||
splitspan startof next (DateSpan (Just b) (Just e))
|
||||
| b >= e = []
|
||||
| otherwise = [DateSpan (Just $ startof b) (Just $ next $ startof b)]
|
||||
++ splitspan startof next (DateSpan (Just $ next $ startof b) (Just e))
|
||||
|
||||
-- | Convert a smart date string to a date span using the provided reference date.
|
||||
-- | Parse a period expression to an Interval and overall DateSpan using
|
||||
-- the provided reference date.
|
||||
parsePeriodExpr :: Day -> String -> (Interval, DateSpan)
|
||||
parsePeriodExpr refdate expr = (interval,span)
|
||||
where (interval,span) = fromparse $ parsewith (periodexpr refdate) expr
|
||||
|
||||
-- | Convert a single smart date string to a date span using the provided
|
||||
-- reference date.
|
||||
spanFromSmartDateString :: Day -> String -> DateSpan
|
||||
spanFromSmartDateString refdate s = spanFromSmartDate refdate sdate
|
||||
where
|
||||
@ -135,6 +160,7 @@ fixSmartDate refdate sdate = fix sdate
|
||||
prevday :: Day -> Day
|
||||
prevday = addDays (-1)
|
||||
nextday = addDays 1
|
||||
startofday = id
|
||||
|
||||
thisweek = startofweek
|
||||
prevweek = startofweek . addDays (-7)
|
||||
@ -292,21 +318,78 @@ lastthisnextthing = do
|
||||
]
|
||||
return ("",r,p)
|
||||
|
||||
periodexpr :: Day -> Parser DateSpan
|
||||
periodexpr rdate = try (doubledateperiod rdate) <|> (singledateperiod rdate)
|
||||
periodexpr :: Day -> Parser (Interval, DateSpan)
|
||||
periodexpr rdate = choice $ map try [
|
||||
intervalanddateperiodexpr rdate,
|
||||
intervalperiodexpr,
|
||||
dateperiodexpr rdate,
|
||||
(return $ (NoInterval,DateSpan Nothing Nothing))
|
||||
]
|
||||
|
||||
doubledateperiod :: Day -> Parser DateSpan
|
||||
doubledateperiod rdate = do
|
||||
string "from"
|
||||
intervalanddateperiodexpr :: Day -> Parser (Interval, DateSpan)
|
||||
intervalanddateperiodexpr rdate = do
|
||||
many spacenonewline
|
||||
i <- periodexprinterval
|
||||
many spacenonewline
|
||||
s <- periodexprdatespan rdate
|
||||
return (i,s)
|
||||
|
||||
intervalperiodexpr :: Parser (Interval, DateSpan)
|
||||
intervalperiodexpr = do
|
||||
many spacenonewline
|
||||
i <- periodexprinterval
|
||||
return (i, DateSpan Nothing Nothing)
|
||||
|
||||
dateperiodexpr :: Day -> Parser (Interval, DateSpan)
|
||||
dateperiodexpr rdate = do
|
||||
many spacenonewline
|
||||
s <- periodexprdatespan rdate
|
||||
return (NoInterval, s)
|
||||
|
||||
periodexprinterval :: Parser Interval
|
||||
periodexprinterval =
|
||||
choice $ map try [
|
||||
tryinterval "day" "daily" Daily,
|
||||
tryinterval "week" "weekly" Weekly,
|
||||
tryinterval "month" "monthly" Monthly,
|
||||
tryinterval "quarter" "quarterly" Quarterly,
|
||||
tryinterval "year" "yearly" Yearly
|
||||
]
|
||||
where
|
||||
tryinterval s1 s2 v =
|
||||
choice [try (string $ "every "++s1), try (string s2)] >> return v
|
||||
|
||||
periodexprdatespan :: Day -> Parser DateSpan
|
||||
periodexprdatespan rdate = choice $ map try [
|
||||
doubledatespan rdate,
|
||||
fromdatespan rdate,
|
||||
todatespan rdate,
|
||||
justdatespan rdate
|
||||
]
|
||||
|
||||
doubledatespan :: Day -> Parser DateSpan
|
||||
doubledatespan rdate = do
|
||||
optional (string "from" >> many spacenonewline)
|
||||
b <- smartdate
|
||||
many spacenonewline
|
||||
string "to"
|
||||
many spacenonewline
|
||||
optional (string "to" >> many spacenonewline)
|
||||
e <- smartdate
|
||||
let span = DateSpan (Just $ fixSmartDate rdate b) (Just $ fixSmartDate rdate e)
|
||||
return span
|
||||
return $ DateSpan (Just $ fixSmartDate rdate b) (Just $ fixSmartDate rdate e)
|
||||
|
||||
singledateperiod :: Day -> Parser DateSpan
|
||||
singledateperiod rdate = smartdate >>= return . spanFromSmartDate rdate
|
||||
fromdatespan :: Day -> Parser DateSpan
|
||||
fromdatespan rdate = do
|
||||
string "from" >> many spacenonewline
|
||||
b <- smartdate
|
||||
return $ DateSpan (Just $ fixSmartDate rdate b) Nothing
|
||||
|
||||
todatespan :: Day -> Parser DateSpan
|
||||
todatespan rdate = do
|
||||
string "to" >> many spacenonewline
|
||||
e <- smartdate
|
||||
return $ DateSpan Nothing (Just $ fixSmartDate rdate e)
|
||||
|
||||
justdatespan :: Day -> Parser DateSpan
|
||||
justdatespan rdate = do
|
||||
optional (string "in" >> many spacenonewline)
|
||||
d <- smartdate
|
||||
return $ spanFromSmartDate rdate d
|
||||
|
||||
@ -87,3 +87,11 @@ ledgerAccountTree depth l = treemap (ledgerAccount l) $ treeprune depth $ accoun
|
||||
-- | Get a ledger's tree of accounts rooted at the specified account.
|
||||
ledgerAccountTreeAt :: Ledger -> Account -> Maybe (Tree Account)
|
||||
ledgerAccountTreeAt l acct = subtreeat acct $ ledgerAccountTree 9999 l
|
||||
|
||||
-- | The (explicit) date span containing all the ledger's transactions,
|
||||
-- or DateSpan Nothing Nothing if there are no transactions.
|
||||
ledgerDateSpan l
|
||||
| null ts = DateSpan Nothing Nothing
|
||||
| otherwise = DateSpan (Just $ date $ head ts) (Just $ date $ last ts)
|
||||
where
|
||||
ts = sortBy (comparing date) $ ledgerTransactions l
|
||||
|
||||
@ -16,6 +16,9 @@ type SmartDate = (String,String,String)
|
||||
|
||||
data DateSpan = DateSpan (Maybe Day) (Maybe Day) deriving (Eq,Show,Ord)
|
||||
|
||||
data Interval = NoInterval | Daily | Weekly | Monthly | Quarterly | Yearly
|
||||
deriving (Eq,Show,Ord)
|
||||
|
||||
type AccountName = String
|
||||
|
||||
data Side = L | R deriving (Eq,Show,Ord)
|
||||
|
||||
34
NOTES
34
NOTES
@ -11,30 +11,7 @@ clever tricks like the plague." --Edsger Dijkstra
|
||||
* to do
|
||||
** errors
|
||||
** features
|
||||
*** period expressions, for ease of use
|
||||
**** from and/or to
|
||||
**** reporting intervals
|
||||
***** design types
|
||||
***** parse intervals
|
||||
every day
|
||||
every week
|
||||
every monthly
|
||||
every quarter
|
||||
every year
|
||||
every N days # N is any integer
|
||||
every N weeks
|
||||
every N months
|
||||
every N quarters
|
||||
every N years
|
||||
daily
|
||||
weekly
|
||||
biweekly
|
||||
monthly
|
||||
bimonthly
|
||||
quarterly
|
||||
yearly
|
||||
***** implement in register report
|
||||
***** -W/-M/-Y
|
||||
*** show empty reporting intervals with the -E option, for clarity/consistency/graphing
|
||||
*** actual/effective entry & txn dates, for completeness
|
||||
*** speed
|
||||
**** easy profiling
|
||||
@ -43,6 +20,15 @@ clever tricks like the plague." --Edsger Dijkstra
|
||||
*** ~/.hledgerrc, for setting defaults
|
||||
*** more ledger features from README (?)
|
||||
*** new features
|
||||
**** support complete period syntax ?
|
||||
every N days # N is any integer
|
||||
every N weeks
|
||||
every N months
|
||||
every N quarters
|
||||
every N years
|
||||
biweekly
|
||||
bimonthly
|
||||
**** -Q quarterly interval option, for consistency/convenience ?
|
||||
**** easy timelog queries when called as hours
|
||||
**** curses gui
|
||||
**** web gui
|
||||
|
||||
53
Options.hs
53
Options.hs
@ -50,6 +50,9 @@ options = [
|
||||
Option [] ["options-anywhere"] (NoArg OptionsAnywhere) "allow options anywhere, use ^ to negate patterns",
|
||||
Option ['n'] ["collapse"] (NoArg Collapse) "balance report: no grand total",
|
||||
Option ['s'] ["subtotal"] (NoArg SubTotal) "balance report: show subaccounts",
|
||||
Option ['W'] ["weekly"] (NoArg WeeklyOpt) "register report: show weekly summary",
|
||||
Option ['M'] ["monthly"] (NoArg MonthlyOpt) "register report: show monthly summary",
|
||||
Option ['Y'] ["yearly"] (NoArg YearlyOpt) "register report: show yearly summary",
|
||||
Option ['h'] ["help"] (NoArg Help) "show this help",
|
||||
Option ['v'] ["verbose"] (NoArg Verbose) "verbose test output",
|
||||
Option ['V'] ["version"] (NoArg Version) "show version"
|
||||
@ -73,15 +76,24 @@ data Opt =
|
||||
OptionsAnywhere |
|
||||
Collapse |
|
||||
SubTotal |
|
||||
WeeklyOpt |
|
||||
MonthlyOpt |
|
||||
YearlyOpt |
|
||||
Help |
|
||||
Verbose |
|
||||
Version
|
||||
deriving (Show,Eq)
|
||||
|
||||
-- yow..
|
||||
optsWithConstructor f opts = concatMap get opts
|
||||
where get o = if f v == o then [o] else [] where v = value o
|
||||
|
||||
optValuesForConstructor f opts = concatMap get opts
|
||||
where get o = if f v == o then [v] else [] where v = value o
|
||||
|
||||
optValuesForConstructors fs opts = concatMap get opts
|
||||
where get o = if any (\f -> f v == o) fs then [v] else [] where v = value o
|
||||
|
||||
-- | Parse the command-line arguments into ledger options, ledger command
|
||||
-- name, and ledger command arguments. Also any dates in the options are
|
||||
-- converted to full YYYY/MM/DD format, while we are in the IO monad
|
||||
@ -109,22 +121,37 @@ fixOptDates opts = do
|
||||
where fixbracketeddatestr s = "[" ++ (fixSmartDateStr t $ init $ tail s) ++ "]"
|
||||
fixopt _ o = o
|
||||
|
||||
-- | Figure out the date span we should report on, based on any
|
||||
-- begin/end/period options provided. This could be really smart but I'm
|
||||
-- just going to look for 1. the first Period or 2. the first Begin and
|
||||
-- first End.
|
||||
-- | Figure out the overall date span we should report on, based on any
|
||||
-- begin/end/period options provided. If there is a period option, the
|
||||
-- others are ignored.
|
||||
dateSpanFromOpts :: Day -> [Opt] -> DateSpan
|
||||
dateSpanFromOpts refdate opts
|
||||
| not $ null ps = spanFromPeriodExpr refdate $ head ps
|
||||
dateSpanFromOpts refdate opts
|
||||
| not $ null popts = snd $ parsePeriodExpr refdate $ head popts
|
||||
| otherwise = DateSpan firstb firste
|
||||
where
|
||||
ps = optValuesForConstructor Period opts
|
||||
firstb = listtomaybeday $ optValuesForConstructor Begin opts
|
||||
firste = listtomaybeday $ optValuesForConstructor End opts
|
||||
listtomaybeday [] = Nothing
|
||||
listtomaybeday vs = Just $ parse $ head vs
|
||||
parse s = parsedate $ printf "%04s/%02s/%02s" y m d
|
||||
where (y,m,d) = fromparse $ parsewith smartdate $ s
|
||||
popts = optValuesForConstructor Period opts
|
||||
bopts = optValuesForConstructor Begin opts
|
||||
eopts = optValuesForConstructor End opts
|
||||
firstb = listtomaybeday bopts
|
||||
firste = listtomaybeday eopts
|
||||
listtomaybeday vs = if null vs then Nothing else Just $ parse $ head vs
|
||||
where parse = parsedate . fixSmartDateStr refdate
|
||||
|
||||
-- | Figure out the reporting interval, if any, specified by the options.
|
||||
-- If there is a period option, the others are ignored.
|
||||
intervalFromOpts :: [Opt] -> Interval
|
||||
intervalFromOpts opts
|
||||
| not $ null popts = fst $ parsePeriodExpr refdate $ head popts
|
||||
| otherwise = case otheropts of
|
||||
[] -> NoInterval
|
||||
(WeeklyOpt:_) -> Weekly
|
||||
(MonthlyOpt:_) -> Monthly
|
||||
(YearlyOpt:_) -> Yearly
|
||||
where
|
||||
popts = optValuesForConstructor Period opts
|
||||
otheropts = filter (`elem` [WeeklyOpt,MonthlyOpt,YearlyOpt]) opts
|
||||
-- doesn't affect the interval, but parsePeriodExpr needs something
|
||||
refdate = parsedate "0001/01/01"
|
||||
|
||||
-- | Get the value of the (first) depth option, if any.
|
||||
depthFromOpts :: [Opt] -> Maybe Int
|
||||
|
||||
8
README
8
README
@ -158,8 +158,12 @@ Other differences
|
||||
* hledger keeps differently-priced amounts of the same commodity separate, at the moment
|
||||
* hledger refers to the entry and transaction "description", ledger calls it "note"
|
||||
* hledger doesn't require a space after flags like -f
|
||||
* hledger always shows timelog balances in hours
|
||||
* hledger doesn't parse all ledger file constructs (and may choke ? please report)
|
||||
* hledger doesn't count an unfinished timelog session
|
||||
* hledger interprets "last/this/next week" as weeks beginning on monday
|
||||
* hledger provides "--cost" as a synonym for "--basis"
|
||||
* hledger's "weekly" reporting intervals always start on mondays
|
||||
* hledger shows start and end dates of full intervals, not just the span containing data
|
||||
* hledger period expressions don't support "biweekly", "bimonthly", or "every N days/weeks/..."
|
||||
* hledger always shows timelog balances in hours
|
||||
* hledger doesn't count an unfinished timelog session
|
||||
* (disabled for now: hledger counts timelog sessions on the day they end, ledger on the day they start)
|
||||
|
||||
@ -6,6 +6,8 @@ A ledger-compatible @register@ command.
|
||||
|
||||
module RegisterCommand
|
||||
where
|
||||
import qualified Data.Map as Map
|
||||
import Data.Map ((!))
|
||||
import Ledger
|
||||
import Options
|
||||
|
||||
@ -26,32 +28,85 @@ DDDDDDDDDD dddddddddddddddddddd aaaaaaaaaaaaaaaaaaaaaa AAAAAAAAAAA AAAAAAAAAAAA
|
||||
@
|
||||
-}
|
||||
showRegisterReport :: [Opt] -> [String] -> Ledger -> String
|
||||
showRegisterReport opts args l = showtxns ts nulltxn nullmixedamt
|
||||
showRegisterReport opts args l
|
||||
| interval == NoInterval = showtxns ts nulltxn nullmixedamt
|
||||
| otherwise = showtxns summaryts nulltxn nullmixedamt
|
||||
where
|
||||
ts = filter matchapats $ ledgerTransactions l
|
||||
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
|
||||
|
||||
-- show display-filtered transactions, one per line, with a running balance
|
||||
showtxns [] _ _ = ""
|
||||
showtxns (t@Transaction{amount=a}:ts) tprev bal =
|
||||
(if (isZeroMixedAmount a || (not $ matchdisplayopt dopt t)) then "" else this) ++ showtxns ts t bal'
|
||||
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
|
||||
this = showtxn (t `issame` tprev) t bal'
|
||||
issame t1 t2 = entryno t1 == entryno t2
|
||||
bal' = bal + amount t
|
||||
b' = fromMaybe (date $ head ts) b
|
||||
e' = fromMaybe (date $ last ts) e
|
||||
|
||||
-- show one transaction line, 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
|
||||
-- | 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
|
||||
|
||||
|
||||
55
Tests.hs
55
Tests.hs
@ -129,6 +129,33 @@ misc_tests = TestList [
|
||||
"this year" `gives` "2008/01/01"
|
||||
"last year" `gives` "2007/01/01"
|
||||
"next year" `gives` "2009/01/01"
|
||||
,
|
||||
"dateSpanFromOpts" ~: do
|
||||
let todaysdate = parsedate "2008/11/26"
|
||||
let opts `gives` spans = assertequal spans (show $ dateSpanFromOpts todaysdate opts)
|
||||
[] `gives` "DateSpan Nothing Nothing"
|
||||
[Begin "2008", End "2009"] `gives` "DateSpan (Just 2008-01-01) (Just 2009-01-01)"
|
||||
[Period "in 2008"] `gives` "DateSpan (Just 2008-01-01) (Just 2009-01-01)"
|
||||
[Begin "2005", End "2007",Period "in 2008"] `gives` "DateSpan (Just 2008-01-01) (Just 2009-01-01)"
|
||||
,
|
||||
"intervalFromOpts" ~: do
|
||||
let opts `gives` interval = assertequal interval (intervalFromOpts opts)
|
||||
[] `gives` NoInterval
|
||||
[WeeklyOpt] `gives` Weekly
|
||||
[MonthlyOpt] `gives` Monthly
|
||||
[YearlyOpt] `gives` Yearly
|
||||
[Period "weekly"] `gives` Weekly
|
||||
[Period "monthly"] `gives` Monthly
|
||||
[WeeklyOpt, Period "yearly"] `gives` Yearly
|
||||
,
|
||||
"period expressions" ~: do
|
||||
let todaysdate = parsedate "2008/11/26"
|
||||
let str `gives` result = assertequal ("Right "++result) (show $ parsewith (periodexpr todaysdate) str)
|
||||
"from aug to oct" `gives` "(NoInterval,DateSpan (Just 2008-08-01) (Just 2008-10-01))"
|
||||
"aug to oct" `gives` "(NoInterval,DateSpan (Just 2008-08-01) (Just 2008-10-01))"
|
||||
"every day from aug to oct" `gives` "(Daily,DateSpan (Just 2008-08-01) (Just 2008-10-01))"
|
||||
"daily from aug" `gives` "(Daily,DateSpan (Just 2008-08-01) Nothing)"
|
||||
"every week to 2009" `gives` "(Weekly,DateSpan Nothing (Just 2009-01-01))"
|
||||
]
|
||||
|
||||
balancereportacctnames_tests = TestList
|
||||
@ -354,10 +381,26 @@ registercommand_tests = TestList [
|
||||
,
|
||||
"register report with period expression" ~:
|
||||
do
|
||||
"" `periodexprgives` ["2008/01/01","2008/06/01","2008/06/02","2008/06/03","2008/12/31"]
|
||||
"" `periodexprgives` ["2008/01/01","2008/06/01","2008/06/02","2008/06/03","2008/12/31"]
|
||||
"2008" `periodexprgives` ["2008/01/01","2008/06/01","2008/06/02","2008/06/03","2008/12/31"]
|
||||
-- need to get datespan into ledgerFromString, or preconvert period expressions
|
||||
-- "2007" `periodexprgives` []
|
||||
"2007" `periodexprgives` []
|
||||
"june" `periodexprgives` ["2008/06/01","2008/06/02","2008/06/03"]
|
||||
|
||||
let l = ledgerfromstring [] sample_ledger_str
|
||||
assertequal (
|
||||
"2008/01/01 - 2008/12/31 assets:cash $-2 $-2\n" ++
|
||||
" assets:saving $1 $-1\n" ++
|
||||
" expenses:food $1 0\n" ++
|
||||
" expenses:supplies $1 $1\n" ++
|
||||
" income:gifts $-1 0\n" ++
|
||||
" income:salary $-1 $-1\n" ++
|
||||
" liabilities:debts $1 0\n" ++
|
||||
"")
|
||||
(showRegisterReport [Period "yearly"] [] l)
|
||||
|
||||
assertequal ["2008/01/01","2008/04/01","2008/10/01"] (datesfromregister $ showRegisterReport [Period "quarterly"] [] l)
|
||||
-- assertequal ["2008/01/01","2008/04/01","2008/07/01","2008/10/01"] (datesfromregister $ showRegisterReport [Period "quarterly"] [] l)
|
||||
|
||||
]
|
||||
where
|
||||
expr `displayexprgives` dates =
|
||||
@ -369,9 +412,9 @@ registercommand_tests = TestList [
|
||||
assertequal dates (datesfromregister r)
|
||||
where
|
||||
r = showRegisterReport [Period expr] [] l
|
||||
l = ledgerfromstring [] sample_ledger_str
|
||||
|
||||
datesfromregister = filter (not . null) . map (strip . take 10) . lines
|
||||
l = ledgerfromstringwithopts [Period expr] [] refdate sample_ledger_str
|
||||
refdate = parsedate "2008/11/26"
|
||||
datesfromregister = filter (not . null) . map (strip . take 10) . lines
|
||||
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
Loading…
Reference in New Issue
Block a user