lib: use Period for rendering DateSpans

hledger-lib/Hledger/Data/Dates.hs

@@ -21,6 +21,8 @@ with both ends unspecified matches all dates.)
 An 'Interval' is ledger's \"reporting interval\" - weekly, monthly,
 quarterly, etc.
 
+'Period' will probably replace DateSpan in due course.
+
 -}
 
 -- XXX fromGregorian silently clips bad dates, use fromGregorianValid instead ?
@@ -80,7 +82,6 @@ import System.Locale (TimeLocale, defaultTimeLocale)
 #endif
 import Data.Time.Calendar
 import Data.Time.Calendar.OrdinalDate
-import Data.Time.Calendar.WeekDate
 import Data.Time.Clock
 import Data.Time.LocalTime
 import Safe (headMay, lastMay, readMay)
@@ -89,6 +90,7 @@ import Text.Megaparsec.Text
 import Text.Printf
 
 import Hledger.Data.Types
+import Hledger.Data.Period
 import Hledger.Utils
 
 
@@ -100,65 +102,10 @@ instance Show DateSpan where
 showDate :: Day -> String
 showDate = formatTime defaultTimeLocale "%0C%y/%m/%d"
 
--- XXX review for more boundary crossing issues
 -- | Render a datespan as a display string, abbreviating into a
 -- compact form if possible.
-showDateSpan ds@(DateSpan (Just from) (Just to)) =
+showDateSpan :: DateSpan -> String
-  case (toGregorian from, toGregorian to) of
+showDateSpan = showPeriod . dateSpanAsPeriod
-    -- special cases we can abbreviate:
-    -- a year, YYYY
-    ((fy,1,1), (ty,1,1))   | fy+1==ty           -> formatTime defaultTimeLocale "%0C%y" from
-    -- a half, YYYYhN
-    ((fy,1,1), (ty,7,1))   | fy==ty             -> formatTime defaultTimeLocale "%0C%yh1" from
-    ((fy,7,1), (ty,1,1))   | fy+1==ty           -> formatTime defaultTimeLocale "%0C%yh2" from
-    -- a quarter, YYYYqN
-    ((fy,1,1), (ty,4,1))   | fy==ty             -> formatTime defaultTimeLocale "%0C%yq1" from
-    ((fy,4,1), (ty,7,1))   | fy==ty             -> formatTime defaultTimeLocale "%0C%yq2" from
-    ((fy,7,1), (ty,10,1))  | fy==ty             -> formatTime defaultTimeLocale "%0C%yq3" from
-    ((fy,10,1), (ty,1,1))  | fy+1==ty           -> formatTime defaultTimeLocale "%0C%yq4" from
-    -- a month, YYYY/MM
-    ((fy,fm,1), (ty,tm,1)) | fy==ty && fm+1==tm -> formatTime defaultTimeLocale "%0C%y/%m" from
-    ((fy,12,1), (ty,1,1))  | fy+1==ty           -> formatTime defaultTimeLocale "%0C%y/%m" from
-    -- a week (two successive mondays),
-    -- YYYYwN ("week N of year YYYY")
-    -- _ | let ((fy,fw,fd), (ty,tw,td)) = (toWeekDate from, toWeekDate to) in fy==ty && fw+1==tw && fd==1 && td==1
-    --                                             -> formatTime defaultTimeLocale "%0f%gw%V" from
-    -- YYYY/MM/DDwN ("week N, starting on YYYY/MM/DD")
-    _ | let ((fy,fw,fd), (ty,tw,td)) = (toWeekDate from, toWeekDate (addDays (-1) to)) in fy==ty && fw==tw && fd==1 && td==7
-                                                -> formatTime defaultTimeLocale "%0C%y/%m/%dw%V" from
-    -- a day, YYYY/MM/DDd (d suffix is to distinguish from a regular date in register)
-    ((fy,fm,fd), (ty,tm,td)) | fy==ty && fm==tm && fd+1==td -> formatTime defaultTimeLocale "%0C%y/%m/%dd" from
-    -- ((fy,fm,fd), (ty,tm,td)) | fy==ty && fm==tm && fd+1==td -> formatTime defaultTimeLocale "%0C%y/%m/%d" from -- try without the d
-    -- crossing a year boundary
-    ((fy,fm,fd), (ty,tm,td)) | fy+1==ty && fm==12 && tm==1 && fd==31 && td==1 -> formatTime defaultTimeLocale "%0C%y/%m/%dd" from
-    -- crossing a month boundary XXX wrongly shows LEAPYEAR/2/28-LEAPYEAR/3/1 as LEAPYEAR/2/28
-    ((fy,fm,fd), (ty,tm,td)) | fy==ty && fm+1==tm && fd `elem` fromMaybe [] (lookup fm lastdayofmonth) && td==1 -> formatTime defaultTimeLocale "%0C%y/%m/%dd" from
-    -- otherwise, YYYY/MM/DD-YYYY/MM/DD
-    _                                           -> showDateSpan' ds
-  where lastdayofmonth = [(1,[31])
-                         ,(2,[28,29])
-                         ,(3,[31])
-                         ,(4,[30])
-                         ,(5,[31])
-                         ,(6,[30])
-                         ,(7,[31])
-                         ,(8,[31])
-                         ,(9,[30])
-                         ,(10,[31])
-                         ,(11,[30])
-                         ,(12,[31])
-                         ]
-
-showDateSpan ds = showDateSpan' ds
-
--- | Render a datespan as a display string like [START]-[ENDINCL]
--- (optional start date, hyphen, optional inclusive end date).
-showDateSpan' (DateSpan from to) =
-  concat
-    [maybe "" showDate from
-    ,"-"
-    ,maybe "" (showDate . prevday) to
-    ]
 
 -- | Get the current local date.
 getCurrentDay :: IO Day

hledger-lib/Hledger/Data/Period.hs

@@ -1,7 +1,7 @@
 {-|
 
-Manipulating the time periods typically used for reports
+Manipulate the time periods typically used for reports with Period,
-using Period, a richer abstraction than DateSpan.
+a richer abstraction that will probably replace DateSpan.
 See also Types and Dates.
 
 -}
@@ -11,9 +11,10 @@ where
 
 import Data.Time.Calendar
 import Data.Time.Calendar.WeekDate
+import Data.Time.Format
+import Text.Printf
 
 import Hledger.Data.Types
-import Hledger.Data.Dates () -- DateSpan Show instance
 
 -- | Convert Periods to DateSpans.
 --
@@ -116,3 +117,18 @@ isLastDayOfMonth y m d =
     12 -> d==31
     _ -> False
 
+-- | Render a period as a compact display string suitable for user output.
+--
+-- >>> showPeriod (WeekPeriod (fromGregorian 2016 7 25))
+-- "2016/07/25w30"
+showPeriod (DayPeriod b)       = formatTime defaultTimeLocale "%0C%y/%m/%dd" b    -- DATEd
+showPeriod (WeekPeriod b)      = formatTime defaultTimeLocale "%0C%y/%m/%dw%V" b  -- STARTDATEwYEARWEEK
+showPeriod (MonthPeriod y m)   = printf "%04d/%02d" y m                           -- YYYY/MM
+showPeriod (QuarterPeriod y q) = printf "%04dq%d" y q                             -- YYYYqN
+showPeriod (YearPeriod y)      = printf "%04d" y                                  -- YYYY
+showPeriod (PeriodBetween b e) = formatTime defaultTimeLocale "%0C%y/%m/%d" b
+                                 ++ formatTime defaultTimeLocale "-%0C%y/%m/%d" (addDays (-1) e) -- STARTDATE-INCLUSIVEENDDATE
+showPeriod (PeriodFrom b)      = formatTime defaultTimeLocale "%0C%y/%m/%d-" b                   -- STARTDATE-
+showPeriod (PeriodTo e)        = formatTime defaultTimeLocale "-%0C%y/%m/%d" (addDays (-1) e)    -- -INCLUSIVEENDDATE
+showPeriod PeriodAll           = "-"
+

hledger-lib/future-package.yaml

@@ -120,9 +120,10 @@ library:
     - Hledger.Data.Dates
     - Hledger.Data.Journal
     - Hledger.Data.Ledger
-    - Hledger.Data.StringFormat
+    - Hledger.Data.Period
     - Hledger.Data.Posting
     - Hledger.Data.RawOptions
+    - Hledger.Data.StringFormat
     - Hledger.Data.Timeclock
     - Hledger.Data.Transaction
     - Hledger.Data.Types

hledger-lib/hledger-lib.cabal

@@ -109,6 +109,7 @@ library
       Hledger.Data.Dates
       Hledger.Data.Journal
       Hledger.Data.Ledger
+      Hledger.Data.Period
       Hledger.Data.StringFormat
       Hledger.Data.Posting
       Hledger.Data.RawOptions