fix!: register: Tighten up spacing around the date in register reports. (#1655)

As a side effect, this changes the Json representation of the
PostingsReport. The maybe report end date is now replaced with a maybe
period.
This commit is contained in:
Stephen Morgan 2021-08-19 12:32:19 +10:00 committed by Simon Michael
parent 4b654fff94
commit 06312c353a
9 changed files with 116 additions and 97 deletions

View File

@ -121,6 +121,7 @@ instance ToJSON PeriodicTransaction
instance ToJSON PriceDirective
instance ToJSON DateSpan
instance ToJSON Interval
instance ToJSON Period
instance ToJSON AccountAlias
instance ToJSON AccountType
instance ToJSONKey AccountType
@ -225,6 +226,7 @@ instance FromJSON (DecimalRaw Integer)
-- instance FromJSON Commodity
-- instance FromJSON DateSpan
-- instance FromJSON Interval
-- instance FromJSON Period
-- instance FromJSON PeriodicTransaction
-- instance FromJSON PriceDirective
-- instance FromJSON TimeclockCode

View File

@ -13,6 +13,7 @@ module Hledger.Data.Period (
,simplifyPeriod
,isLastDayOfMonth
,isStandardPeriod
,periodTextWidth
,showPeriod
,showPeriodMonthAbbrev
,periodStart
@ -155,6 +156,20 @@ isStandardPeriod = isStandardPeriod' . simplifyPeriod
isStandardPeriod' (YearPeriod _) = True
isStandardPeriod' _ = False
-- | The width of a period of this type when displayed.
periodTextWidth :: Period -> Int
periodTextWidth = periodTextWidth' . simplifyPeriod
where
periodTextWidth' DayPeriod{} = 10 -- 2021-01-01
periodTextWidth' WeekPeriod{} = 13 -- 2021-01-01W52
periodTextWidth' MonthPeriod{} = 7 -- 2021-01
periodTextWidth' QuarterPeriod{} = 6 -- 2021Q1
periodTextWidth' YearPeriod{} = 4 -- 2021
periodTextWidth' PeriodBetween{} = 22 -- 2021-01-01..2021-01-07
periodTextWidth' PeriodFrom{} = 12 -- 2021-01-01..
periodTextWidth' PeriodTo{} = 12 -- ..2021-01-01
periodTextWidth' PeriodAll = 2 -- ..
-- | Render a period as a compact display string suitable for user output.
--
-- >>> showPeriod (WeekPeriod (fromGregorian 2016 7 25))

View File

@ -25,8 +25,8 @@ import Data.List (nub, sortOn)
import Data.List.Extra (nubSort)
import Data.Maybe (fromMaybe, isJust, isNothing)
import Data.Text (Text)
import Data.Time.Calendar (Day, addDays)
import Safe (headMay, lastMay)
import Data.Time.Calendar (Day)
import Safe (headMay)
import Hledger.Data
import Hledger.Query
@ -43,9 +43,7 @@ type PostingsReportItem = (Maybe Day -- The posting date, if this is the firs
-- posting's date. Or if this a summary posting, the
-- report interval's start date if this is the first
-- summary posting in the interval.
,Maybe Day -- If this is a summary posting, the report interval's
-- end date if this is the first summary posting in
-- the interval.
,Maybe Period -- If this is a summary posting, the report interval's period.
,Maybe Text -- The posting's transaction's description, if this is the first posting in the transaction.
,Posting -- The posting, possibly with the account name depth-clipped.
,MixedAmount -- The running total after this posting, or with --average,
@ -55,10 +53,10 @@ type PostingsReportItem = (Maybe Day -- The posting date, if this is the firs
)
-- | A summary posting summarises the activity in one account within a report
-- interval. It is kludgily represented by a regular Posting with no description,
-- the interval's start date stored as the posting date, and the interval's end
-- date attached with a tuple.
type SummaryPosting = (Posting, Day)
-- interval. It is by a regular Posting with no description, the interval's
-- start date stored as the posting date, and the interval's Period attached
-- with a tuple.
type SummaryPosting = (Posting, Period)
-- | Select postings from the journal and add running balance and other
-- information to make a postings report. Used by eg hledger's register command.
@ -74,8 +72,8 @@ postingsReport rspec@ReportSpec{_rsReportOpts=ropts@ReportOpts{..}} j = items
(precedingps, reportps) = matchedPostingsBeforeAndDuring rspec j reportspan
-- Postings, or summary postings with their subperiod's end date, to be displayed.
displayps :: [(Posting, Maybe Day)]
| multiperiod = [(p, Just periodend) | (p, periodend) <- summariseps reportps]
displayps :: [(Posting, Maybe Period)]
| multiperiod = [(p, Just period) | (p, period) <- summariseps reportps]
| otherwise = [(p, Nothing) | p <- reportps]
where
summariseps = summarisePostingsByInterval interval_ whichdate mdepth showempty reportspan
@ -142,14 +140,14 @@ matchedPostingsBeforeAndDuring rspec@ReportSpec{_rsReportOpts=ropts,_rsQuery=q}
dateq = dbg4 "dateq" $ filterQuery queryIsDateOrDate2 $ dbg4 "q" q -- XXX confused by multiple date:/date2: ?
-- | Generate postings report line items from a list of postings or (with
-- non-Nothing dates attached) summary postings.
postingsReportItems :: [(Posting,Maybe Day)] -> (Posting,Maybe Day) -> WhichDate -> Maybe Int -> MixedAmount -> (Int -> MixedAmount -> MixedAmount -> MixedAmount) -> Int -> [PostingsReportItem]
-- non-Nothing periods attached) summary postings.
postingsReportItems :: [(Posting,Maybe Period)] -> (Posting,Maybe Period) -> WhichDate -> Maybe Int -> MixedAmount -> (Int -> MixedAmount -> MixedAmount -> MixedAmount) -> Int -> [PostingsReportItem]
postingsReportItems [] _ _ _ _ _ _ = []
postingsReportItems ((p,menddate):ps) (pprev,menddateprev) wd d b runningcalcfn itemnum =
i:(postingsReportItems ps (p,menddate) wd d b' runningcalcfn (itemnum+1))
postingsReportItems ((p,mperiod):ps) (pprev,mperiodprev) wd d b runningcalcfn itemnum =
i:(postingsReportItems ps (p,mperiod) wd d b' runningcalcfn (itemnum+1))
where
i = mkpostingsReportItem showdate showdesc wd menddate p' b'
(showdate, showdesc) | isJust menddate = (menddate /= menddateprev, False)
i = mkpostingsReportItem showdate showdesc wd mperiod p' b'
(showdate, showdesc) | isJust mperiod = (mperiod /= mperiodprev, False)
| otherwise = (isfirstintxn || isdifferentdate, isfirstintxn)
isfirstintxn = ptransaction p /= ptransaction pprev
isdifferentdate = case wd of PrimaryDate -> postingDate p /= postingDate pprev
@ -160,10 +158,10 @@ postingsReportItems ((p,menddate):ps) (pprev,menddateprev) wd d b runningcalcfn
-- | Generate one postings report line item, containing the posting,
-- the current running balance, and optionally the posting date and/or
-- the transaction description.
mkpostingsReportItem :: Bool -> Bool -> WhichDate -> Maybe Day -> Posting -> MixedAmount -> PostingsReportItem
mkpostingsReportItem showdate showdesc wd menddate p b =
mkpostingsReportItem :: Bool -> Bool -> WhichDate -> Maybe Period -> Posting -> MixedAmount -> PostingsReportItem
mkpostingsReportItem showdate showdesc wd mperiod p b =
(if showdate then Just date else Nothing
,menddate
,mperiod
,if showdesc then tdescription <$> ptransaction p else Nothing
,p
,b
@ -194,19 +192,18 @@ summarisePostingsByInterval interval wd mdepth showempty reportspan ps = concatM
-- with 0 amount.
--
summarisePostingsInDateSpan :: DateSpan -> WhichDate -> Maybe Int -> Bool -> [Posting] -> [SummaryPosting]
summarisePostingsInDateSpan (DateSpan b e) wd mdepth showempty ps
summarisePostingsInDateSpan span@(DateSpan b e) wd mdepth showempty ps
| null ps && (isNothing b || isNothing e) = []
| null ps && showempty = [(summaryp, e')]
| null ps && showempty = [(summaryp, dateSpanAsPeriod span)]
| otherwise = summarypes
where
postingdate = if wd == PrimaryDate then postingDate else postingDate2
b' = fromMaybe (maybe nulldate postingdate $ headMay ps) b
e' = fromMaybe (maybe (addDays 1 nulldate) postingdate $ lastMay ps) e
summaryp = nullposting{pdate=Just b'}
clippedanames = nub $ map (clipAccountName mdepth) anames
summaryps | mdepth == Just 0 = [summaryp{paccount="...",pamount=sumPostings ps}]
| otherwise = [summaryp{paccount=a,pamount=balance a} | a <- clippedanames]
summarypes = map (, e') $ (if showempty then id else filter (not . mixedAmountLooksZero . pamount)) summaryps
summarypes = map (, dateSpanAsPeriod span) $ (if showempty then id else filter (not . mixedAmountLooksZero . pamount)) summaryps
anames = nubSort $ map paccount ps
-- aggregate balances by account, like ledgerFromJournal, then do depth-clipping
accts = accountsFromPostings ps

View File

@ -134,7 +134,7 @@ postingsReportAsText opts items = TB.toLazyText $ foldMap first3 linesWithWidths
-- Also returns the natural width (without padding) of the amount and balance
-- fields.
postingsReportItemAsText :: CliOpts -> Int -> Int -> PostingsReportItem -> (TB.Builder, Int, Int)
postingsReportItemAsText opts preferredamtwidth preferredbalwidth (mdate, menddate, mdesc, p, b) =
postingsReportItemAsText opts preferredamtwidth preferredbalwidth (mdate, mperiod, mdesc, p, b) =
(table <> TB.singleton '\n', thisamtwidth, thisbalwidth)
where
table = renderRowB def{tableBorders=False, borderSpaces=False} . Group NoLine $ map Header
@ -154,11 +154,10 @@ postingsReportItemAsText opts preferredamtwidth preferredbalwidth (mdate, mendda
where w = fullwidth - wbWidth amt
-- calculate widths
(totalwidth,mdescwidth) = registerWidthsFromOpts opts
(datewidth, date) = case (mdate,menddate) of
(Just _, Just _) -> (21, showDateSpan (DateSpan mdate menddate))
(Nothing, Just _) -> (21, "")
(Just d, Nothing) -> (10, showDate d)
_ -> (10, "")
datewidth = maybe 10 periodTextWidth mperiod
date = case mperiod of
Just period -> if isJust mdate then showPeriod period else ""
Nothing -> maybe "" showDate mdate
(amtwidth, balwidth)
| shortfall <= 0 = (preferredamtwidth, preferredbalwidth)
| otherwise = (adjustedamtwidth, adjustedbalwidth)
@ -172,10 +171,9 @@ postingsReportItemAsText opts preferredamtwidth preferredbalwidth (mdate, mendda
remaining = totalwidth - (datewidth + 1 + 2 + amtwidth + 2 + balwidth)
(descwidth, acctwidth)
| hasinterval = (0, remaining - 2)
| isJust mperiod = (0, remaining - 2)
| otherwise = (w, remaining - 2 - w)
where
hasinterval = isJust menddate
w = fromMaybe ((remaining - 2) `div` 2) mdescwidth
-- gather content

View File

@ -69,3 +69,10 @@ $ hledger -f- register -p 'monthly 2014/1/10-2014/2/20'
2014-02 after 1 2
within 1 3
# 7. Custom ranges should display fully.
$ hledger -f- register -p 'every tue'
2013-12-31..2014-01-06 before 1 1
2014-01-28..2014-02-03 within 1 2
2014-02-25..2014-03-03 after 1 3