forked from simonmichael/hledger
/
ReportOptions.hs
395 lines (351 loc) · 14.8 KB
/
ReportOptions.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
{-# LANGUAGE CPP, RecordWildCards, DeriveDataTypeable #-}
{-|
Options common to most hledger reports.
-}
module Hledger.Reports.ReportOptions (
ReportOpts(..),
BalanceType(..),
AccountListMode(..),
FormatStr,
defreportopts,
rawOptsToReportOpts,
checkReportOpts,
flat_,
tree_,
whichDateFromOpts,
journalSelectingAmountFromOpts,
queryFromOpts,
queryFromOptsOnly,
queryOptsFromOpts,
transactionDateFn,
postingDateFn,
reportStartDate,
reportEndDate,
reportStartEndDates,
tests_Hledger_Reports_ReportOptions
)
where
import Data.Data (Data)
#if !MIN_VERSION_base(4,8,0)
import Data.Functor.Compat ((<$>))
#endif
import Data.Maybe
import qualified Data.Text as T
import Data.Typeable (Typeable)
import Data.Time.Calendar
import Data.Default
import Safe
import Test.HUnit
import Text.Megaparsec.Error
import Hledger.Data
import Hledger.Query
import Hledger.Utils
type FormatStr = String
-- | Which "balance" is being shown in a balance report.
data BalanceType = PeriodChange -- ^ The change of balance in each period.
| CumulativeChange -- ^ The accumulated change across multiple periods.
| HistoricalBalance -- ^ The historical ending balance, including the effect of
-- all postings before the report period. Unless altered by,
-- a query, this is what you would see on a bank statement.
deriving (Eq,Show,Data,Typeable)
instance Default BalanceType where def = PeriodChange
-- | Should accounts be displayed: in the command's default style, hierarchically, or as a flat list ?
data AccountListMode = ALDefault | ALTree | ALFlat deriving (Eq, Show, Data, Typeable)
instance Default AccountListMode where def = ALDefault
-- | Standard options for customising report filtering and output,
-- corresponding to hledger's command-line options and query language
-- arguments. Used in hledger-lib and above.
data ReportOpts = ReportOpts {
period_ :: Period
,interval_ :: Interval
,clearedstatus_ :: Maybe ClearedStatus
,cost_ :: Bool
,depth_ :: Maybe Int
,display_ :: Maybe DisplayExp
,date2_ :: Bool
,empty_ :: Bool
,no_elide_ :: Bool
,real_ :: Bool
,format_ :: Maybe FormatStr
,query_ :: String -- all arguments, as a string
-- register only
,average_ :: Bool
,related_ :: Bool
-- balance only
,balancetype_ :: BalanceType
,accountlistmode_ :: AccountListMode
,drop_ :: Int
,row_total_ :: Bool
,no_total_ :: Bool
,value_ :: Bool
,pretty_tables_ :: Bool
} deriving (Show, Data, Typeable)
instance Default ReportOpts where def = defreportopts
instance Default Bool where def = False
defreportopts :: ReportOpts
defreportopts = ReportOpts
def
def
def
def
def
def
def
def
def
def
def
def
def
def
def
def
def
def
def
def
def
rawOptsToReportOpts :: RawOpts -> IO ReportOpts
rawOptsToReportOpts rawopts = checkReportOpts <$> do
d <- getCurrentDay
let rawopts' = checkRawOpts rawopts
return defreportopts{
period_ = periodFromRawOpts d rawopts'
,interval_ = intervalFromRawOpts rawopts'
,clearedstatus_ = clearedStatusFromRawOpts rawopts'
,cost_ = boolopt "cost" rawopts'
,depth_ = maybeintopt "depth" rawopts'
,display_ = maybedisplayopt d rawopts'
,date2_ = boolopt "date2" rawopts'
,empty_ = boolopt "empty" rawopts'
,no_elide_ = boolopt "no-elide" rawopts'
,real_ = boolopt "real" rawopts'
,format_ = maybestringopt "format" rawopts' -- XXX move to CliOpts or move validation from Cli.CliOptions to here
,query_ = unwords $ listofstringopt "args" rawopts' -- doesn't handle an arg like "" right
,average_ = boolopt "average" rawopts'
,related_ = boolopt "related" rawopts'
,balancetype_ = balancetypeopt rawopts'
,accountlistmode_ = accountlistmodeopt rawopts'
,drop_ = intopt "drop" rawopts'
,row_total_ = boolopt "row-total" rawopts'
,no_total_ = boolopt "no-total" rawopts'
,value_ = boolopt "value" rawopts'
,pretty_tables_ = boolopt "pretty-tables" rawopts'
}
-- | Do extra validation of raw option values, raising an error if there's a problem.
checkRawOpts :: RawOpts -> RawOpts
checkRawOpts rawopts
-- our standard behaviour is to accept conflicting options actually,
-- using the last one - more forgiving for overriding command-line aliases
-- | countopts ["change","cumulative","historical"] > 1
-- = optserror "please specify at most one of --change, --cumulative, --historical"
-- | countopts ["flat","tree"] > 1
-- = optserror "please specify at most one of --flat, --tree"
-- | countopts ["daily","weekly","monthly","quarterly","yearly"] > 1
-- = optserror "please specify at most one of --daily, "
| otherwise = rawopts
-- where
-- countopts = length . filter (`boolopt` rawopts)
-- | Do extra validation of report options, raising an error if there's a problem.
checkReportOpts :: ReportOpts -> ReportOpts
checkReportOpts ropts@ReportOpts{..} =
either optserror (const ropts) $ do
case depth_ of
Just d | d < 0 -> Left "--depth should have a positive number"
_ -> Right ()
accountlistmodeopt :: RawOpts -> AccountListMode
accountlistmodeopt rawopts =
case reverse $ filter (`elem` ["tree","flat"]) $ map fst rawopts of
("tree":_) -> ALTree
("flat":_) -> ALFlat
_ -> ALDefault
balancetypeopt :: RawOpts -> BalanceType
balancetypeopt rawopts =
case reverse $ filter (`elem` ["change","cumulative","historical"]) $ map fst rawopts of
("historical":_) -> HistoricalBalance
("cumulative":_) -> CumulativeChange
_ -> PeriodChange
-- Get the period specified by the intersection of -b/--begin, -e/--end and/or
-- -p/--period options, using the given date to interpret relative date expressions.
periodFromRawOpts :: Day -> RawOpts -> Period
periodFromRawOpts d rawopts =
case (mearliestb, mlateste) of
(Nothing, Nothing) -> PeriodAll
(Just b, Nothing) -> PeriodFrom b
(Nothing, Just e) -> PeriodTo e
(Just b, Just e) -> simplifyPeriod $
PeriodBetween b e
where
mearliestb = case beginDatesFromRawOpts d rawopts of
[] -> Nothing
bs -> Just $ minimum bs
mlateste = case endDatesFromRawOpts d rawopts of
[] -> Nothing
es -> Just $ maximum es
-- Get all begin dates specified by -b/--begin or -p/--period options, in order,
-- using the given date to interpret relative date expressions.
beginDatesFromRawOpts :: Day -> RawOpts -> [Day]
beginDatesFromRawOpts d = catMaybes . map (begindatefromrawopt d)
where
begindatefromrawopt d (n,v)
| n == "begin" =
either (\e -> optserror $ "could not parse "++n++" date: "++parseErrorPretty e) Just $
fixSmartDateStrEither' d (T.pack v)
| n == "period" =
case
either (\e -> optserror $ "could not parse period option: "++parseErrorPretty e) id $
parsePeriodExpr d (stripquotes $ T.pack v)
of
(_, DateSpan (Just b) _) -> Just b
_ -> Nothing
| otherwise = Nothing
-- Get all end dates specified by -e/--end or -p/--period options, in order,
-- using the given date to interpret relative date expressions.
endDatesFromRawOpts :: Day -> RawOpts -> [Day]
endDatesFromRawOpts d = catMaybes . map (enddatefromrawopt d)
where
enddatefromrawopt d (n,v)
| n == "end" =
either (\e -> optserror $ "could not parse "++n++" date: "++parseErrorPretty e) Just $
fixSmartDateStrEither' d (T.pack v)
| n == "period" =
case
either (\e -> optserror $ "could not parse period option: "++parseErrorPretty e) id $
parsePeriodExpr d (stripquotes $ T.pack v)
of
(_, DateSpan _ (Just e)) -> Just e
_ -> Nothing
| otherwise = Nothing
-- | Get the report interval, if any, specified by the last of -p/--period,
-- -D/--daily, -W/--weekly, -M/--monthly etc. options.
intervalFromRawOpts :: RawOpts -> Interval
intervalFromRawOpts = lastDef NoInterval . catMaybes . map intervalfromrawopt
where
intervalfromrawopt (n,v)
| n == "period" =
either (\e -> optserror $ "could not parse period option: "++parseErrorPretty e) (Just . fst) $
parsePeriodExpr nulldate (stripquotes $ T.pack v) -- reference date does not affect the interval
| n == "daily" = Just $ Days 1
| n == "weekly" = Just $ Weeks 1
| n == "monthly" = Just $ Months 1
| n == "quarterly" = Just $ Quarters 1
| n == "yearly" = Just $ Years 1
| otherwise = Nothing
-- | Get the cleared status, if any, specified by the last of -C/--cleared,
-- --pending, -U/--uncleared options.
clearedStatusFromRawOpts :: RawOpts -> Maybe ClearedStatus
clearedStatusFromRawOpts = lastMay . catMaybes . map clearedstatusfromrawopt
where
clearedstatusfromrawopt (n,_)
| n == "cleared" = Just Cleared
| n == "pending" = Just Pending
| n == "uncleared" = Just Uncleared
| otherwise = Nothing
type DisplayExp = String
maybedisplayopt :: Day -> RawOpts -> Maybe DisplayExp
maybedisplayopt d rawopts =
maybe Nothing (Just . regexReplaceBy "\\[.+?\\]" fixbracketeddatestr) $ maybestringopt "display" rawopts
where
fixbracketeddatestr "" = ""
fixbracketeddatestr s = "[" ++ fixSmartDateStr d (T.pack $ init $ tail s) ++ "]"
-- | Select the Transaction date accessor based on --date2.
transactionDateFn :: ReportOpts -> (Transaction -> Day)
transactionDateFn ReportOpts{..} = if date2_ then transactionDate2 else tdate
-- | Select the Posting date accessor based on --date2.
postingDateFn :: ReportOpts -> (Posting -> Day)
postingDateFn ReportOpts{..} = if date2_ then postingDate2 else postingDate
-- | Report which date we will report on based on --date2.
whichDateFromOpts :: ReportOpts -> WhichDate
whichDateFromOpts ReportOpts{..} = if date2_ then SecondaryDate else PrimaryDate
-- | Legacy-compatible convenience aliases for accountlistmode_.
tree_ :: ReportOpts -> Bool
tree_ = (==ALTree) . accountlistmode_
flat_ :: ReportOpts -> Bool
flat_ = (==ALFlat) . accountlistmode_
-- depthFromOpts :: ReportOpts -> Int
-- depthFromOpts opts = min (fromMaybe 99999 $ depth_ opts) (queryDepth $ queryFromOpts nulldate opts)
-- | Convert this journal's postings' amounts to the cost basis amounts if
-- specified by options.
journalSelectingAmountFromOpts :: ReportOpts -> Journal -> Journal
journalSelectingAmountFromOpts opts
| cost_ opts = journalConvertAmountsToCost
| otherwise = id
-- | Convert report options and arguments to a query.
queryFromOpts :: Day -> ReportOpts -> Query
queryFromOpts d ReportOpts{..} = simplifyQuery $ And $ [flagsq, argsq]
where
flagsq = And $
[(if date2_ then Date2 else Date) $ periodAsDateSpan period_]
++ (if real_ then [Real True] else [])
++ (if empty_ then [Empty True] else []) -- ?
++ (maybe [] ((:[]) . Status) clearedstatus_)
++ (maybe [] ((:[]) . Depth) depth_)
argsq = fst $ parseQuery d (T.pack query_)
-- | Convert report options to a query, ignoring any non-flag command line arguments.
queryFromOptsOnly :: Day -> ReportOpts -> Query
queryFromOptsOnly _d ReportOpts{..} = simplifyQuery flagsq
where
flagsq = And $
[(if date2_ then Date2 else Date) $ periodAsDateSpan period_]
++ (if real_ then [Real True] else [])
++ (if empty_ then [Empty True] else []) -- ?
++ (maybe [] ((:[]) . Status) clearedstatus_)
++ (maybe [] ((:[]) . Depth) depth_)
tests_queryFromOpts :: [Test]
tests_queryFromOpts = [
"queryFromOpts" ~: do
assertEqual "" Any (queryFromOpts nulldate defreportopts)
assertEqual "" (Acct "a") (queryFromOpts nulldate defreportopts{query_="a"})
assertEqual "" (Desc "a a") (queryFromOpts nulldate defreportopts{query_="desc:'a a'"})
assertEqual "" (Date $ mkdatespan "2012/01/01" "2013/01/01")
(queryFromOpts nulldate defreportopts{period_=PeriodFrom (parsedate "2012/01/01")
,query_="date:'to 2013'"
})
assertEqual "" (Date2 $ mkdatespan "2012/01/01" "2013/01/01")
(queryFromOpts nulldate defreportopts{query_="date2:'in 2012'"})
assertEqual "" (Or [Acct "a a", Acct "'b"])
(queryFromOpts nulldate defreportopts{query_="'a a' 'b"})
]
-- | Convert report options and arguments to query options.
queryOptsFromOpts :: Day -> ReportOpts -> [QueryOpt]
queryOptsFromOpts d ReportOpts{..} = flagsqopts ++ argsqopts
where
flagsqopts = []
argsqopts = snd $ parseQuery d (T.pack query_)
tests_queryOptsFromOpts :: [Test]
tests_queryOptsFromOpts = [
"queryOptsFromOpts" ~: do
assertEqual "" [] (queryOptsFromOpts nulldate defreportopts)
assertEqual "" [] (queryOptsFromOpts nulldate defreportopts{query_="a"})
assertEqual "" [] (queryOptsFromOpts nulldate defreportopts{period_=PeriodFrom (parsedate "2012/01/01")
,query_="date:'to 2013'"
})
]
-- | The effective report start date is the one specified by options or queries,
-- otherwise the earliest transaction or posting date in the journal,
-- otherwise (for an empty journal) nothing.
-- Needs IO to parse smart dates in options/queries.
reportStartDate :: Journal -> ReportOpts -> IO (Maybe Day)
reportStartDate j ropts = (fst <$>) <$> reportStartEndDates j ropts
-- | The effective report end date is the one specified by options or queries,
-- otherwise the latest transaction or posting date in the journal,
-- otherwise (for an empty journal) nothing.
-- Needs IO to parse smart dates in options/queries.
reportEndDate :: Journal -> ReportOpts -> IO (Maybe Day)
reportEndDate j ropts = (snd <$>) <$> reportStartEndDates j ropts
reportStartEndDates :: Journal -> ReportOpts -> IO (Maybe (Day,Day))
reportStartEndDates j ropts = do
today <- getCurrentDay
let
q = queryFromOpts today ropts
mrequestedstartdate = queryStartDate False q
mrequestedenddate = queryEndDate False q
return $
case journalDateSpan False j of -- don't bother with secondary dates
DateSpan (Just journalstartdate) (Just journalenddate) ->
Just (fromMaybe journalstartdate mrequestedstartdate, fromMaybe journalenddate mrequestedenddate)
_ -> Nothing
tests_Hledger_Reports_ReportOptions :: Test
tests_Hledger_Reports_ReportOptions = TestList $
tests_queryFromOpts
++ tests_queryOptsFromOpts