imp: abbreviate week naming for weekly reports

This commit is contained in:
Victor Mihalache 2024-06-14 10:16:10 +02:00 committed by Simon Michael
parent 83bd98076a
commit 60efd035f5
3 changed files with 14 additions and 11 deletions

View File

@ -43,7 +43,7 @@ module Hledger.Data.Dates (
showEFDate, showEFDate,
showDateSpan, showDateSpan,
showDateSpanDebug, showDateSpanDebug,
showDateSpanMonthAbbrev, showDateSpanAbbrev,
elapsedSeconds, elapsedSeconds,
prevday, prevday,
periodexprp, periodexprp,
@ -139,8 +139,8 @@ showDateSpanDebug (DateSpan b e)= "DateSpan (" <> show b <> ") (" <> show e <> "
-- | Like showDateSpan, but show month spans as just the abbreviated month name -- | Like showDateSpan, but show month spans as just the abbreviated month name
-- in the current locale. -- in the current locale.
showDateSpanMonthAbbrev :: DateSpan -> Text showDateSpanAbbrev :: DateSpan -> Text
showDateSpanMonthAbbrev = showPeriodMonthAbbrev . dateSpanAsPeriod showDateSpanAbbrev = showPeriodAbbrev . dateSpanAsPeriod
-- | Get the current local date. -- | Get the current local date.
getCurrentDay :: IO Day getCurrentDay :: IO Day

View File

@ -15,7 +15,7 @@ module Hledger.Data.Period (
,isStandardPeriod ,isStandardPeriod
,periodTextWidth ,periodTextWidth
,showPeriod ,showPeriod
,showPeriodMonthAbbrev ,showPeriodAbbrev
,periodStart ,periodStart
,periodEnd ,periodEnd
,periodNext ,periodNext
@ -176,7 +176,7 @@ periodTextWidth = periodTextWidth' . simplifyPeriod
-- "2016-07-25W30" -- "2016-07-25W30"
showPeriod :: Period -> Text showPeriod :: Period -> Text
showPeriod (DayPeriod b) = T.pack $ formatTime defaultTimeLocale "%F" b -- DATE showPeriod (DayPeriod b) = T.pack $ formatTime defaultTimeLocale "%F" b -- DATE
showPeriod (WeekPeriod b) = T.pack $ formatTime defaultTimeLocale "%FW%V" b -- STARTDATEWYEARWEEK showPeriod (WeekPeriod b) = T.pack $ formatTime defaultTimeLocale "%0Y-W%V" b -- YYYY-Www
showPeriod (MonthPeriod y m) = T.pack $ printf "%04d-%02d" y m -- YYYY-MM showPeriod (MonthPeriod y m) = T.pack $ printf "%04d-%02d" y m -- YYYY-MM
showPeriod (QuarterPeriod y q) = T.pack $ printf "%04dQ%d" y q -- YYYYQN showPeriod (QuarterPeriod y q) = T.pack $ printf "%04dQ%d" y q -- YYYYQN
showPeriod (YearPeriod y) = T.pack $ printf "%04d" y -- YYYY showPeriod (YearPeriod y) = T.pack $ printf "%04d" y -- YYYY
@ -186,13 +186,16 @@ showPeriod (PeriodFrom b) = T.pack $ formatTime defaultTimeLocale "%F.." b
showPeriod (PeriodTo e) = T.pack $ formatTime defaultTimeLocale "..%F" (addDays (-1) e) -- ..INCLUSIVEENDDATE showPeriod (PeriodTo e) = T.pack $ formatTime defaultTimeLocale "..%F" (addDays (-1) e) -- ..INCLUSIVEENDDATE
showPeriod PeriodAll = ".." showPeriod PeriodAll = ".."
-- | Like showPeriod, but if it's a month period show just -- | Like showPeriod, but if it's a month or week period show
-- the 3 letter month name abbreviation for the current locale. -- an abbreviated form.
showPeriodMonthAbbrev :: Period -> Text -- >>> showPeriodAbbrev (WeekPeriod (fromGregorian 2016 7 25))
showPeriodMonthAbbrev (MonthPeriod _ m) -- Jan -- "W30"
showPeriodAbbrev :: Period -> Text
showPeriodAbbrev (MonthPeriod _ m) -- Jan
| m > 0 && m <= length monthnames = T.pack . snd $ monthnames !! (m-1) | m > 0 && m <= length monthnames = T.pack . snd $ monthnames !! (m-1)
where monthnames = months defaultTimeLocale where monthnames = months defaultTimeLocale
showPeriodMonthAbbrev p = showPeriod p showPeriodAbbrev (WeekPeriod b) = T.pack $ formatTime defaultTimeLocale "W%V" b -- Www
showPeriodAbbrev p = showPeriod p
periodStart :: Period -> Maybe Day periodStart :: Period -> Maybe Day
periodStart p = fromEFDay <$> mb periodStart p = fromEFDay <$> mb

View File

@ -766,7 +766,7 @@ reportPeriodOrJournalLastDay rspec j = reportPeriodLastDay rspec <|> journalOrPr
reportPeriodName :: BalanceAccumulation -> [DateSpan] -> DateSpan -> T.Text reportPeriodName :: BalanceAccumulation -> [DateSpan] -> DateSpan -> T.Text
reportPeriodName balanceaccumulation spans = reportPeriodName balanceaccumulation spans =
case balanceaccumulation of case balanceaccumulation of
PerPeriod -> if multiyear then showDateSpan else showDateSpanMonthAbbrev PerPeriod -> if multiyear then showDateSpan else showDateSpanAbbrev
where where
multiyear = (>1) $ length $ nubSort $ map spanStartYear spans multiyear = (>1) $ length $ nubSort $ map spanStartYear spans
_ -> maybe "" (showDate . prevday) . spanEnd _ -> maybe "" (showDate . prevday) . spanEnd