slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source 
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
hledger-lib/Hledger/Data/Json.hs
View File

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

15
hledger-lib/Hledger/Data/Period.hs
View File

@ -13,6 +13,7 @@ module Hledger.Data.Period (
,simplifyPeriod ,simplifyPeriod
,isLastDayOfMonth ,isLastDayOfMonth
,isStandardPeriod ,isStandardPeriod
,periodTextWidth
,showPeriod ,showPeriod
,showPeriodMonthAbbrev ,showPeriodMonthAbbrev
,periodStart ,periodStart
@ -155,6 +156,20 @@ isStandardPeriod = isStandardPeriod' . simplifyPeriod
isStandardPeriod' (YearPeriod _) = True isStandardPeriod' (YearPeriod _) = True
isStandardPeriod' _ = False 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. -- | Render a period as a compact display string suitable for user output.
-- --
-- >>> showPeriod (WeekPeriod (fromGregorian 2016 7 25)) -- >>> showPeriod (WeekPeriod (fromGregorian 2016 7 25))

45
hledger-lib/Hledger/Reports/PostingsReport.hs
View File

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

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

7
hledger/test/register/intervals.test
View File

@ -69,3 +69,10 @@ $ hledger -f- register -p 'monthly 2014/1/10-2014/2/20'
2014-02 after 1 2 2014-02 after 1 2
within 1 3 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