lib: abstract period/interval/cleared in ReportOpts
This commit is contained in:
parent
7d81adcefa
commit
fe6d4cc7da
@ -132,3 +132,12 @@ showPeriod (PeriodFrom b) = formatTime defaultTimeLocale "%0C%y/%m/%d-" b
|
|||||||
showPeriod (PeriodTo e) = formatTime defaultTimeLocale "-%0C%y/%m/%d" (addDays (-1) e) -- -INCLUSIVEENDDATE
|
showPeriod (PeriodTo e) = formatTime defaultTimeLocale "-%0C%y/%m/%d" (addDays (-1) e) -- -INCLUSIVEENDDATE
|
||||||
showPeriod PeriodAll = "-"
|
showPeriod PeriodAll = "-"
|
||||||
|
|
||||||
|
periodStart :: Period -> Maybe Day
|
||||||
|
periodStart p = mb
|
||||||
|
where
|
||||||
|
DateSpan mb _ = periodAsDateSpan p
|
||||||
|
|
||||||
|
periodEnd :: Period -> Maybe Day
|
||||||
|
periodEnd p = me
|
||||||
|
where
|
||||||
|
DateSpan _ me = periodAsDateSpan p
|
||||||
|
|||||||
@ -180,13 +180,13 @@ type TagValue = Text
|
|||||||
type Tag = (TagName, TagValue) -- ^ A tag name and (possibly empty) value.
|
type Tag = (TagName, TagValue) -- ^ A tag name and (possibly empty) value.
|
||||||
|
|
||||||
data ClearedStatus = Uncleared | Pending | Cleared
|
data ClearedStatus = Uncleared | Pending | Cleared
|
||||||
deriving (Eq,Ord,Typeable,Data,Generic)
|
deriving (Eq,Ord,Typeable,Data,Generic)
|
||||||
|
|
||||||
instance NFData ClearedStatus
|
instance NFData ClearedStatus
|
||||||
|
|
||||||
instance Show ClearedStatus where -- custom show
|
instance Show ClearedStatus where -- custom show.. bad idea.. don't do it..
|
||||||
show Uncleared = "" -- a bad idea
|
show Uncleared = ""
|
||||||
show Pending = "!" -- don't do it
|
show Pending = "!"
|
||||||
show Cleared = "*"
|
show Cleared = "*"
|
||||||
|
|
||||||
data Posting = Posting {
|
data Posting = Posting {
|
||||||
|
|||||||
@ -84,7 +84,7 @@ multiBalanceReport opts q j = MultiBalanceReport (displayspans, items, totalsrow
|
|||||||
precedingq = dbg1 "precedingq" $ And [datelessq, dateqcons $ DateSpan Nothing (spanStart reportspan)]
|
precedingq = dbg1 "precedingq" $ And [datelessq, dateqcons $ DateSpan Nothing (spanStart reportspan)]
|
||||||
requestedspan = dbg1 "requestedspan" $ queryDateSpan (date2_ opts) q -- span specified by -b/-e/-p options and query args
|
requestedspan = dbg1 "requestedspan" $ queryDateSpan (date2_ opts) q -- span specified by -b/-e/-p options and query args
|
||||||
requestedspan' = dbg1 "requestedspan'" $ requestedspan `spanDefaultsFrom` journalDateSpan (date2_ opts) j -- if open-ended, close it using the journal's end dates
|
requestedspan' = dbg1 "requestedspan'" $ requestedspan `spanDefaultsFrom` journalDateSpan (date2_ opts) j -- if open-ended, close it using the journal's end dates
|
||||||
intervalspans = dbg1 "intervalspans" $ splitSpan (intervalFromOpts opts) requestedspan' -- interval spans enclosing it
|
intervalspans = dbg1 "intervalspans" $ splitSpan (interval_ opts) requestedspan' -- interval spans enclosing it
|
||||||
reportspan = dbg1 "reportspan" $ DateSpan (maybe Nothing spanStart $ headMay intervalspans) -- the requested span enlarged to a whole number of intervals
|
reportspan = dbg1 "reportspan" $ DateSpan (maybe Nothing spanStart $ headMay intervalspans) -- the requested span enlarged to a whole number of intervals
|
||||||
(maybe Nothing spanEnd $ lastMay intervalspans)
|
(maybe Nothing spanEnd $ lastMay intervalspans)
|
||||||
newdatesq = dbg1 "newdateq" $ dateqcons reportspan
|
newdatesq = dbg1 "newdateq" $ dateqcons reportspan
|
||||||
@ -97,7 +97,7 @@ multiBalanceReport opts q j = MultiBalanceReport (displayspans, items, totalsrow
|
|||||||
filterJournalPostings reportq $ -- remove postings not matched by (adjusted) query
|
filterJournalPostings reportq $ -- remove postings not matched by (adjusted) query
|
||||||
journalSelectingAmountFromOpts opts j
|
journalSelectingAmountFromOpts opts j
|
||||||
|
|
||||||
displayspans = dbg1 "displayspans" $ splitSpan (intervalFromOpts opts) displayspan
|
displayspans = dbg1 "displayspans" $ splitSpan (interval_ opts) displayspan
|
||||||
where
|
where
|
||||||
displayspan
|
displayspan
|
||||||
| empty_ opts = dbg1 "displayspan (-E)" $ reportspan -- all the requested intervals
|
| empty_ opts = dbg1 "displayspan (-E)" $ reportspan -- all the requested intervals
|
||||||
|
|||||||
@ -66,7 +66,7 @@ postingsReport opts q j = (totallabel, items)
|
|||||||
displayps | interval == NoInterval = map (,Nothing) reportps
|
displayps | interval == NoInterval = map (,Nothing) reportps
|
||||||
| otherwise = summarisePostingsByInterval interval whichdate depth showempty reportspan reportps
|
| otherwise = summarisePostingsByInterval interval whichdate depth showempty reportspan reportps
|
||||||
where
|
where
|
||||||
interval = intervalFromOpts opts -- XXX
|
interval = interval_ opts -- XXX
|
||||||
showempty = empty_ opts || average_ opts
|
showempty = empty_ opts || average_ opts
|
||||||
|
|
||||||
-- posting report items ready for display
|
-- posting report items ready for display
|
||||||
@ -93,7 +93,7 @@ adjustReportDates opts q j = reportspan
|
|||||||
dates = journalDateSpan False j
|
dates = journalDateSpan False j
|
||||||
date2s = journalDateSpan True j
|
date2s = journalDateSpan True j
|
||||||
requestedspanclosed = dbg1 "requestedspanclosed" $ requestedspan `spanDefaultsFrom` journalspan -- if open-ended, close it using the journal's dates (if any)
|
requestedspanclosed = dbg1 "requestedspanclosed" $ requestedspan `spanDefaultsFrom` journalspan -- if open-ended, close it using the journal's dates (if any)
|
||||||
intervalspans = dbg1 "intervalspans" $ splitSpan (intervalFromOpts opts) requestedspanclosed -- get the whole intervals enclosing that
|
intervalspans = dbg1 "intervalspans" $ splitSpan (interval_ opts) requestedspanclosed -- get the whole intervals enclosing that
|
||||||
mreportstart = dbg1 "reportstart" $ maybe Nothing spanStart $ headMay intervalspans -- start of the first interval, or open ended
|
mreportstart = dbg1 "reportstart" $ maybe Nothing spanStart $ headMay intervalspans -- start of the first interval, or open ended
|
||||||
mreportend = dbg1 "reportend" $ maybe Nothing spanEnd $ lastMay intervalspans -- end of the last interval, or open ended
|
mreportend = dbg1 "reportend" $ maybe Nothing spanEnd $ lastMay intervalspans -- end of the last interval, or open ended
|
||||||
reportspan = dbg1 "reportspan" $ DateSpan mreportstart mreportend -- the requested span enlarged to whole intervals if possible
|
reportspan = dbg1 "reportspan" $ DateSpan mreportstart mreportend -- the requested span enlarged to whole intervals if possible
|
||||||
@ -262,8 +262,8 @@ tests_postingsReport = [
|
|||||||
|
|
||||||
-- with query and/or command-line options
|
-- with query and/or command-line options
|
||||||
assertEqual "" 11 (length $ snd $ postingsReport defreportopts Any samplejournal)
|
assertEqual "" 11 (length $ snd $ postingsReport defreportopts Any samplejournal)
|
||||||
assertEqual "" 9 (length $ snd $ postingsReport defreportopts{monthly_=True} Any samplejournal)
|
assertEqual "" 9 (length $ snd $ postingsReport defreportopts{interval_=Months 1} Any samplejournal)
|
||||||
assertEqual "" 19 (length $ snd $ postingsReport defreportopts{monthly_=True, empty_=True} Any samplejournal)
|
assertEqual "" 19 (length $ snd $ postingsReport defreportopts{interval_=Months 1, empty_=True} Any samplejournal)
|
||||||
assertEqual "" 4 (length $ snd $ postingsReport defreportopts (Acct "assets:bank:checking") samplejournal)
|
assertEqual "" 4 (length $ snd $ postingsReport defreportopts (Acct "assets:bank:checking") samplejournal)
|
||||||
|
|
||||||
-- (defreportopts, And [Acct "a a", Acct "'b"], samplejournal2) `gives` 0
|
-- (defreportopts, And [Acct "a a", Acct "'b"], samplejournal2) `gives` 0
|
||||||
|
|||||||
@ -15,9 +15,6 @@ module Hledger.Reports.ReportOptions (
|
|||||||
checkReportOpts,
|
checkReportOpts,
|
||||||
flat_,
|
flat_,
|
||||||
tree_,
|
tree_,
|
||||||
dateSpanFromOpts,
|
|
||||||
intervalFromOpts,
|
|
||||||
clearedValueFromOpts,
|
|
||||||
whichDateFromOpts,
|
whichDateFromOpts,
|
||||||
journalSelectingAmountFromOpts,
|
journalSelectingAmountFromOpts,
|
||||||
queryFromOpts,
|
queryFromOpts,
|
||||||
@ -34,10 +31,12 @@ import Data.Data (Data)
|
|||||||
#if !MIN_VERSION_base(4,8,0)
|
#if !MIN_VERSION_base(4,8,0)
|
||||||
import Data.Functor.Compat ((<$>))
|
import Data.Functor.Compat ((<$>))
|
||||||
#endif
|
#endif
|
||||||
|
import Data.Maybe
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import Data.Typeable (Typeable)
|
import Data.Typeable (Typeable)
|
||||||
import Data.Time.Calendar
|
import Data.Time.Calendar
|
||||||
import Data.Default
|
import Data.Default
|
||||||
|
import Safe
|
||||||
import Test.HUnit
|
import Test.HUnit
|
||||||
|
|
||||||
import Hledger.Data
|
import Hledger.Data
|
||||||
@ -64,12 +63,9 @@ instance Default AccountListMode where def = ALDefault
|
|||||||
-- corresponding to hledger's command-line options and query language
|
-- corresponding to hledger's command-line options and query language
|
||||||
-- arguments. Used in hledger-lib and above.
|
-- arguments. Used in hledger-lib and above.
|
||||||
data ReportOpts = ReportOpts {
|
data ReportOpts = ReportOpts {
|
||||||
begin_ :: Maybe Day
|
period_ :: Period
|
||||||
,end_ :: Maybe Day
|
,interval_ :: Interval
|
||||||
,period_ :: Maybe (Interval,DateSpan)
|
,clearedstatus_ :: Maybe ClearedStatus
|
||||||
,cleared_ :: Bool
|
|
||||||
,pending_ :: Bool
|
|
||||||
,uncleared_ :: Bool
|
|
||||||
,cost_ :: Bool
|
,cost_ :: Bool
|
||||||
,depth_ :: Maybe Int
|
,depth_ :: Maybe Int
|
||||||
,display_ :: Maybe DisplayExp
|
,display_ :: Maybe DisplayExp
|
||||||
@ -77,19 +73,14 @@ data ReportOpts = ReportOpts {
|
|||||||
,empty_ :: Bool
|
,empty_ :: Bool
|
||||||
,no_elide_ :: Bool
|
,no_elide_ :: Bool
|
||||||
,real_ :: Bool
|
,real_ :: Bool
|
||||||
,daily_ :: Bool
|
|
||||||
,weekly_ :: Bool
|
|
||||||
,monthly_ :: Bool
|
|
||||||
,quarterly_ :: Bool
|
|
||||||
,yearly_ :: Bool
|
|
||||||
,format_ :: Maybe FormatStr
|
,format_ :: Maybe FormatStr
|
||||||
,query_ :: String -- all arguments, as a string
|
,query_ :: String -- all arguments, as a string
|
||||||
-- register
|
-- register only
|
||||||
,average_ :: Bool
|
,average_ :: Bool
|
||||||
,related_ :: Bool
|
,related_ :: Bool
|
||||||
-- balance
|
-- balance only
|
||||||
,balancetype_ :: BalanceType
|
,balancetype_ :: BalanceType
|
||||||
,accountlistmode_ :: AccountListMode
|
,accountlistmode_ :: AccountListMode
|
||||||
,drop_ :: Int
|
,drop_ :: Int
|
||||||
,row_total_ :: Bool
|
,row_total_ :: Bool
|
||||||
,no_total_ :: Bool
|
,no_total_ :: Bool
|
||||||
@ -121,25 +112,14 @@ defreportopts = ReportOpts
|
|||||||
def
|
def
|
||||||
def
|
def
|
||||||
def
|
def
|
||||||
def
|
|
||||||
def
|
|
||||||
def
|
|
||||||
def
|
|
||||||
def
|
|
||||||
def
|
|
||||||
def
|
|
||||||
def
|
|
||||||
|
|
||||||
rawOptsToReportOpts :: RawOpts -> IO ReportOpts
|
rawOptsToReportOpts :: RawOpts -> IO ReportOpts
|
||||||
rawOptsToReportOpts rawopts = checkReportOpts <$> do
|
rawOptsToReportOpts rawopts = checkReportOpts <$> do
|
||||||
d <- getCurrentDay
|
d <- getCurrentDay
|
||||||
return defreportopts{
|
return defreportopts{
|
||||||
begin_ = maybesmartdateopt d "begin" rawopts
|
period_ = periodFromRawOpts d rawopts
|
||||||
,end_ = maybesmartdateopt d "end" rawopts
|
,interval_ = intervalFromRawOpts rawopts
|
||||||
,period_ = maybeperiodopt d rawopts
|
,clearedstatus_ = clearedStatusFromRawOpts rawopts
|
||||||
,cleared_ = boolopt "cleared" rawopts
|
|
||||||
,pending_ = boolopt "pending" rawopts
|
|
||||||
,uncleared_ = boolopt "uncleared" rawopts
|
|
||||||
,cost_ = boolopt "cost" rawopts
|
,cost_ = boolopt "cost" rawopts
|
||||||
,depth_ = maybeintopt "depth" rawopts
|
,depth_ = maybeintopt "depth" rawopts
|
||||||
,display_ = maybedisplayopt d rawopts
|
,display_ = maybedisplayopt d rawopts
|
||||||
@ -147,11 +127,6 @@ rawOptsToReportOpts rawopts = checkReportOpts <$> do
|
|||||||
,empty_ = boolopt "empty" rawopts
|
,empty_ = boolopt "empty" rawopts
|
||||||
,no_elide_ = boolopt "no-elide" rawopts
|
,no_elide_ = boolopt "no-elide" rawopts
|
||||||
,real_ = boolopt "real" rawopts
|
,real_ = boolopt "real" rawopts
|
||||||
,daily_ = boolopt "daily" rawopts
|
|
||||||
,weekly_ = boolopt "weekly" rawopts
|
|
||||||
,monthly_ = boolopt "monthly" rawopts
|
|
||||||
,quarterly_ = boolopt "quarterly" rawopts
|
|
||||||
,yearly_ = boolopt "yearly" rawopts
|
|
||||||
,format_ = maybestringopt "format" rawopts -- XXX move to CliOpts or move validation from Cli.CliOptions to here
|
,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
|
,query_ = unwords $ listofstringopt "args" rawopts -- doesn't handle an arg like "" right
|
||||||
,average_ = boolopt "average" rawopts
|
,average_ = boolopt "average" rawopts
|
||||||
@ -189,14 +164,86 @@ balancetypeopt rawopts
|
|||||||
where
|
where
|
||||||
isset = flip boolopt rawopts
|
isset = flip boolopt rawopts
|
||||||
|
|
||||||
maybesmartdateopt :: Day -> String -> RawOpts -> Maybe Day
|
-- Get the period specified by the intersection of -b/--begin, -e/--end and/or
|
||||||
maybesmartdateopt d name rawopts =
|
-- -p/--period options, using the given date to interpret relative date expressions.
|
||||||
case maybestringopt name rawopts of
|
periodFromRawOpts :: Day -> RawOpts -> Period
|
||||||
Nothing -> Nothing
|
periodFromRawOpts d rawopts =
|
||||||
Just s -> either
|
case (mearliestb, mlateste) of
|
||||||
(\e -> optserror $ "could not parse "++name++" date: "++show e)
|
(Nothing, Nothing) -> PeriodAll
|
||||||
Just
|
(Just b, Nothing) -> PeriodFrom b
|
||||||
$ fixSmartDateStrEither' d (T.pack s)
|
(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: "++show e) Just $
|
||||||
|
fixSmartDateStrEither' d (T.pack v)
|
||||||
|
| n == "period" =
|
||||||
|
case
|
||||||
|
either (\e -> optserror $ "could not parse period option: "++show 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: "++show e) Just $
|
||||||
|
fixSmartDateStrEither' d (T.pack v)
|
||||||
|
| n == "period" =
|
||||||
|
case
|
||||||
|
either (\e -> optserror $ "could not parse period option: "++show 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: "++show 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
|
type DisplayExp = String
|
||||||
|
|
||||||
@ -207,58 +254,6 @@ maybedisplayopt d rawopts =
|
|||||||
fixbracketeddatestr "" = ""
|
fixbracketeddatestr "" = ""
|
||||||
fixbracketeddatestr s = "[" ++ fixSmartDateStr d (T.pack $ init $ tail s) ++ "]"
|
fixbracketeddatestr s = "[" ++ fixSmartDateStr d (T.pack $ init $ tail s) ++ "]"
|
||||||
|
|
||||||
maybeperiodopt :: Day -> RawOpts -> Maybe (Interval,DateSpan)
|
|
||||||
maybeperiodopt d rawopts =
|
|
||||||
case maybestringopt "period" rawopts of
|
|
||||||
Nothing -> Nothing
|
|
||||||
Just s -> either
|
|
||||||
(\e -> optserror $ "could not parse period option: "++show e)
|
|
||||||
Just
|
|
||||||
$ parsePeriodExpr d (T.pack s)
|
|
||||||
|
|
||||||
-- | Legacy-compatible convenience aliases for accountlistmode_.
|
|
||||||
tree_ :: ReportOpts -> Bool
|
|
||||||
tree_ = (==ALTree) . accountlistmode_
|
|
||||||
|
|
||||||
flat_ :: ReportOpts -> Bool
|
|
||||||
flat_ = (==ALFlat) . accountlistmode_
|
|
||||||
|
|
||||||
-- | Figure out the date span we should report on, based on any
|
|
||||||
-- begin/end/period options provided. A period option will cause begin and
|
|
||||||
-- end options to be ignored.
|
|
||||||
dateSpanFromOpts :: Day -> ReportOpts -> DateSpan
|
|
||||||
dateSpanFromOpts _ ReportOpts{..} =
|
|
||||||
case period_ of Just (_,span) -> span
|
|
||||||
Nothing -> DateSpan begin_ end_
|
|
||||||
|
|
||||||
-- | Figure out the reporting interval, if any, specified by the options.
|
|
||||||
-- --period overrides --daily overrides --weekly overrides --monthly etc.
|
|
||||||
intervalFromOpts :: ReportOpts -> Interval
|
|
||||||
intervalFromOpts ReportOpts{..} =
|
|
||||||
case period_ of
|
|
||||||
Just (interval,_) -> interval
|
|
||||||
Nothing -> i
|
|
||||||
where i | daily_ = Days 1
|
|
||||||
| weekly_ = Weeks 1
|
|
||||||
| monthly_ = Months 1
|
|
||||||
| quarterly_ = Quarters 1
|
|
||||||
| yearly_ = Years 1
|
|
||||||
| otherwise = NoInterval
|
|
||||||
|
|
||||||
-- | Get a maybe boolean representing the last cleared/uncleared option if any.
|
|
||||||
clearedValueFromOpts :: ReportOpts -> Maybe ClearedStatus
|
|
||||||
clearedValueFromOpts ReportOpts{..} | cleared_ = Just Cleared
|
|
||||||
| pending_ = Just Pending
|
|
||||||
| uncleared_ = Just Uncleared
|
|
||||||
| otherwise = Nothing
|
|
||||||
|
|
||||||
-- depthFromOpts :: ReportOpts -> Int
|
|
||||||
-- depthFromOpts opts = min (fromMaybe 99999 $ depth_ opts) (queryDepth $ queryFromOpts nulldate opts)
|
|
||||||
|
|
||||||
-- | Report which date we will report on based on --date2.
|
|
||||||
whichDateFromOpts :: ReportOpts -> WhichDate
|
|
||||||
whichDateFromOpts ReportOpts{..} = if date2_ then SecondaryDate else PrimaryDate
|
|
||||||
|
|
||||||
-- | Select the Transaction date accessor based on --date2.
|
-- | Select the Transaction date accessor based on --date2.
|
||||||
transactionDateFn :: ReportOpts -> (Transaction -> Day)
|
transactionDateFn :: ReportOpts -> (Transaction -> Day)
|
||||||
transactionDateFn ReportOpts{..} = if date2_ then transactionDate2 else tdate
|
transactionDateFn ReportOpts{..} = if date2_ then transactionDate2 else tdate
|
||||||
@ -267,6 +262,19 @@ transactionDateFn ReportOpts{..} = if date2_ then transactionDate2 else tdate
|
|||||||
postingDateFn :: ReportOpts -> (Posting -> Day)
|
postingDateFn :: ReportOpts -> (Posting -> Day)
|
||||||
postingDateFn ReportOpts{..} = if date2_ then postingDate2 else postingDate
|
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
|
-- | Convert this journal's postings' amounts to the cost basis amounts if
|
||||||
-- specified by options.
|
-- specified by options.
|
||||||
@ -277,25 +285,25 @@ journalSelectingAmountFromOpts opts
|
|||||||
|
|
||||||
-- | Convert report options and arguments to a query.
|
-- | Convert report options and arguments to a query.
|
||||||
queryFromOpts :: Day -> ReportOpts -> Query
|
queryFromOpts :: Day -> ReportOpts -> Query
|
||||||
queryFromOpts d opts@ReportOpts{..} = simplifyQuery $ And $ [flagsq, argsq]
|
queryFromOpts d ReportOpts{..} = simplifyQuery $ And $ [flagsq, argsq]
|
||||||
where
|
where
|
||||||
flagsq = And $
|
flagsq = And $
|
||||||
[(if date2_ then Date2 else Date) $ dateSpanFromOpts d opts]
|
[(if date2_ then Date2 else Date) $ periodAsDateSpan period_]
|
||||||
++ (if real_ then [Real True] else [])
|
++ (if real_ then [Real True] else [])
|
||||||
++ (if empty_ then [Empty True] else []) -- ?
|
++ (if empty_ then [Empty True] else []) -- ?
|
||||||
++ (maybe [] ((:[]) . Status) (clearedValueFromOpts opts))
|
++ (maybe [] ((:[]) . Status) clearedstatus_)
|
||||||
++ (maybe [] ((:[]) . Depth) depth_)
|
++ (maybe [] ((:[]) . Depth) depth_)
|
||||||
argsq = fst $ parseQuery d (T.pack query_)
|
argsq = fst $ parseQuery d (T.pack query_)
|
||||||
|
|
||||||
-- | Convert report options to a query, ignoring any non-flag command line arguments.
|
-- | Convert report options to a query, ignoring any non-flag command line arguments.
|
||||||
queryFromOptsOnly :: Day -> ReportOpts -> Query
|
queryFromOptsOnly :: Day -> ReportOpts -> Query
|
||||||
queryFromOptsOnly d opts@ReportOpts{..} = simplifyQuery flagsq
|
queryFromOptsOnly _d ReportOpts{..} = simplifyQuery flagsq
|
||||||
where
|
where
|
||||||
flagsq = And $
|
flagsq = And $
|
||||||
[(if date2_ then Date2 else Date) $ dateSpanFromOpts d opts]
|
[(if date2_ then Date2 else Date) $ periodAsDateSpan period_]
|
||||||
++ (if real_ then [Real True] else [])
|
++ (if real_ then [Real True] else [])
|
||||||
++ (if empty_ then [Empty True] else []) -- ?
|
++ (if empty_ then [Empty True] else []) -- ?
|
||||||
++ (maybe [] ((:[]) . Status) (clearedValueFromOpts opts))
|
++ (maybe [] ((:[]) . Status) clearedstatus_)
|
||||||
++ (maybe [] ((:[]) . Depth) depth_)
|
++ (maybe [] ((:[]) . Depth) depth_)
|
||||||
|
|
||||||
tests_queryFromOpts :: [Test]
|
tests_queryFromOpts :: [Test]
|
||||||
@ -305,7 +313,7 @@ tests_queryFromOpts = [
|
|||||||
assertEqual "" (Acct "a") (queryFromOpts nulldate defreportopts{query_="a"})
|
assertEqual "" (Acct "a") (queryFromOpts nulldate defreportopts{query_="a"})
|
||||||
assertEqual "" (Desc "a a") (queryFromOpts nulldate defreportopts{query_="desc:'a a'"})
|
assertEqual "" (Desc "a a") (queryFromOpts nulldate defreportopts{query_="desc:'a a'"})
|
||||||
assertEqual "" (Date $ mkdatespan "2012/01/01" "2013/01/01")
|
assertEqual "" (Date $ mkdatespan "2012/01/01" "2013/01/01")
|
||||||
(queryFromOpts nulldate defreportopts{begin_=Just (parsedate "2012/01/01")
|
(queryFromOpts nulldate defreportopts{period_=PeriodFrom (parsedate "2012/01/01")
|
||||||
,query_="date:'to 2013'"
|
,query_="date:'to 2013'"
|
||||||
})
|
})
|
||||||
assertEqual "" (Date2 $ mkdatespan "2012/01/01" "2013/01/01")
|
assertEqual "" (Date2 $ mkdatespan "2012/01/01" "2013/01/01")
|
||||||
@ -326,7 +334,7 @@ tests_queryOptsFromOpts = [
|
|||||||
"queryOptsFromOpts" ~: do
|
"queryOptsFromOpts" ~: do
|
||||||
assertEqual "" [] (queryOptsFromOpts nulldate defreportopts)
|
assertEqual "" [] (queryOptsFromOpts nulldate defreportopts)
|
||||||
assertEqual "" [] (queryOptsFromOpts nulldate defreportopts{query_="a"})
|
assertEqual "" [] (queryOptsFromOpts nulldate defreportopts{query_="a"})
|
||||||
assertEqual "" [] (queryOptsFromOpts nulldate defreportopts{begin_=Just (parsedate "2012/01/01")
|
assertEqual "" [] (queryOptsFromOpts nulldate defreportopts{period_=PeriodFrom (parsedate "2012/01/01")
|
||||||
,query_="date:'to 2013'"
|
,query_="date:'to 2013'"
|
||||||
})
|
})
|
||||||
]
|
]
|
||||||
|
|||||||
@ -135,9 +135,7 @@ asDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}
|
|||||||
mdepth = depth_ ropts
|
mdepth = depth_ ropts
|
||||||
togglefilters =
|
togglefilters =
|
||||||
case concat [
|
case concat [
|
||||||
if cleared_ ropts then ["cleared"] else []
|
uiShowClearedStatus $ clearedstatus_ ropts
|
||||||
,if uncleared_ ropts then ["uncleared"] else []
|
|
||||||
,if pending_ ropts then ["pending"] else []
|
|
||||||
,if real_ ropts then ["real"] else []
|
,if real_ ropts then ["real"] else []
|
||||||
] of
|
] of
|
||||||
[] -> str ""
|
[] -> str ""
|
||||||
|
|||||||
@ -129,9 +129,7 @@ rsDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}
|
|||||||
<+> (if ignore_assertions_ copts then withAttr (borderAttr <> "query") (str " ignoring balance assertions") else str "")
|
<+> (if ignore_assertions_ copts then withAttr (borderAttr <> "query") (str " ignoring balance assertions") else str "")
|
||||||
togglefilters =
|
togglefilters =
|
||||||
case concat [
|
case concat [
|
||||||
if cleared_ ropts then ["cleared"] else []
|
uiShowClearedStatus $ clearedstatus_ ropts
|
||||||
,if uncleared_ ropts then ["uncleared"] else []
|
|
||||||
,if pending_ ropts then ["pending"] else []
|
|
||||||
,if real_ ropts then ["real"] else []
|
,if real_ ropts then ["real"] else []
|
||||||
,if empty_ ropts then [] else ["nonzero"]
|
,if empty_ ropts then [] else ["nonzero"]
|
||||||
] of
|
] of
|
||||||
|
|||||||
@ -72,9 +72,7 @@ tsDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}
|
|||||||
<+> (if ignore_assertions_ copts then withAttr (borderAttr <> "query") (str " ignoring balance assertions") else str "")
|
<+> (if ignore_assertions_ copts then withAttr (borderAttr <> "query") (str " ignoring balance assertions") else str "")
|
||||||
togglefilters =
|
togglefilters =
|
||||||
case concat [
|
case concat [
|
||||||
if cleared_ ropts then ["cleared"] else []
|
uiShowClearedStatus $ clearedstatus_ ropts
|
||||||
,if uncleared_ ropts then ["uncleared"] else []
|
|
||||||
,if pending_ ropts then ["pending"] else []
|
|
||||||
,if real_ ropts then ["real"] else []
|
,if real_ ropts then ["real"] else []
|
||||||
,if empty_ ropts then [] else ["nonzero"]
|
,if empty_ ropts then [] else ["nonzero"]
|
||||||
] of
|
] of
|
||||||
|
|||||||
@ -22,21 +22,24 @@ toggleCleared :: UIState -> UIState
|
|||||||
toggleCleared ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} =
|
toggleCleared ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} =
|
||||||
ui{aopts=uopts{cliopts_=copts{reportopts_=toggleCleared ropts}}}
|
ui{aopts=uopts{cliopts_=copts{reportopts_=toggleCleared ropts}}}
|
||||||
where
|
where
|
||||||
toggleCleared ropts = ropts{cleared_=not $ cleared_ ropts, uncleared_=False, pending_=False}
|
toggleCleared ropts@ReportOpts{clearedstatus_=Just Cleared} = ropts{clearedstatus_=Nothing}
|
||||||
|
toggleCleared ropts = ropts{clearedstatus_=Just Cleared}
|
||||||
|
|
||||||
-- | Toggle between showing only pending items or all items.
|
-- | Toggle between showing only pending items or all items.
|
||||||
togglePending :: UIState -> UIState
|
togglePending :: UIState -> UIState
|
||||||
togglePending ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} =
|
togglePending ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} =
|
||||||
ui{aopts=uopts{cliopts_=copts{reportopts_=togglePending ropts}}}
|
ui{aopts=uopts{cliopts_=copts{reportopts_=togglePending ropts}}}
|
||||||
where
|
where
|
||||||
togglePending ropts = ropts{pending_=not $ pending_ ropts, uncleared_=False, cleared_=False}
|
togglePending ropts@ReportOpts{clearedstatus_=Just Pending} = ropts{clearedstatus_=Nothing}
|
||||||
|
togglePending ropts = ropts{clearedstatus_=Just Pending}
|
||||||
|
|
||||||
-- | Toggle between showing only uncleared items or all items.
|
-- | Toggle between showing only uncleared items or all items.
|
||||||
toggleUncleared :: UIState -> UIState
|
toggleUncleared :: UIState -> UIState
|
||||||
toggleUncleared ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} =
|
toggleUncleared ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} =
|
||||||
ui{aopts=uopts{cliopts_=copts{reportopts_=toggleUncleared ropts}}}
|
ui{aopts=uopts{cliopts_=copts{reportopts_=toggleUncleared ropts}}}
|
||||||
where
|
where
|
||||||
toggleUncleared ropts = ropts{uncleared_=not $ uncleared_ ropts, cleared_=False, pending_=False}
|
toggleUncleared ropts@ReportOpts{clearedstatus_=Just Uncleared} = ropts{clearedstatus_=Nothing}
|
||||||
|
toggleUncleared ropts = ropts{clearedstatus_=Just Uncleared}
|
||||||
|
|
||||||
-- | Toggle between showing all and showing only nonempty (more precisely, nonzero) items.
|
-- | Toggle between showing all and showing only nonempty (more precisely, nonzero) items.
|
||||||
toggleEmpty :: UIState -> UIState
|
toggleEmpty :: UIState -> UIState
|
||||||
@ -76,9 +79,7 @@ resetFilter ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=rop
|
|||||||
ui{aopts=uopts{cliopts_=copts{reportopts_=ropts{
|
ui{aopts=uopts{cliopts_=copts{reportopts_=ropts{
|
||||||
accountlistmode_=ALTree
|
accountlistmode_=ALTree
|
||||||
,empty_=True
|
,empty_=True
|
||||||
,cleared_=False
|
,clearedstatus_=Nothing
|
||||||
,pending_=False
|
|
||||||
,uncleared_=False
|
|
||||||
,real_=False
|
,real_=False
|
||||||
,query_=""
|
,query_=""
|
||||||
}}}}
|
}}}}
|
||||||
|
|||||||
@ -28,6 +28,13 @@ runHelp = runCommand "hledger-ui --help | less" >>= waitForProcess
|
|||||||
|
|
||||||
-- ui
|
-- ui
|
||||||
|
|
||||||
|
uiShowClearedStatus mc =
|
||||||
|
case mc of
|
||||||
|
Just Cleared -> ["cleared"]
|
||||||
|
Just Pending -> ["pending"]
|
||||||
|
Just Uncleared -> ["uncleared"]
|
||||||
|
Nothing -> []
|
||||||
|
|
||||||
-- | Draw the help dialog, called when help mode is active.
|
-- | Draw the help dialog, called when help mode is active.
|
||||||
helpDialog :: Widget Name
|
helpDialog :: Widget Name
|
||||||
helpDialog =
|
helpDialog =
|
||||||
|
|||||||
@ -294,7 +294,7 @@ balance opts@CliOpts{reportopts_=ropts} j = do
|
|||||||
Left err -> error' $ unlines [err]
|
Left err -> error' $ unlines [err]
|
||||||
Right _ -> do
|
Right _ -> do
|
||||||
let format = outputFormatFromOpts opts
|
let format = outputFormatFromOpts opts
|
||||||
interval = intervalFromOpts ropts
|
interval = interval_ ropts
|
||||||
baltype = balancetype_ ropts
|
baltype = balancetype_ ropts
|
||||||
valuedate = fromMaybe d $ queryEndDate False $ queryFromOpts d ropts
|
valuedate = fromMaybe d $ queryEndDate False $ queryFromOpts d ropts
|
||||||
case interval of
|
case interval of
|
||||||
|
|||||||
@ -56,9 +56,10 @@ Total:
|
|||||||
|]
|
|]
|
||||||
|
|
||||||
withoutBeginDate :: ReportOpts -> ReportOpts
|
withoutBeginDate :: ReportOpts -> ReportOpts
|
||||||
withoutBeginDate ropts@ReportOpts{..} = ropts{begin_=Nothing, period_=p}
|
withoutBeginDate ropts@ReportOpts{..} = ropts{period_=p}
|
||||||
where p = case period_ of Nothing -> Nothing
|
where
|
||||||
Just (i, DateSpan _ e) -> Just (i, DateSpan Nothing e)
|
p = dateSpanAsPeriod $ DateSpan Nothing e
|
||||||
|
e = periodEnd p
|
||||||
|
|
||||||
tests_Hledger_Cli_Balancesheet :: Test
|
tests_Hledger_Cli_Balancesheet :: Test
|
||||||
tests_Hledger_Cli_Balancesheet = TestList
|
tests_Hledger_Cli_Balancesheet = TestList
|
||||||
|
|||||||
@ -43,7 +43,7 @@ histogram CliOpts{reportopts_=ropts} j = do
|
|||||||
showHistogram :: ReportOpts -> Query -> Journal -> String
|
showHistogram :: ReportOpts -> Query -> Journal -> String
|
||||||
showHistogram opts q j = concatMap (printDayWith countBar) spanps
|
showHistogram opts q j = concatMap (printDayWith countBar) spanps
|
||||||
where
|
where
|
||||||
i = intervalFromOpts opts
|
i = interval_ opts
|
||||||
interval | i == NoInterval = Days 1
|
interval | i == NoInterval = Days 1
|
||||||
| otherwise = i
|
| otherwise = i
|
||||||
span' = queryDateSpan (date2_ opts) q `spanDefaultsFrom` journalDateSpan (date2_ opts) j
|
span' = queryDateSpan (date2_ opts) q `spanDefaultsFrom` journalDateSpan (date2_ opts) j
|
||||||
|
|||||||
@ -70,7 +70,7 @@ import Hledger.Cli.Utils
|
|||||||
import Hledger.Cli.Version
|
import Hledger.Cli.Version
|
||||||
import Hledger.Data.Dates (getCurrentDay)
|
import Hledger.Data.Dates (getCurrentDay)
|
||||||
import Hledger.Data.RawOptions (RawOpts, optserror)
|
import Hledger.Data.RawOptions (RawOpts, optserror)
|
||||||
import Hledger.Reports.ReportOptions (dateSpanFromOpts, intervalFromOpts, queryFromOpts)
|
import Hledger.Reports.ReportOptions (period_, interval_, queryFromOpts)
|
||||||
import Hledger.Utils
|
import Hledger.Utils
|
||||||
|
|
||||||
|
|
||||||
@ -272,8 +272,8 @@ main = do
|
|||||||
dbgIO "isExternalCommand" isExternalCommand
|
dbgIO "isExternalCommand" isExternalCommand
|
||||||
dbgIO "isBadCommand" isBadCommand
|
dbgIO "isBadCommand" isBadCommand
|
||||||
d <- getCurrentDay
|
d <- getCurrentDay
|
||||||
dbgIO "date span from opts" (dateSpanFromOpts d $ reportopts_ opts)
|
dbgIO "period from opts" (period_ $ reportopts_ opts)
|
||||||
dbgIO "interval from opts" (intervalFromOpts $ reportopts_ opts)
|
dbgIO "interval from opts" (interval_ $ reportopts_ opts)
|
||||||
dbgIO "query from opts & args" (queryFromOpts d $ reportopts_ opts)
|
dbgIO "query from opts & args" (queryFromOpts d $ reportopts_ opts)
|
||||||
let
|
let
|
||||||
runHledgerCommand
|
runHledgerCommand
|
||||||
|
|||||||
@ -49,7 +49,7 @@ stats opts@CliOpts{reportopts_=reportopts_} j = do
|
|||||||
let q = queryFromOpts d reportopts_
|
let q = queryFromOpts d reportopts_
|
||||||
l = ledgerFromJournal q j
|
l = ledgerFromJournal q j
|
||||||
reportspan = (ledgerDateSpan l) `spanDefaultsFrom` (queryDateSpan False q)
|
reportspan = (ledgerDateSpan l) `spanDefaultsFrom` (queryDateSpan False q)
|
||||||
intervalspans = splitSpan (intervalFromOpts reportopts_) reportspan
|
intervalspans = splitSpan (interval_ reportopts_) reportspan
|
||||||
showstats = showLedgerStats l d
|
showstats = showLedgerStats l d
|
||||||
s = intercalate "\n" $ map showstats intervalspans
|
s = intercalate "\n" $ map showstats intervalspans
|
||||||
writeOutput opts s
|
writeOutput opts s
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user