mirror of
https://github.com/simonmichael/hledger.git
synced 2024-09-19 10:17:35 +03:00
imp: partial/inferred dates are flexible, full dates are not (#1982)
DateSpans are now now aware of exact/flexible dates.
This commit is contained in:
parent
032ffd112b
commit
fa70f160ae
@ -30,6 +30,8 @@ quarterly, etc.
|
||||
|
||||
module Hledger.Data.Dates (
|
||||
-- * Misc date handling utilities
|
||||
fromEFDay,
|
||||
modifyEFDay,
|
||||
getCurrentDay,
|
||||
getCurrentMonth,
|
||||
getCurrentYear,
|
||||
@ -38,7 +40,9 @@ module Hledger.Data.Dates (
|
||||
periodContainsDate,
|
||||
parsedateM,
|
||||
showDate,
|
||||
showEFDate,
|
||||
showDateSpan,
|
||||
showDateSpanDebug,
|
||||
showDateSpanMonthAbbrev,
|
||||
elapsedSeconds,
|
||||
prevday,
|
||||
@ -118,11 +122,19 @@ instance Show DateSpan where
|
||||
showDate :: Day -> Text
|
||||
showDate = T.pack . show
|
||||
|
||||
showEFDate :: EFDay -> Text
|
||||
showEFDate = showDate . fromEFDay
|
||||
|
||||
-- | Render a datespan as a display string, abbreviating into a
|
||||
-- compact form if possible.
|
||||
-- Warning, hides whether dates are Exact or Flex.
|
||||
showDateSpan :: DateSpan -> Text
|
||||
showDateSpan = showPeriod . dateSpanAsPeriod
|
||||
|
||||
-- | Show a DateSpan with its begin/end dates, exact or flex.
|
||||
showDateSpanDebug :: DateSpan -> String
|
||||
showDateSpanDebug (DateSpan b e)= "DateSpan (" <> show b <> ") (" <> show e <> ")"
|
||||
|
||||
-- | Like showDateSpan, but show month spans as just the abbreviated month name
|
||||
-- in the current locale.
|
||||
showDateSpanMonthAbbrev :: DateSpan -> Text
|
||||
@ -144,28 +156,36 @@ elapsedSeconds :: Fractional a => UTCTime -> UTCTime -> a
|
||||
elapsedSeconds t1 = realToFrac . diffUTCTime t1
|
||||
|
||||
spanStart :: DateSpan -> Maybe Day
|
||||
spanStart (DateSpan d _) = d
|
||||
spanStart (DateSpan d _) = fromEFDay <$> d
|
||||
|
||||
spanEnd :: DateSpan -> Maybe Day
|
||||
spanEnd (DateSpan _ d) = d
|
||||
spanEnd (DateSpan _ d) = fromEFDay <$> d
|
||||
|
||||
spanStartDate :: DateSpan -> Maybe EFDay
|
||||
spanStartDate (DateSpan d _) = d
|
||||
|
||||
spanEndDate :: DateSpan -> Maybe EFDay
|
||||
spanEndDate (DateSpan _ d) = d
|
||||
|
||||
spanStartYear :: DateSpan -> Maybe Year
|
||||
spanStartYear (DateSpan d _) = fmap (first3 . toGregorian) d
|
||||
spanStartYear (DateSpan d _) = fmap (first3 . toGregorian . fromEFDay) d
|
||||
|
||||
spanEndYear :: DateSpan -> Maybe Year
|
||||
spanEndYear (DateSpan d _) = fmap (first3 . toGregorian) d
|
||||
spanEndYear (DateSpan d _) = fmap (first3 . toGregorian. fromEFDay) d
|
||||
|
||||
-- | Get the 0-2 years mentioned explicitly in a DateSpan.
|
||||
spanYears :: DateSpan -> [Year]
|
||||
spanYears (DateSpan ma mb) = mapMaybe (fmap (first3 . toGregorian)) [ma,mb]
|
||||
spanYears (DateSpan ma mb) = mapMaybe (fmap (first3 . toGregorian. fromEFDay)) [ma,mb]
|
||||
|
||||
-- might be useful later: http://en.wikipedia.org/wiki/Allen%27s_interval_algebra
|
||||
|
||||
-- | Get overall span enclosing multiple sequentially ordered spans.
|
||||
-- The start and end date will be exact or flexible depending on
|
||||
-- the first span's start date and last span's end date.
|
||||
spansSpan :: [DateSpan] -> DateSpan
|
||||
spansSpan spans = DateSpan (spanStart =<< headMay spans) (spanEnd =<< lastMay spans)
|
||||
spansSpan spans = DateSpan (spanStartDate =<< headMay spans) (spanEndDate =<< lastMay spans)
|
||||
|
||||
-- | Split a DateSpan into consecutive spans of the specified Interval.
|
||||
-- | Split a DateSpan into consecutive exact spans of the specified Interval.
|
||||
-- If the first argument is true and the interval is Weeks, Months, Quarters or Years,
|
||||
-- the start date will be adjusted backward if needed to nearest natural interval boundary
|
||||
-- (a monday, first of month, first of quarter or first of year).
|
||||
@ -174,7 +194,7 @@ spansSpan spans = DateSpan (spanStart =<< headMay spans) (spanEnd =<< lastMay sp
|
||||
-- If the original span is empty, eg if the end date is <= the start date, no spans are returned.
|
||||
--
|
||||
-- ==== Examples:
|
||||
-- >>> let t i y1 m1 d1 y2 m2 d2 = splitSpan True i $ DateSpan (Just $ fromGregorian y1 m1 d1) (Just $ fromGregorian y2 m2 d2)
|
||||
-- >>> let t i y1 m1 d1 y2 m2 d2 = splitSpan True i $ DateSpan (Just $ Flex $ fromGregorian y1 m1 d1) (Just $ Flex $ fromGregorian y2 m2 d2)
|
||||
-- >>> t NoInterval 2008 01 01 2009 01 01
|
||||
-- [DateSpan 2008]
|
||||
-- >>> t (Quarters 1) 2008 01 01 2009 01 01
|
||||
@ -228,29 +248,29 @@ splitSpan _ (DaysOfWeek days@(n:_)) ds = spansFromBoundaries e bdrys
|
||||
-- The first representative of each weekday
|
||||
starts = map (\d -> addDays (toInteger $ d - n) $ nthdayofweekcontaining n s) days
|
||||
|
||||
-- Split the given span using the provided helper functions:
|
||||
-- start is applied to the span's start date to get the first sub-span's start date
|
||||
-- addInterval is applied to an integer n (multiplying it by mult) and the span's start date to get the nth sub-span's start date
|
||||
-- Split the given span into exact spans using the provided helper functions:
|
||||
-- the start function is applied to the span's start date to get the first sub-span's start date
|
||||
-- the addInterval function is applied to an integer n (multiplying it by mult) and the span's start date to get the nth sub-span's start date
|
||||
splitspan :: (Day -> Day) -> (Integer -> Day -> Day) -> Int -> DateSpan -> [DateSpan]
|
||||
splitspan start addInterval mult ds = spansFromBoundaries e bdrys
|
||||
where
|
||||
(s, e) = dateSpanSplitLimits start (addInterval $ toInteger mult) ds
|
||||
(s, e) = dateSpanSplitLimits start (addInterval (toInteger mult)) ds
|
||||
bdrys = mapM (addInterval . toInteger) [0,mult..] $ start s
|
||||
|
||||
-- | Fill in missing endpoints for calculating 'splitSpan'.
|
||||
-- | Fill in missing start/end dates for calculating 'splitSpan'.
|
||||
dateSpanSplitLimits :: (Day -> Day) -> (Day -> Day) -> DateSpan -> (Day, Day)
|
||||
dateSpanSplitLimits start _ (DateSpan (Just s) (Just e)) = (start s, e)
|
||||
dateSpanSplitLimits start next (DateSpan (Just s) Nothing) = (start s, next $ start s)
|
||||
dateSpanSplitLimits start next (DateSpan Nothing (Just e)) = (start e, next $ start e)
|
||||
dateSpanSplitLimits _ _ (DateSpan Nothing Nothing) = error "dateSpanSplitLimits: Should not be nulldatespan" -- PARTIAL: This case should have been handled in splitSpan
|
||||
dateSpanSplitLimits start _ (DateSpan (Just s) (Just e)) = (start $ fromEFDay s, fromEFDay e)
|
||||
dateSpanSplitLimits start next (DateSpan (Just s) Nothing) = (start $ fromEFDay s, next $ start $ fromEFDay s)
|
||||
dateSpanSplitLimits start next (DateSpan Nothing (Just e)) = (start $ fromEFDay e, next $ start $ fromEFDay e)
|
||||
dateSpanSplitLimits _ _ (DateSpan Nothing Nothing) = error "dateSpanSplitLimits: should not be nulldatespan" -- PARTIAL: This case should have been handled in splitSpan
|
||||
|
||||
-- | Construct a list of 'DateSpan's from a list of boundaries, which fit within a given range.
|
||||
-- | Construct a list of exact 'DateSpan's from a list of boundaries, which fit within a given range.
|
||||
spansFromBoundaries :: Day -> [Day] -> [DateSpan]
|
||||
spansFromBoundaries e bdrys = zipWith (DateSpan `on` Just) (takeWhile (< e) bdrys) $ drop 1 bdrys
|
||||
spansFromBoundaries e bdrys = zipWith (DateSpan `on` (Just . Exact)) (takeWhile (< e) bdrys) $ drop 1 bdrys
|
||||
|
||||
-- | Count the days in a DateSpan, or if it is open-ended return Nothing.
|
||||
daysInSpan :: DateSpan -> Maybe Integer
|
||||
daysInSpan (DateSpan (Just d1) (Just d2)) = Just $ diffDays d2 d1
|
||||
daysInSpan (DateSpan (Just d1) (Just d2)) = Just $ diffDays (fromEFDay d2) (fromEFDay d1)
|
||||
daysInSpan _ = Nothing
|
||||
|
||||
-- | Is this an empty span, ie closed with the end date on or before the start date ?
|
||||
@ -261,9 +281,9 @@ isEmptySpan _ = False
|
||||
-- | Does the span include the given date ?
|
||||
spanContainsDate :: DateSpan -> Day -> Bool
|
||||
spanContainsDate (DateSpan Nothing Nothing) _ = True
|
||||
spanContainsDate (DateSpan Nothing (Just e)) d = d < e
|
||||
spanContainsDate (DateSpan (Just b) Nothing) d = d >= b
|
||||
spanContainsDate (DateSpan (Just b) (Just e)) d = d >= b && d < e
|
||||
spanContainsDate (DateSpan Nothing (Just e)) d = d < fromEFDay e
|
||||
spanContainsDate (DateSpan (Just b) Nothing) d = d >= fromEFDay b
|
||||
spanContainsDate (DateSpan (Just b) (Just e)) d = d >= fromEFDay b && d < fromEFDay e
|
||||
|
||||
-- | Does the period include the given date ?
|
||||
-- (Here to avoid import cycle).
|
||||
@ -294,7 +314,7 @@ spansIntersect (d:ds) = d `spanIntersect` (spansIntersect ds)
|
||||
-- | Calculate the intersection of two datespans.
|
||||
--
|
||||
-- For non-intersecting spans, gives an empty span beginning on the second's start date:
|
||||
-- >>> DateSpan (Just $ fromGregorian 2018 01 01) (Just $ fromGregorian 2018 01 03) `spanIntersect` DateSpan (Just $ fromGregorian 2018 01 03) (Just $ fromGregorian 2018 01 05)
|
||||
-- >>> DateSpan (Just $ Flex $ fromGregorian 2018 01 01) (Just $ Flex $ fromGregorian 2018 01 03) `spanIntersect` DateSpan (Just $ Flex $ fromGregorian 2018 01 03) (Just $ Flex $ fromGregorian 2018 01 05)
|
||||
-- DateSpan 2018-01-03..2018-01-02
|
||||
spanIntersect (DateSpan b1 e1) (DateSpan b2 e2) = DateSpan b e
|
||||
where
|
||||
@ -330,7 +350,7 @@ earliest (Just d1) (Just d2) = Just $ min d1 d2
|
||||
-- usual exclusive-end-date sense: beginning on the earliest, and ending on
|
||||
-- the day after the latest).
|
||||
daysSpan :: [Day] -> DateSpan
|
||||
daysSpan ds = DateSpan (minimumMay ds) (addDays 1 <$> maximumMay ds)
|
||||
daysSpan ds = DateSpan (Exact <$> minimumMay ds) (Exact . addDays 1 <$> maximumMay ds)
|
||||
|
||||
-- | Select the DateSpan containing a given Day, if any, from a given list of
|
||||
-- DateSpans.
|
||||
@ -352,7 +372,7 @@ latestSpanContaining datespans = go
|
||||
return spn
|
||||
where
|
||||
-- The smallest DateSpan larger than any DateSpan containing day.
|
||||
supSpan = DateSpan (Just $ addDays 1 day) Nothing
|
||||
supSpan = DateSpan (Just $ Exact $ addDays 1 day) Nothing
|
||||
|
||||
spanSet = Set.fromList $ filter (not . isEmptySpan) datespans
|
||||
|
||||
@ -388,17 +408,17 @@ spanFromSmartDate refdate sdate = DateSpan (Just b) (Just e)
|
||||
(ry,rm,_) = toGregorian refdate
|
||||
(b,e) = span' sdate
|
||||
where
|
||||
span' :: SmartDate -> (Day,Day)
|
||||
span' (SmartCompleteDate day) = (day, nextday day)
|
||||
span' (SmartAssumeStart y Nothing) = (startofyear day, nextyear day) where day = fromGregorian y 1 1
|
||||
span' (SmartAssumeStart y (Just m)) = (startofmonth day, nextmonth day) where day = fromGregorian y m 1
|
||||
span' (SmartFromReference m d) = (day, nextday day) where day = fromGregorian ry (fromMaybe rm m) d
|
||||
span' (SmartMonth m) = (startofmonth day, nextmonth day) where day = fromGregorian ry m 1
|
||||
span' (SmartRelative n Day) = (addDays n refdate, addDays (n+1) refdate)
|
||||
span' (SmartRelative n Week) = (addDays (7*n) d, addDays (7*n+7) d) where d = thisweek refdate
|
||||
span' (SmartRelative n Month) = (addGregorianMonthsClip n d, addGregorianMonthsClip (n+1) d) where d = thismonth refdate
|
||||
span' (SmartRelative n Quarter) = (addGregorianMonthsClip (3*n) d, addGregorianMonthsClip (3*n+3) d) where d = thisquarter refdate
|
||||
span' (SmartRelative n Year) = (addGregorianYearsClip n d, addGregorianYearsClip (n+1) d) where d = thisyear refdate
|
||||
span' :: SmartDate -> (EFDay, EFDay)
|
||||
span' (SmartCompleteDate day) = (Exact day, Exact $ nextday day)
|
||||
span' (SmartAssumeStart y Nothing) = (Flex $ startofyear day, Flex $ nextyear day) where day = fromGregorian y 1 1
|
||||
span' (SmartAssumeStart y (Just m)) = (Flex $ startofmonth day, Flex $ nextmonth day) where day = fromGregorian y m 1
|
||||
span' (SmartFromReference m d) = (Exact day, Exact $ nextday day) where day = fromGregorian ry (fromMaybe rm m) d
|
||||
span' (SmartMonth m) = (Flex $ startofmonth day, Flex $ nextmonth day) where day = fromGregorian ry m 1
|
||||
span' (SmartRelative n Day) = (Exact $ addDays n refdate, Exact $ addDays (n+1) refdate)
|
||||
span' (SmartRelative n Week) = (Flex $ addDays (7*n) d, Flex $ addDays (7*n+7) d) where d = thisweek refdate
|
||||
span' (SmartRelative n Month) = (Flex $ addGregorianMonthsClip n d, Flex $ addGregorianMonthsClip (n+1) d) where d = thismonth refdate
|
||||
span' (SmartRelative n Quarter) = (Flex $ addGregorianMonthsClip (3*n) d, Flex $ addGregorianMonthsClip (3*n+3) d) where d = thisquarter refdate
|
||||
span' (SmartRelative n Year) = (Flex $ addGregorianYearsClip n d, Flex $ addGregorianYearsClip (n+1) d) where d = thisyear refdate
|
||||
|
||||
-- showDay :: Day -> String
|
||||
-- showDay day = printf "%04d/%02d/%02d" y m d where (y,m,d) = toGregorian day
|
||||
@ -412,15 +432,17 @@ fixSmartDateStr d s =
|
||||
|
||||
-- | A safe version of fixSmartDateStr.
|
||||
fixSmartDateStrEither :: Day -> Text -> Either HledgerParseErrors Text
|
||||
fixSmartDateStrEither d = fmap showDate . fixSmartDateStrEither' d
|
||||
fixSmartDateStrEither d = fmap showEFDate . fixSmartDateStrEither' d
|
||||
|
||||
fixSmartDateStrEither'
|
||||
:: Day -> Text -> Either HledgerParseErrors Day
|
||||
:: Day -> Text -> Either HledgerParseErrors EFDay
|
||||
fixSmartDateStrEither' d s = case parsewith smartdateonly (T.toLower s) of
|
||||
Right sd -> Right $ fixSmartDate d sd
|
||||
Left e -> Left e
|
||||
|
||||
-- | Convert a SmartDate to an absolute date using the provided reference date.
|
||||
-- | Convert a SmartDate to a specific date using the provided reference date.
|
||||
-- This date will be exact or flexible depending on whether the day was
|
||||
-- specified exactly. (Missing least-significant parts produces a flex date.)
|
||||
--
|
||||
-- ==== Examples:
|
||||
-- >>> :set -XOverloadedStrings
|
||||
@ -503,19 +525,19 @@ fixSmartDateStrEither' d s = case parsewith smartdateonly (T.toLower s) of
|
||||
-- "2008-07-01"
|
||||
-- >>> t "1 week ahead"
|
||||
-- "2008-12-01"
|
||||
fixSmartDate :: Day -> SmartDate -> Day
|
||||
fixSmartDate :: Day -> SmartDate -> EFDay
|
||||
fixSmartDate refdate = fix
|
||||
where
|
||||
fix :: SmartDate -> Day
|
||||
fix (SmartCompleteDate d) = d
|
||||
fix (SmartAssumeStart y m) = fromGregorian y (fromMaybe 1 m) 1
|
||||
fix (SmartFromReference m d) = fromGregorian ry (fromMaybe rm m) d
|
||||
fix (SmartMonth m) = fromGregorian ry m 1
|
||||
fix (SmartRelative n Day) = addDays n refdate
|
||||
fix (SmartRelative n Week) = addDays (7*n) $ thisweek refdate
|
||||
fix (SmartRelative n Month) = addGregorianMonthsClip n $ thismonth refdate
|
||||
fix (SmartRelative n Quarter) = addGregorianMonthsClip (3*n) $ thisquarter refdate
|
||||
fix (SmartRelative n Year) = addGregorianYearsClip n $ thisyear refdate
|
||||
fix :: SmartDate -> EFDay
|
||||
fix (SmartCompleteDate d) = Exact d
|
||||
fix (SmartAssumeStart y m) = Flex $ fromGregorian y (fromMaybe 1 m) 1
|
||||
fix (SmartFromReference m d) = Exact $ fromGregorian ry (fromMaybe rm m) d
|
||||
fix (SmartMonth m) = Flex $ fromGregorian ry m 1
|
||||
fix (SmartRelative n Day) = Exact $ addDays n refdate
|
||||
fix (SmartRelative n Week) = Flex $ addDays (7*n) $ thisweek refdate
|
||||
fix (SmartRelative n Month) = Flex $ addGregorianMonthsClip n $ thismonth refdate
|
||||
fix (SmartRelative n Quarter) = Flex $ addGregorianMonthsClip (3*n) $ thisquarter refdate
|
||||
fix (SmartRelative n Year) = Flex $ addGregorianYearsClip n $ thisyear refdate
|
||||
(ry, rm, _) = toGregorian refdate
|
||||
|
||||
prevday :: Day -> Day
|
||||
@ -551,8 +573,8 @@ startofyear day = fromGregorian y 1 1 where (y,_,_) = toGregorian day
|
||||
-- when applicable. Works for Weeks, Months, Quarters, Years, eg.
|
||||
intervalBoundaryBefore :: Interval -> Day -> Day
|
||||
intervalBoundaryBefore i d =
|
||||
case splitSpan True i (DateSpan (Just d) (Just $ addDays 1 d)) of
|
||||
(DateSpan (Just start) _:_) -> start
|
||||
case splitSpan True i (DateSpan (Just $ Exact d) (Just $ Exact $ addDays 1 d)) of
|
||||
(DateSpan (Just start) _:_) -> fromEFDay start
|
||||
_ -> d
|
||||
|
||||
-- | For given date d find year-long interval that starts on given
|
||||
@ -1050,9 +1072,9 @@ justdatespanp rdate =
|
||||
nulldatespan :: DateSpan
|
||||
nulldatespan = DateSpan Nothing Nothing
|
||||
|
||||
-- | A datespan of zero length, that matches no date.
|
||||
-- | An exact datespan of zero length, that matches no date.
|
||||
emptydatespan :: DateSpan
|
||||
emptydatespan = DateSpan (Just $ addDays 1 nulldate) (Just nulldate)
|
||||
emptydatespan = DateSpan (Just $ Exact $ addDays 1 nulldate) (Just $ Exact nulldate)
|
||||
|
||||
nulldate :: Day
|
||||
nulldate = fromGregorian 0 1 1
|
||||
@ -1062,23 +1084,23 @@ nulldate = fromGregorian 0 1 1
|
||||
|
||||
tests_Dates = testGroup "Dates"
|
||||
[ testCase "weekday" $ do
|
||||
splitSpan False (DaysOfWeek [1..5]) (DateSpan (Just $ fromGregorian 2021 07 01) (Just $ fromGregorian 2021 07 08))
|
||||
@?= [ (DateSpan (Just $ fromGregorian 2021 06 28) (Just $ fromGregorian 2021 06 29))
|
||||
, (DateSpan (Just $ fromGregorian 2021 06 29) (Just $ fromGregorian 2021 06 30))
|
||||
, (DateSpan (Just $ fromGregorian 2021 06 30) (Just $ fromGregorian 2021 07 01))
|
||||
, (DateSpan (Just $ fromGregorian 2021 07 01) (Just $ fromGregorian 2021 07 02))
|
||||
, (DateSpan (Just $ fromGregorian 2021 07 02) (Just $ fromGregorian 2021 07 05))
|
||||
splitSpan False (DaysOfWeek [1..5]) (DateSpan (Just $ Exact $ fromGregorian 2021 07 01) (Just $ Exact $ fromGregorian 2021 07 08))
|
||||
@?= [ (DateSpan (Just $ Exact $ fromGregorian 2021 06 28) (Just $ Exact $ fromGregorian 2021 06 29))
|
||||
, (DateSpan (Just $ Exact $ fromGregorian 2021 06 29) (Just $ Exact $ fromGregorian 2021 06 30))
|
||||
, (DateSpan (Just $ Exact $ fromGregorian 2021 06 30) (Just $ Exact $ fromGregorian 2021 07 01))
|
||||
, (DateSpan (Just $ Exact $ fromGregorian 2021 07 01) (Just $ Exact $ fromGregorian 2021 07 02))
|
||||
, (DateSpan (Just $ Exact $ fromGregorian 2021 07 02) (Just $ Exact $ fromGregorian 2021 07 05))
|
||||
-- next week
|
||||
, (DateSpan (Just $ fromGregorian 2021 07 05) (Just $ fromGregorian 2021 07 06))
|
||||
, (DateSpan (Just $ fromGregorian 2021 07 06) (Just $ fromGregorian 2021 07 07))
|
||||
, (DateSpan (Just $ fromGregorian 2021 07 07) (Just $ fromGregorian 2021 07 08))
|
||||
, (DateSpan (Just $ Exact $ fromGregorian 2021 07 05) (Just $ Exact $ fromGregorian 2021 07 06))
|
||||
, (DateSpan (Just $ Exact $ fromGregorian 2021 07 06) (Just $ Exact $ fromGregorian 2021 07 07))
|
||||
, (DateSpan (Just $ Exact $ fromGregorian 2021 07 07) (Just $ Exact $ fromGregorian 2021 07 08))
|
||||
]
|
||||
|
||||
splitSpan False (DaysOfWeek [1, 5]) (DateSpan (Just $ fromGregorian 2021 07 01) (Just $ fromGregorian 2021 07 08))
|
||||
@?= [ (DateSpan (Just $ fromGregorian 2021 06 28) (Just $ fromGregorian 2021 07 02))
|
||||
, (DateSpan (Just $ fromGregorian 2021 07 02) (Just $ fromGregorian 2021 07 05))
|
||||
splitSpan False (DaysOfWeek [1, 5]) (DateSpan (Just $ Exact $ fromGregorian 2021 07 01) (Just $ Exact $ fromGregorian 2021 07 08))
|
||||
@?= [ (DateSpan (Just $ Exact $ fromGregorian 2021 06 28) (Just $ Exact $ fromGregorian 2021 07 02))
|
||||
, (DateSpan (Just $ Exact $ fromGregorian 2021 07 02) (Just $ Exact $ fromGregorian 2021 07 05))
|
||||
-- next week
|
||||
, (DateSpan (Just $ fromGregorian 2021 07 05) (Just $ fromGregorian 2021 07 09))
|
||||
, (DateSpan (Just $ Exact $ fromGregorian 2021 07 05) (Just $ Exact $ fromGregorian 2021 07 09))
|
||||
]
|
||||
|
||||
, testCase "match dayOfWeek" $ do
|
||||
@ -1087,14 +1109,14 @@ tests_Dates = testGroup "Dates"
|
||||
ys2021 = fromGregorian 2021 01 01
|
||||
ye2021 = fromGregorian 2021 12 31
|
||||
ys2022 = fromGregorian 2022 01 01
|
||||
mapM_ (matchdow (DateSpan (Just ys2021) (Just ye2021))) [1..7]
|
||||
mapM_ (matchdow (DateSpan (Just ys2021) (Just ys2022))) [1..7]
|
||||
mapM_ (matchdow (DateSpan (Just ye2021) (Just ys2022))) [1..7]
|
||||
mapM_ (matchdow (DateSpan (Just $ Exact ys2021) (Just $ Exact ye2021))) [1..7]
|
||||
mapM_ (matchdow (DateSpan (Just $ Exact ys2021) (Just $ Exact ys2022))) [1..7]
|
||||
mapM_ (matchdow (DateSpan (Just $ Exact ye2021) (Just $ Exact ys2022))) [1..7]
|
||||
|
||||
mapM_ (matchdow (DateSpan (Just ye2021) Nothing)) [1..7]
|
||||
mapM_ (matchdow (DateSpan (Just ys2022) Nothing)) [1..7]
|
||||
mapM_ (matchdow (DateSpan (Just $ Exact ye2021) Nothing)) [1..7]
|
||||
mapM_ (matchdow (DateSpan (Just $ Exact ys2022) Nothing)) [1..7]
|
||||
|
||||
mapM_ (matchdow (DateSpan Nothing (Just ye2021))) [1..7]
|
||||
mapM_ (matchdow (DateSpan Nothing (Just ys2022))) [1..7]
|
||||
mapM_ (matchdow (DateSpan Nothing (Just $ Exact ye2021))) [1..7]
|
||||
mapM_ (matchdow (DateSpan Nothing (Just $ Exact ys2022))) [1..7]
|
||||
|
||||
]
|
||||
|
@ -1002,7 +1002,7 @@ journalStyleInfluencingAmounts j =
|
||||
-- pamt g p = (\amt -> p {pamount =amt}) <$> g (pamount p)
|
||||
-- amts g (Mixed as) = Mixed <$> g as
|
||||
|
||||
-- | The fully specified date span enclosing the dates (primary or secondary)
|
||||
-- | The fully specified exact date span enclosing the dates (primary or secondary)
|
||||
-- of all this journal's transactions and postings, or DateSpan Nothing Nothing
|
||||
-- if there are none.
|
||||
journalDateSpan :: Bool -> Journal -> DateSpan
|
||||
@ -1019,7 +1019,7 @@ journalDateSpanBothDates = journalDateSpanHelper Nothing
|
||||
-- uses both primary and secondary dates.
|
||||
journalDateSpanHelper :: Maybe WhichDate -> Journal -> DateSpan
|
||||
journalDateSpanHelper whichdate j =
|
||||
DateSpan (minimumMay dates) (addDays 1 <$> maximumMay dates)
|
||||
DateSpan (Exact <$> minimumMay dates) (Exact . addDays 1 <$> maximumMay dates)
|
||||
where
|
||||
dates = pdates ++ tdates
|
||||
tdates = concatMap gettdate ts
|
||||
@ -1037,12 +1037,12 @@ journalDateSpanHelper whichdate j =
|
||||
-- | The earliest of this journal's transaction and posting dates, or
|
||||
-- Nothing if there are none.
|
||||
journalStartDate :: Bool -> Journal -> Maybe Day
|
||||
journalStartDate secondary j = b where DateSpan b _ = journalDateSpan secondary j
|
||||
journalStartDate secondary j = fromEFDay <$> b where DateSpan b _ = journalDateSpan secondary j
|
||||
|
||||
-- | The "exclusive end date" of this journal: the day following its latest transaction
|
||||
-- or posting date, or Nothing if there are none.
|
||||
journalEndDate :: Bool -> Journal -> Maybe Day
|
||||
journalEndDate secondary j = e where DateSpan _ e = journalDateSpan secondary j
|
||||
journalEndDate secondary j = fromEFDay <$> e where DateSpan _ e = journalDateSpan secondary j
|
||||
|
||||
-- | The latest of this journal's transaction and posting dates, or
|
||||
-- Nothing if there are none.
|
||||
@ -1254,5 +1254,5 @@ tests_Journal = testGroup "Journal" [
|
||||
}
|
||||
]
|
||||
}
|
||||
@?= (DateSpan (Just $ fromGregorian 2014 1 10) (Just $ fromGregorian 2014 10 11))
|
||||
@?= (DateSpan (Just $ Exact $ fromGregorian 2014 1 10) (Just $ Exact $ fromGregorian 2014 10 11))
|
||||
]
|
||||
|
@ -125,6 +125,7 @@ instance ToJSON TransactionModifier
|
||||
instance ToJSON TMPostingRule
|
||||
instance ToJSON PeriodicTransaction
|
||||
instance ToJSON PriceDirective
|
||||
instance ToJSON EFDay
|
||||
instance ToJSON DateSpan
|
||||
instance ToJSON Interval
|
||||
instance ToJSON Period
|
||||
|
@ -44,38 +44,38 @@ import Text.Printf
|
||||
|
||||
import Hledger.Data.Types
|
||||
|
||||
-- | Convert Periods to DateSpans.
|
||||
-- | Convert Periods to exact DateSpans.
|
||||
--
|
||||
-- >>> periodAsDateSpan (MonthPeriod 2000 1) == DateSpan (Just $ fromGregorian 2000 1 1) (Just $ fromGregorian 2000 2 1)
|
||||
-- >>> periodAsDateSpan (MonthPeriod 2000 1) == DateSpan (Just $ Flex $ fromGregorian 2000 1 1) (Just $ Flex $ fromGregorian 2000 2 1)
|
||||
-- True
|
||||
periodAsDateSpan :: Period -> DateSpan
|
||||
periodAsDateSpan (DayPeriod d) = DateSpan (Just d) (Just $ addDays 1 d)
|
||||
periodAsDateSpan (WeekPeriod b) = DateSpan (Just b) (Just $ addDays 7 b)
|
||||
periodAsDateSpan (MonthPeriod y m) = DateSpan (Just $ fromGregorian y m 1) (Just $ fromGregorian y' m' 1)
|
||||
periodAsDateSpan (DayPeriod d) = DateSpan (Just $ Exact d) (Just $ Exact $ addDays 1 d)
|
||||
periodAsDateSpan (WeekPeriod b) = DateSpan (Just $ Flex b) (Just $ Flex $ addDays 7 b)
|
||||
periodAsDateSpan (MonthPeriod y m) = DateSpan (Just $ Flex $ fromGregorian y m 1) (Just $ Flex $ fromGregorian y' m' 1)
|
||||
where
|
||||
(y',m') | m==12 = (y+1,1)
|
||||
| otherwise = (y,m+1)
|
||||
periodAsDateSpan (QuarterPeriod y q) = DateSpan (Just $ fromGregorian y m 1) (Just $ fromGregorian y' m' 1)
|
||||
periodAsDateSpan (QuarterPeriod y q) = DateSpan (Just $ Flex $ fromGregorian y m 1) (Just $ Flex $ fromGregorian y' m' 1)
|
||||
where
|
||||
(y', q') | q==4 = (y+1,1)
|
||||
| otherwise = (y,q+1)
|
||||
quarterAsMonth q2 = (q2-1) * 3 + 1
|
||||
m = quarterAsMonth q
|
||||
m' = quarterAsMonth q'
|
||||
periodAsDateSpan (YearPeriod y) = DateSpan (Just $ fromGregorian y 1 1) (Just $ fromGregorian (y+1) 1 1)
|
||||
periodAsDateSpan (PeriodBetween b e) = DateSpan (Just b) (Just e)
|
||||
periodAsDateSpan (PeriodFrom b) = DateSpan (Just b) Nothing
|
||||
periodAsDateSpan (PeriodTo e) = DateSpan Nothing (Just e)
|
||||
periodAsDateSpan (YearPeriod y) = DateSpan (Just $ Flex $ fromGregorian y 1 1) (Just $ Flex $ fromGregorian (y+1) 1 1)
|
||||
periodAsDateSpan (PeriodBetween b e) = DateSpan (Just $ Exact b) (Just $ Exact e)
|
||||
periodAsDateSpan (PeriodFrom b) = DateSpan (Just $ Exact b) Nothing
|
||||
periodAsDateSpan (PeriodTo e) = DateSpan Nothing (Just $ Exact e)
|
||||
periodAsDateSpan (PeriodAll) = DateSpan Nothing Nothing
|
||||
|
||||
-- | Convert DateSpans to Periods.
|
||||
--
|
||||
-- >>> dateSpanAsPeriod $ DateSpan (Just $ fromGregorian 2000 1 1) (Just $ fromGregorian 2000 2 1)
|
||||
-- >>> dateSpanAsPeriod $ DateSpan (Just $ Exact $ fromGregorian 2000 1 1) (Just $ Exact $ fromGregorian 2000 2 1)
|
||||
-- MonthPeriod 2000 1
|
||||
dateSpanAsPeriod :: DateSpan -> Period
|
||||
dateSpanAsPeriod (DateSpan (Just b) (Just e)) = simplifyPeriod $ PeriodBetween b e
|
||||
dateSpanAsPeriod (DateSpan (Just b) Nothing) = PeriodFrom b
|
||||
dateSpanAsPeriod (DateSpan Nothing (Just e)) = PeriodTo e
|
||||
dateSpanAsPeriod (DateSpan (Just b) (Just e)) = simplifyPeriod $ PeriodBetween (fromEFDay b) (fromEFDay e)
|
||||
dateSpanAsPeriod (DateSpan (Just b) Nothing) = PeriodFrom (fromEFDay b)
|
||||
dateSpanAsPeriod (DateSpan Nothing (Just e)) = PeriodTo (fromEFDay e)
|
||||
dateSpanAsPeriod (DateSpan Nothing Nothing) = PeriodAll
|
||||
|
||||
-- | Convert PeriodBetweens to a more abstract period where possible.
|
||||
@ -195,12 +195,12 @@ showPeriodMonthAbbrev (MonthPeriod _ m) -- Jan
|
||||
showPeriodMonthAbbrev p = showPeriod p
|
||||
|
||||
periodStart :: Period -> Maybe Day
|
||||
periodStart p = mb
|
||||
periodStart p = fromEFDay <$> mb
|
||||
where
|
||||
DateSpan mb _ = periodAsDateSpan p
|
||||
|
||||
periodEnd :: Period -> Maybe Day
|
||||
periodEnd p = me
|
||||
periodEnd p = fromEFDay <$> me
|
||||
where
|
||||
DateSpan _ me = periodAsDateSpan p
|
||||
|
||||
@ -231,11 +231,12 @@ periodPrevious p = p
|
||||
-- | Move a standard period to the following period of same duration, staying within enclosing dates.
|
||||
-- Non-standard periods are unaffected.
|
||||
periodNextIn :: DateSpan -> Period -> Period
|
||||
periodNextIn (DateSpan _ (Just e)) p =
|
||||
periodNextIn (DateSpan _ (Just e0)) p =
|
||||
case mb of
|
||||
Just b -> if b < e then p' else p
|
||||
_ -> p
|
||||
where
|
||||
e = fromEFDay e0
|
||||
p' = periodNext p
|
||||
mb = periodStart p'
|
||||
periodNextIn _ p = periodNext p
|
||||
@ -243,11 +244,12 @@ periodNextIn _ p = periodNext p
|
||||
-- | Move a standard period to the preceding period of same duration, staying within enclosing dates.
|
||||
-- Non-standard periods are unaffected.
|
||||
periodPreviousIn :: DateSpan -> Period -> Period
|
||||
periodPreviousIn (DateSpan (Just b) _) p =
|
||||
periodPreviousIn (DateSpan (Just b0) _) p =
|
||||
case me of
|
||||
Just e -> if e > b then p' else p
|
||||
_ -> p
|
||||
where
|
||||
b = fromEFDay b0
|
||||
p' = periodPrevious p
|
||||
me = periodEnd p'
|
||||
periodPreviousIn _ p = periodPrevious p
|
||||
|
@ -186,17 +186,17 @@ instance Show PeriodicTransaction where
|
||||
-- a $1.00
|
||||
-- <BLANKLINE>
|
||||
--
|
||||
-- >>> let reportperiod="daily from 2018/01/03" in let (i,s) = parsePeriodExpr' nulldate reportperiod in runPeriodicTransaction (nullperiodictransaction{ptperiodexpr=reportperiod, ptspan=s, ptinterval=i, ptpostings=["a" `post` usd 1]}) (DateSpan (Just $ fromGregorian 2018 01 01) (Just $ fromGregorian 2018 01 03))
|
||||
-- >>> let reportperiod="daily from 2018/01/03" in let (i,s) = parsePeriodExpr' nulldate reportperiod in runPeriodicTransaction (nullperiodictransaction{ptperiodexpr=reportperiod, ptspan=s, ptinterval=i, ptpostings=["a" `post` usd 1]}) (DateSpan (Just $ Flex $ fromGregorian 2018 01 01) (Just $ Flex $ fromGregorian 2018 01 03))
|
||||
-- []
|
||||
--
|
||||
-- >>> _ptgenspan "every 3 months from 2019-05" (DateSpan (Just $ fromGregorian 2020 01 01) (Just $ fromGregorian 2020 02 01))
|
||||
-- >>> _ptgenspan "every 3 months from 2019-05" (DateSpan (Just $ Flex $ fromGregorian 2020 01 01) (Just $ Flex $ fromGregorian 2020 02 01))
|
||||
--
|
||||
-- >>> _ptgenspan "every 3 months from 2019-05" (DateSpan (Just $ fromGregorian 2020 02 01) (Just $ fromGregorian 2020 03 01))
|
||||
-- >>> _ptgenspan "every 3 months from 2019-05" (DateSpan (Just $ Flex $ fromGregorian 2020 02 01) (Just $ Flex $ fromGregorian 2020 03 01))
|
||||
-- 2020-02-01
|
||||
-- ; generated-transaction: ~ every 3 months from 2019-05
|
||||
-- a $1.00
|
||||
-- <BLANKLINE>
|
||||
-- >>> _ptgenspan "every 3 days from 2018" (DateSpan (Just $ fromGregorian 2018 01 01) (Just $ fromGregorian 2018 01 05))
|
||||
-- >>> _ptgenspan "every 3 days from 2018" (DateSpan (Just $ Flex $ fromGregorian 2018 01 01) (Just $ Flex $ fromGregorian 2018 01 05))
|
||||
-- 2018-01-01
|
||||
-- ; generated-transaction: ~ every 3 days from 2018
|
||||
-- a $1.00
|
||||
@ -205,7 +205,7 @@ instance Show PeriodicTransaction where
|
||||
-- ; generated-transaction: ~ every 3 days from 2018
|
||||
-- a $1.00
|
||||
-- <BLANKLINE>
|
||||
-- >>> _ptgenspan "every 3 days from 2018" (DateSpan (Just $ fromGregorian 2018 01 02) (Just $ fromGregorian 2018 01 05))
|
||||
-- >>> _ptgenspan "every 3 days from 2018" (DateSpan (Just $ Flex $ fromGregorian 2018 01 02) (Just $ Flex $ fromGregorian 2018 01 05))
|
||||
-- 2018-01-04
|
||||
-- ; generated-transaction: ~ every 3 days from 2018
|
||||
-- a $1.00
|
||||
@ -213,7 +213,7 @@ instance Show PeriodicTransaction where
|
||||
|
||||
runPeriodicTransaction :: PeriodicTransaction -> DateSpan -> [Transaction]
|
||||
runPeriodicTransaction PeriodicTransaction{..} requestedspan =
|
||||
[ t{tdate=d} | (DateSpan (Just d) _) <- alltxnspans, spanContainsDate requestedspan d ]
|
||||
[ t{tdate=d} | (DateSpan (Just efd) _) <- alltxnspans, let d = fromEFDay efd, spanContainsDate requestedspan d ]
|
||||
where
|
||||
t = nulltransaction{
|
||||
tsourcepos = ptsourcepos
|
||||
@ -249,7 +249,7 @@ checkPeriodicTransactionStartDate i s periodexpr =
|
||||
_ -> Nothing
|
||||
where
|
||||
checkStart d x =
|
||||
let firstDate = fixSmartDate d $ SmartRelative 0 x
|
||||
let firstDate = fromEFDay $ fixSmartDate d $ SmartRelative 0 x
|
||||
in
|
||||
if d == firstDate
|
||||
then Nothing
|
||||
|
@ -1,4 +1,4 @@
|
||||
{-|
|
||||
{-|
|
||||
|
||||
Most data types are defined here to avoid import cycles.
|
||||
Here is an overview of the hledger data model:
|
||||
@ -82,8 +82,8 @@ type WeekDay = Int -- 1-7
|
||||
-- containing the reference date.
|
||||
data SmartDate
|
||||
= SmartCompleteDate Day
|
||||
| SmartAssumeStart Year (Maybe Month)
|
||||
| SmartFromReference (Maybe Month) MonthDay
|
||||
| SmartAssumeStart Year (Maybe Month) -- XXX improve these constructor names
|
||||
| SmartFromReference (Maybe Month) MonthDay --
|
||||
| SmartMonth Month
|
||||
| SmartRelative Integer SmartInterval
|
||||
deriving (Show)
|
||||
@ -92,7 +92,27 @@ data SmartInterval = Day | Week | Month | Quarter | Year deriving (Show)
|
||||
|
||||
data WhichDate = PrimaryDate | SecondaryDate deriving (Eq,Show)
|
||||
|
||||
data DateSpan = DateSpan (Maybe Day) (Maybe Day) deriving (Eq,Ord,Generic)
|
||||
-- | A date which is either exact or flexible.
|
||||
-- Flexible dates are allowed to be adjusted in certain situations.
|
||||
data EFDay = Exact Day | Flex Day deriving (Eq,Generic,Show)
|
||||
|
||||
-- EFDay's Ord instance treats them like ordinary dates, ignoring exact/flexible.
|
||||
instance Ord EFDay where compare d1 d2 = compare (fromEFDay d1) (fromEFDay d2)
|
||||
|
||||
-- instance Ord EFDay where compare = maCompare
|
||||
|
||||
fromEFDay :: EFDay -> Day
|
||||
fromEFDay (Exact d) = d
|
||||
fromEFDay (Flex d) = d
|
||||
|
||||
modifyEFDay :: (Day -> Day) -> EFDay -> EFDay
|
||||
modifyEFDay f (Exact d) = Exact $ f d
|
||||
modifyEFDay f (Flex d) = Flex $ f d
|
||||
|
||||
-- | A possibly open-ended span of time, from an optional inclusive start date
|
||||
-- to an optional exclusive end date. Each date can be either exact or flexible.
|
||||
-- An "exact date span" is a Datepan with exact start and end dates.
|
||||
data DateSpan = DateSpan (Maybe EFDay) (Maybe EFDay) deriving (Eq,Ord,Generic)
|
||||
|
||||
instance Default DateSpan where def = DateSpan Nothing Nothing
|
||||
|
||||
|
@ -571,8 +571,8 @@ p ||| q = \v -> p v || q v
|
||||
queryStartDate :: Bool -> Query -> Maybe Day
|
||||
queryStartDate secondary (Or ms) = earliestMaybeDate $ map (queryStartDate secondary) ms
|
||||
queryStartDate secondary (And ms) = latestMaybeDate $ map (queryStartDate secondary) ms
|
||||
queryStartDate False (Date (DateSpan (Just d) _)) = Just d
|
||||
queryStartDate True (Date2 (DateSpan (Just d) _)) = Just d
|
||||
queryStartDate False (Date (DateSpan (Just d) _)) = Just $ fromEFDay d
|
||||
queryStartDate True (Date2 (DateSpan (Just d) _)) = Just $ fromEFDay d
|
||||
queryStartDate _ _ = Nothing
|
||||
|
||||
-- | What end date (or secondary date) does this query specify, if any ?
|
||||
@ -580,8 +580,8 @@ queryStartDate _ _ = Nothing
|
||||
queryEndDate :: Bool -> Query -> Maybe Day
|
||||
queryEndDate secondary (Or ms) = latestMaybeDate' $ map (queryEndDate secondary) ms
|
||||
queryEndDate secondary (And ms) = earliestMaybeDate' $ map (queryEndDate secondary) ms
|
||||
queryEndDate False (Date (DateSpan _ (Just d))) = Just d
|
||||
queryEndDate True (Date2 (DateSpan _ (Just d))) = Just d
|
||||
queryEndDate False (Date (DateSpan _ (Just d))) = Just $ fromEFDay d
|
||||
queryEndDate True (Date2 (DateSpan _ (Just d))) = Just $ fromEFDay d
|
||||
queryEndDate _ _ = Nothing
|
||||
|
||||
queryTermDateSpan (Date spn) = Just spn
|
||||
@ -835,8 +835,8 @@ tests_Query = testGroup "Query" [
|
||||
(simplifyQuery $ And [Any,Any]) @?= (Any)
|
||||
(simplifyQuery $ And [Acct $ toRegex' "b",Any]) @?= (Acct $ toRegex' "b")
|
||||
(simplifyQuery $ And [Any,And [Date (DateSpan Nothing Nothing)]]) @?= (Any)
|
||||
(simplifyQuery $ And [Date (DateSpan Nothing (Just $ fromGregorian 2013 01 01)), Date (DateSpan (Just $ fromGregorian 2012 01 01) Nothing)])
|
||||
@?= (Date (DateSpan (Just $ fromGregorian 2012 01 01) (Just $ fromGregorian 2013 01 01)))
|
||||
(simplifyQuery $ And [Date (DateSpan Nothing (Just $ Exact $ fromGregorian 2013 01 01)), Date (DateSpan (Just $ Exact $ fromGregorian 2012 01 01) Nothing)])
|
||||
@?= (Date (DateSpan (Just $ Exact $ fromGregorian 2012 01 01) (Just $ Exact $ fromGregorian 2013 01 01)))
|
||||
(simplifyQuery $ And [Or [],Or [Desc $ toRegex' "b b"]]) @?= (Desc $ toRegex' "b b")
|
||||
|
||||
,testCase "parseQuery" $ do
|
||||
@ -875,9 +875,9 @@ tests_Query = testGroup "Query" [
|
||||
parseQueryTerm nulldate "payee:x" @?= Left <$> payeeTag (Just "x")
|
||||
parseQueryTerm nulldate "note:x" @?= Left <$> noteTag (Just "x")
|
||||
parseQueryTerm nulldate "real:1" @?= Right (Left $ Real True)
|
||||
parseQueryTerm nulldate "date:2008" @?= Right (Left $ Date $ DateSpan (Just $ fromGregorian 2008 01 01) (Just $ fromGregorian 2009 01 01))
|
||||
parseQueryTerm nulldate "date:from 2012/5/17" @?= Right (Left $ Date $ DateSpan (Just $ fromGregorian 2012 05 17) Nothing)
|
||||
parseQueryTerm nulldate "date:20180101-201804" @?= Right (Left $ Date $ DateSpan (Just $ fromGregorian 2018 01 01) (Just $ fromGregorian 2018 04 01))
|
||||
parseQueryTerm nulldate "date:2008" @?= Right (Left $ Date $ DateSpan (Just $ Flex $ fromGregorian 2008 01 01) (Just $ Flex $ fromGregorian 2009 01 01))
|
||||
parseQueryTerm nulldate "date:from 2012/5/17" @?= Right (Left $ Date $ DateSpan (Just $ Exact $ fromGregorian 2012 05 17) Nothing)
|
||||
parseQueryTerm nulldate "date:20180101-201804" @?= Right (Left $ Date $ DateSpan (Just $ Exact $ fromGregorian 2018 01 01) (Just $ Flex $ fromGregorian 2018 04 01))
|
||||
parseQueryTerm nulldate "inacct:a" @?= Right (Right $ QueryOptInAcct "a")
|
||||
parseQueryTerm nulldate "tag:a" @?= Right (Left $ Tag (toRegexCI' "a") Nothing)
|
||||
parseQueryTerm nulldate "tag:a=some value" @?= Right (Left $ Tag (toRegexCI' "a") (Just $ toRegexCI' "some value"))
|
||||
@ -899,18 +899,18 @@ tests_Query = testGroup "Query" [
|
||||
,testCase "queryStartDate" $ do
|
||||
let small = Just $ fromGregorian 2000 01 01
|
||||
big = Just $ fromGregorian 2000 01 02
|
||||
queryStartDate False (And [Date $ DateSpan small Nothing, Date $ DateSpan big Nothing]) @?= big
|
||||
queryStartDate False (And [Date $ DateSpan small Nothing, Date $ DateSpan Nothing Nothing]) @?= small
|
||||
queryStartDate False (Or [Date $ DateSpan small Nothing, Date $ DateSpan big Nothing]) @?= small
|
||||
queryStartDate False (Or [Date $ DateSpan small Nothing, Date $ DateSpan Nothing Nothing]) @?= Nothing
|
||||
queryStartDate False (And [Date $ DateSpan (Exact <$> small) Nothing, Date $ DateSpan (Exact <$> big) Nothing]) @?= big
|
||||
queryStartDate False (And [Date $ DateSpan (Exact <$> small) Nothing, Date $ DateSpan Nothing Nothing]) @?= small
|
||||
queryStartDate False (Or [Date $ DateSpan (Exact <$> small) Nothing, Date $ DateSpan (Exact <$> big) Nothing]) @?= small
|
||||
queryStartDate False (Or [Date $ DateSpan (Exact <$> small) Nothing, Date $ DateSpan Nothing Nothing]) @?= Nothing
|
||||
|
||||
,testCase "queryEndDate" $ do
|
||||
let small = Just $ fromGregorian 2000 01 01
|
||||
big = Just $ fromGregorian 2000 01 02
|
||||
queryEndDate False (And [Date $ DateSpan Nothing small, Date $ DateSpan Nothing big]) @?= small
|
||||
queryEndDate False (And [Date $ DateSpan Nothing small, Date $ DateSpan Nothing Nothing]) @?= small
|
||||
queryEndDate False (Or [Date $ DateSpan Nothing small, Date $ DateSpan Nothing big]) @?= big
|
||||
queryEndDate False (Or [Date $ DateSpan Nothing small, Date $ DateSpan Nothing Nothing]) @?= Nothing
|
||||
queryEndDate False (And [Date $ DateSpan Nothing (Exact <$> small), Date $ DateSpan Nothing (Exact <$> big)]) @?= small
|
||||
queryEndDate False (And [Date $ DateSpan Nothing (Exact <$> small), Date $ DateSpan Nothing Nothing]) @?= small
|
||||
queryEndDate False (Or [Date $ DateSpan Nothing (Exact <$> small), Date $ DateSpan Nothing (Exact <$> big)]) @?= big
|
||||
queryEndDate False (Or [Date $ DateSpan Nothing (Exact <$> small), Date $ DateSpan Nothing Nothing]) @?= Nothing
|
||||
|
||||
,testCase "matchesAccount" $ do
|
||||
assertBool "" $ (Acct $ toRegex' "b:c") `matchesAccount` "a:bb:c:d"
|
||||
|
@ -211,7 +211,7 @@ rawOptsToInputOpts day rawopts =
|
||||
,new_save_ = True
|
||||
,pivot_ = stringopt "pivot" rawopts
|
||||
,forecast_ = forecastPeriodFromRawOpts day rawopts
|
||||
,reportspan_ = DateSpan (queryStartDate False datequery) (queryEndDate False datequery)
|
||||
,reportspan_ = DateSpan (Exact <$> queryStartDate False datequery) (Exact <$> queryEndDate False datequery)
|
||||
,auto_ = boolopt "auto" rawopts
|
||||
,infer_equity_ = boolopt "infer-equity" rawopts && conversionop_ ropts /= Just ToCost
|
||||
,infer_costs_ = boolopt "infer-costs" rawopts
|
||||
|
@ -76,11 +76,11 @@ definputopts = InputOpts
|
||||
forecastPeriod :: InputOpts -> Journal -> Maybe DateSpan
|
||||
forecastPeriod iopts j = do
|
||||
DateSpan requestedStart requestedEnd <- forecast_ iopts
|
||||
let forecastStart = requestedStart <|> max mjournalend reportStart <|> Just (_ioDay iopts)
|
||||
forecastEnd = requestedEnd <|> reportEnd <|> Just (addDays 180 $ _ioDay iopts)
|
||||
let forecastStart = fromEFDay <$> requestedStart <|> max mjournalend (fromEFDay <$> reportStart) <|> Just (_ioDay iopts)
|
||||
forecastEnd = fromEFDay <$> requestedEnd <|> fromEFDay <$> reportEnd <|> (Just $ addDays 180 $ _ioDay iopts)
|
||||
mjournalend = dbg2 "journalEndDate" $ journalEndDate False j -- ignore secondary dates
|
||||
DateSpan reportStart reportEnd = reportspan_ iopts
|
||||
return . dbg2 "forecastspan" $ DateSpan forecastStart forecastEnd
|
||||
return . dbg2 "forecastspan" $ DateSpan (Exact <$> forecastStart) (Exact <$> forecastEnd)
|
||||
|
||||
-- ** Lenses
|
||||
|
||||
|
@ -898,7 +898,7 @@ tests_JournalReader = testGroup "JournalReader" [
|
||||
nullperiodictransaction {
|
||||
ptperiodexpr = "monthly from 2018/6"
|
||||
,ptinterval = Months 1
|
||||
,ptspan = DateSpan (Just $ fromGregorian 2018 6 1) Nothing
|
||||
,ptspan = DateSpan (Just $ Flex $ fromGregorian 2018 6 1) Nothing
|
||||
,ptsourcepos = (SourcePos "" (mkPos 1) (mkPos 1), SourcePos "" (mkPos 2) (mkPos 1))
|
||||
,ptdescription = ""
|
||||
,ptcomment = "In 2019 we will change this\n"
|
||||
@ -909,7 +909,7 @@ tests_JournalReader = testGroup "JournalReader" [
|
||||
nullperiodictransaction {
|
||||
ptperiodexpr = "monthly from 2018/6"
|
||||
,ptinterval = Months 1
|
||||
,ptspan = DateSpan (Just $ fromGregorian 2018 6 1) Nothing
|
||||
,ptspan = DateSpan (Just $ Flex $ fromGregorian 2018 6 1) Nothing
|
||||
,ptsourcepos = (SourcePos "" (mkPos 1) (mkPos 1), SourcePos "" (mkPos 2) (mkPos 1))
|
||||
,ptdescription = "In 2019 we will change this"
|
||||
,ptcomment = ""
|
||||
@ -931,7 +931,7 @@ tests_JournalReader = testGroup "JournalReader" [
|
||||
nullperiodictransaction {
|
||||
ptperiodexpr = "2019-01-04"
|
||||
,ptinterval = NoInterval
|
||||
,ptspan = DateSpan (Just $ fromGregorian 2019 1 4) (Just $ fromGregorian 2019 1 5)
|
||||
,ptspan = DateSpan (Just $ Exact $ fromGregorian 2019 1 4) (Just $ Exact $ fromGregorian 2019 1 5)
|
||||
,ptsourcepos = (SourcePos "" (mkPos 1) (mkPos 1), SourcePos "" (mkPos 2) (mkPos 1))
|
||||
,ptdescription = ""
|
||||
,ptcomment = ""
|
||||
|
@ -147,7 +147,7 @@ accountTransactionsReport rspec@ReportSpec{_rsReportOpts=ropts} j thisacctq = it
|
||||
priorq = dbg5 "priorq" $ And [thisacctq, tostartdateq, datelessreportq]
|
||||
tostartdateq =
|
||||
case mstartdate of
|
||||
Just _ -> Date (DateSpan Nothing mstartdate)
|
||||
Just _ -> Date (DateSpan Nothing (Exact <$> mstartdate))
|
||||
Nothing -> None -- no start date specified, there are no prior postings
|
||||
mstartdate = queryStartDate (date2_ ropts) reportq
|
||||
datelessreportq = filterQuery (not . queryIsDateOrDate2) reportq
|
||||
|
@ -162,11 +162,11 @@ tests_BalanceReport = testGroup "BalanceReport" [
|
||||
mixedAmount (usd 0))
|
||||
|
||||
,testCase "with date:" $
|
||||
(defreportspec{_rsQuery=Date $ DateSpan (Just $ fromGregorian 2009 01 01) (Just $ fromGregorian 2010 01 01)}, samplejournal2) `gives`
|
||||
(defreportspec{_rsQuery=Date $ DateSpan (Just $ Exact $ fromGregorian 2009 01 01) (Just $ Exact $ fromGregorian 2010 01 01)}, samplejournal2) `gives`
|
||||
([], nullmixedamt)
|
||||
|
||||
,testCase "with date2:" $
|
||||
(defreportspec{_rsQuery=Date2 $ DateSpan (Just $ fromGregorian 2009 01 01) (Just $ fromGregorian 2010 01 01)}, samplejournal2) `gives`
|
||||
(defreportspec{_rsQuery=Date2 $ DateSpan (Just $ Exact $ fromGregorian 2009 01 01) (Just $ Exact $ fromGregorian 2010 01 01)}, samplejournal2) `gives`
|
||||
([
|
||||
("assets:bank:checking","assets:bank:checking",0,mixedAmount (usd 1))
|
||||
,("income:salary","income:salary",0,mixedAmount (usd (-1)))
|
||||
|
@ -112,7 +112,7 @@ journalAddBudgetGoalTransactions bopts ropts reportspan j =
|
||||
either error' id $ -- PARTIAL:
|
||||
(journalApplyCommodityStyles >=> journalBalanceTransactions bopts) j{ jtxns = budgetts }
|
||||
where
|
||||
budgetspan = dbg3 "budget span" $ DateSpan mbudgetgoalsstartdate (spanEnd reportspan)
|
||||
budgetspan = dbg3 "budget span" $ DateSpan (Exact <$> mbudgetgoalsstartdate) (Exact <$> spanEnd reportspan)
|
||||
where
|
||||
mbudgetgoalsstartdate =
|
||||
-- We want to also generate budget goal txns before the report start date, in case -H is used.
|
||||
|
@ -42,7 +42,7 @@ entriesReport rspec@ReportSpec{_rsReportOpts=ropts} =
|
||||
tests_EntriesReport = testGroup "EntriesReport" [
|
||||
testGroup "entriesReport" [
|
||||
testCase "not acct" $ (length $ entriesReport defreportspec{_rsQuery=Not . Acct $ toRegex' "bank"} samplejournal) @?= 1
|
||||
,testCase "date" $ (length $ entriesReport defreportspec{_rsQuery=Date $ DateSpan (Just $ fromGregorian 2008 06 01) (Just $ fromGregorian 2008 07 01)} samplejournal) @?= 3
|
||||
,testCase "date" $ (length $ entriesReport defreportspec{_rsQuery=Date $ DateSpan (Just $ Exact $ fromGregorian 2008 06 01) (Just $ Exact $ fromGregorian 2008 07 01)} samplejournal) @?= 3
|
||||
]
|
||||
]
|
||||
|
||||
|
@ -222,7 +222,7 @@ startingPostings rspec@ReportSpec{_rsQuery=query,_rsReportOpts=ropts} j priceora
|
||||
|
||||
precedingperiod = dateSpanAsPeriod . spanIntersect precedingspan .
|
||||
periodAsDateSpan $ period_ ropts
|
||||
precedingspan = DateSpan Nothing $ spanStart reportspan
|
||||
precedingspan = DateSpan Nothing (Exact <$> spanStart reportspan)
|
||||
precedingspanq = (if date2_ ropts then Date2 else Date) $ case precedingspan of
|
||||
DateSpan Nothing Nothing -> emptydatespan
|
||||
a -> a
|
||||
@ -331,7 +331,7 @@ calculateReportMatrix rspec@ReportSpec{_rsReportOpts=ropts} j priceoracle startb
|
||||
-- since this is a cumulative sum of valued amounts, it should not be valued again
|
||||
cumulative = cumulativeSum nullacct changes
|
||||
startingBalance = HM.lookupDefault nullacct name startbals
|
||||
valuedStart = avalue (DateSpan Nothing historicalDate) startingBalance
|
||||
valuedStart = avalue (DateSpan Nothing (Exact <$> historicalDate)) startingBalance
|
||||
|
||||
-- In each column, get each account's balance changes
|
||||
colacctchanges = dbg5 "colacctchanges" $ map (second $ acctChanges rspec j) colps :: [(DateSpan, HashMap ClippedAccountName Account)]
|
||||
|
@ -23,7 +23,7 @@ where
|
||||
|
||||
import Data.List (nub, sortOn)
|
||||
import Data.List.Extra (nubSort)
|
||||
import Data.Maybe (fromMaybe, isJust, isNothing)
|
||||
import Data.Maybe (isJust, isNothing)
|
||||
import Data.Text (Text)
|
||||
import Data.Time.Calendar (Day)
|
||||
import Safe (headMay)
|
||||
@ -115,7 +115,7 @@ matchedPostingsBeforeAndDuring :: ReportSpec -> Journal -> DateSpan -> ([Posting
|
||||
matchedPostingsBeforeAndDuring rspec@ReportSpec{_rsReportOpts=ropts,_rsQuery=q} j reportspan =
|
||||
dbg5 "beforeps, duringps" $ span (beforestartq `matchesPosting`) beforeandduringps
|
||||
where
|
||||
beforestartq = dbg3 "beforestartq" $ dateqtype $ DateSpan Nothing $ spanStart reportspan
|
||||
beforestartq = dbg3 "beforestartq" $ dateqtype $ DateSpan Nothing (Exact <$> spanStart reportspan)
|
||||
beforeandduringps =
|
||||
sortOn (postingDateOrDate2 (whichDate ropts)) -- sort postings by date or date2
|
||||
. (if invert_ ropts then map negatePostingAmount else id) -- with --invert, invert amounts
|
||||
@ -132,7 +132,7 @@ matchedPostingsBeforeAndDuring rspec@ReportSpec{_rsReportOpts=ropts,_rsQuery=q}
|
||||
where
|
||||
depthless = filterQuery (not . queryIsDepth)
|
||||
dateless = filterQuery (not . queryIsDateOrDate2)
|
||||
beforeendq = dateqtype $ DateSpan Nothing $ spanEnd reportspan
|
||||
beforeendq = dateqtype $ DateSpan Nothing (Exact <$> spanEnd reportspan)
|
||||
|
||||
dateqtype = if queryIsDate2 dateq || (queryIsDate dateq && date2_ ropts) then Date2 else Date
|
||||
where
|
||||
@ -195,7 +195,7 @@ summarisePostingsInDateSpan spn@(DateSpan b e) wd mdepth showempty ps
|
||||
| otherwise = summarypes
|
||||
where
|
||||
postingdate = if wd == PrimaryDate then postingDate else postingDate2
|
||||
b' = fromMaybe (maybe nulldate postingdate $ headMay ps) b
|
||||
b' = maybe (maybe nulldate postingdate $ headMay ps) fromEFDay b
|
||||
summaryp = nullposting{pdate=Just b'}
|
||||
clippedanames = nub $ map (clipAccountName mdepth) anames
|
||||
summaryps | mdepth == Just 0 = [summaryp{paccount="...",pamount=sumPostings ps}]
|
||||
|
@ -382,14 +382,14 @@ periodFromRawOpts d rawopts =
|
||||
where
|
||||
mlastb = case beginDatesFromRawOpts d rawopts of
|
||||
[] -> Nothing
|
||||
bs -> Just $ last bs
|
||||
bs -> Just $ fromEFDay $ last bs
|
||||
mlaste = case endDatesFromRawOpts d rawopts of
|
||||
[] -> Nothing
|
||||
es -> Just $ last es
|
||||
es -> Just $ fromEFDay $ last 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 :: Day -> RawOpts -> [EFDay]
|
||||
beginDatesFromRawOpts d = collectopts (begindatefromrawopt d)
|
||||
where
|
||||
begindatefromrawopt d' (n,v)
|
||||
@ -407,7 +407,7 @@ beginDatesFromRawOpts d = collectopts (begindatefromrawopt d)
|
||||
|
||||
-- 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 :: Day -> RawOpts -> [EFDay]
|
||||
endDatesFromRawOpts d = collectopts (enddatefromrawopt d)
|
||||
where
|
||||
enddatefromrawopt d' (n,v)
|
||||
@ -600,7 +600,7 @@ journalApplyValuationFromOptsWith rspec@ReportSpec{_rsReportOpts=ropts} j priceo
|
||||
mPeriodEnd = case interval_ ropts of
|
||||
NoInterval -> const . spanEnd . fst $ reportSpan j rspec
|
||||
_ -> spanEnd <=< latestSpanContaining (historical : spans)
|
||||
historical = DateSpan Nothing $ spanStart =<< headMay spans
|
||||
historical = DateSpan Nothing $ (fmap Exact . spanStart) =<< headMay spans
|
||||
spans = snd $ reportSpanBothDates j rspec
|
||||
styles = journalCommodityStyles j
|
||||
err = error "journalApplyValuationFromOpts: expected all spans to have an end date"
|
||||
@ -676,7 +676,7 @@ reportSpanHelper bothdates j ReportSpec{_rsQuery=query, _rsReportOpts=ropts} =
|
||||
-- include price directives after the last transaction
|
||||
journalspan = dbg3 "journalspan" $ if bothdates then journalDateSpanBothDates j else journalDateSpan (date2_ ropts) j
|
||||
pricespan = dbg3 "pricespan" . DateSpan Nothing $ case value_ ropts of
|
||||
Just (AtEnd _) -> fmap (addDays 1) . maximumMay . map pddate $ jpricedirectives j
|
||||
Just (AtEnd _) -> fmap (Exact . addDays 1) . maximumMay . map pddate $ jpricedirectives j
|
||||
_ -> Nothing
|
||||
-- If the requested span is open-ended, close it using the journal's start and end dates.
|
||||
-- This can still be the null (open) span if the journal is empty.
|
||||
@ -692,8 +692,8 @@ reportSpanHelper bothdates j ReportSpec{_rsQuery=query, _rsReportOpts=ropts} =
|
||||
adjust = isNothing $ spanStart requestedspan
|
||||
-- The requested span enlarged to enclose a whole number of intervals.
|
||||
-- This can be the null span if there were no intervals.
|
||||
reportspan = dbg3 "reportspan" $ DateSpan (spanStart =<< headMay intervalspans)
|
||||
(spanEnd =<< lastMay intervalspans)
|
||||
reportspan = dbg3 "reportspan" $ DateSpan (fmap Exact . spanStart =<< headMay intervalspans)
|
||||
(fmap Exact . spanEnd =<< lastMay intervalspans)
|
||||
|
||||
reportStartDate :: Journal -> ReportSpec -> Maybe Day
|
||||
reportStartDate j = spanStart . fst . reportSpan j
|
||||
|
@ -120,7 +120,7 @@ zipWithPadded _ [] bs = bs
|
||||
-- | Figure out the overall date span of a PeriodicReport
|
||||
periodicReportSpan :: PeriodicReport a b -> DateSpan
|
||||
periodicReportSpan (PeriodicReport [] _ _) = DateSpan Nothing Nothing
|
||||
periodicReportSpan (PeriodicReport colspans _ _) = DateSpan (spanStart $ head colspans) (spanEnd $ last colspans)
|
||||
periodicReportSpan (PeriodicReport colspans _ _) = DateSpan (fmap Exact . spanStart $ head colspans) (fmap Exact . spanEnd $ last colspans)
|
||||
|
||||
-- | Map a function over the row names.
|
||||
prMapName :: (a -> b) -> PeriodicReport a c -> PeriodicReport b c
|
||||
|
@ -422,7 +422,7 @@ reportSpecSetFutureAndForecast fcast rspec =
|
||||
excludeforecastq (Just _) = Any
|
||||
excludeforecastq Nothing = -- not:date:tomorrow- not:tag:generated-transaction
|
||||
And [
|
||||
Not (Date $ DateSpan (Just $ addDays 1 $ _rsDay rspec) Nothing)
|
||||
Not (Date $ DateSpan (Just $ Exact $ addDays 1 $ _rsDay rspec) Nothing)
|
||||
,Not generatedTransactionTag
|
||||
]
|
||||
|
||||
|
@ -28,6 +28,7 @@ import Hledger
|
||||
import Hledger.Web.Foundation (App, Handler, Widget)
|
||||
import Hledger.Web.Settings (widgetFile)
|
||||
import Data.Function ((&))
|
||||
import Control.Arrow (right)
|
||||
|
||||
addModal :: Route App -> Journal -> Day -> Widget
|
||||
addModal addR j today = do
|
||||
@ -61,7 +62,7 @@ addForm j today = identifyForm "add" $ \extra -> do
|
||||
return (formRes, $(widgetFile "add-form"))
|
||||
where
|
||||
-- custom fields
|
||||
dateField = textField & checkMMap (pure . validateDate) (T.pack . show)
|
||||
dateField = textField & checkMMap (pure . right fromEFDay . validateDate) (T.pack . show)
|
||||
where
|
||||
validateDate s =
|
||||
first (const ("Invalid date format" :: Text)) $
|
||||
|
@ -509,8 +509,8 @@ rawOptsToCliOpts rawopts = do
|
||||
currentDay <- getCurrentDay
|
||||
let day = case maybestringopt "today" rawopts of
|
||||
Nothing -> currentDay
|
||||
Just d -> fromRight (error' $ "Unable to parse date \"" ++ d ++ "\"") -- PARTIAL:
|
||||
$ fixSmartDateStrEither' currentDay (T.pack d)
|
||||
Just d -> fromRight (error' $ "Unable to parse date \"" ++ d ++ "\"") $ -- PARTIAL:
|
||||
fromEFDay <$> fixSmartDateStrEither' currentDay (T.pack d)
|
||||
let iopts = rawOptsToInputOpts day rawopts
|
||||
rspec <- either error' pure $ rawOptsToReportSpec day rawopts -- PARTIAL:
|
||||
mcolumns <- readMay <$> getEnvSafe "COLUMNS"
|
||||
|
@ -160,14 +160,15 @@ confirmedTransactionWizard :: PrevInput -> EntryState -> [AddingStage] -> Wizard
|
||||
confirmedTransactionWizard prevInput es [] = confirmedTransactionWizard prevInput es [EnterDateAndCode]
|
||||
confirmedTransactionWizard prevInput es@EntryState{..} stack@(currentStage : _) = case currentStage of
|
||||
EnterDateAndCode -> dateAndCodeWizard prevInput es >>= \case
|
||||
Just (date, code) -> do
|
||||
let es' = es
|
||||
{ esArgs = drop 1 esArgs
|
||||
, esDefDate = date
|
||||
}
|
||||
dateAndCodeString = formatTime defaultTimeLocale yyyymmddFormat date
|
||||
Just (efd, code) -> do
|
||||
let
|
||||
date = fromEFDay efd
|
||||
es' = es{ esArgs = drop 1 esArgs
|
||||
, esDefDate = date
|
||||
}
|
||||
dateAndCodeString = formatTime defaultTimeLocale yyyymmddFormat date
|
||||
++ T.unpack (if T.null code then "" else " (" <> code <> ")")
|
||||
yyyymmddFormat = "%Y-%m-%d"
|
||||
yyyymmddFormat = "%Y-%m-%d"
|
||||
confirmedTransactionWizard prevInput{prevDateAndCode=Just dateAndCodeString} es' (EnterDescAndComment (date, code) : stack)
|
||||
Nothing ->
|
||||
confirmedTransactionWizard prevInput es stack
|
||||
|
@ -739,8 +739,8 @@ multiBalanceRowAsWbs bopts ReportOpts{..} colspans (PeriodicReportRow _ as rowto
|
||||
cs = if all mixedAmountLooksZero allamts then [""] else S.toList $ foldMap maCommodities allamts
|
||||
allamts = as ++ [rowtot | totalscolumn && not (null as)] ++ [rowavg | average_ && not (null as)]
|
||||
addDateColumns spn@(DateSpan s e) = (wbFromText (showDateSpan spn) :)
|
||||
. (wbFromText (maybe "" showDate s) :)
|
||||
. (wbFromText (maybe "" (showDate . addDays (-1)) e) :)
|
||||
. (wbFromText (maybe "" showEFDate s) :)
|
||||
. (wbFromText (maybe "" (showEFDate . modifyEFDay (addDays (-1))) e) :)
|
||||
|
||||
paddedTranspose :: a -> [[a]] -> [[a]]
|
||||
paddedTranspose _ [] = [[]]
|
||||
|
@ -3,6 +3,7 @@
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
{-|
|
||||
|
||||
The @roi@ command prints internal rate of return and time-weighted rate of return for and investment.
|
||||
@ -95,15 +96,17 @@ roi CliOpts{rawopts_=rawopts, reportspec_=rspec@ReportSpec{_rsReportOpts=ReportO
|
||||
tableBody <- forM spans $ \spn@(DateSpan (Just begin) (Just end)) -> do
|
||||
-- Spans are [begin,end), and end is 1 day after the actual end date we are interested in
|
||||
let
|
||||
cashFlowApplyCostValue = map (\(d,amt) -> (d,mixedAmountValue end d amt))
|
||||
b = fromEFDay begin
|
||||
e = fromEFDay end
|
||||
cashFlowApplyCostValue = map (\(d,amt) -> (d,mixedAmountValue e d amt))
|
||||
|
||||
valueBefore =
|
||||
mixedAmountValue end begin $
|
||||
mixedAmountValue e b $
|
||||
total trans (And [ investmentsQuery
|
||||
, Date (DateSpan Nothing (Just begin))])
|
||||
|
||||
valueAfter =
|
||||
mixedAmountValue end end $
|
||||
mixedAmountValue e e $
|
||||
total trans (And [investmentsQuery
|
||||
, Date (DateSpan Nothing (Just end))])
|
||||
|
||||
@ -123,14 +126,14 @@ roi CliOpts{rawopts_=rawopts, reportspec_=rspec@ReportSpec{_rsReportOpts=ReportO
|
||||
, Date spn ] )
|
||||
|
||||
thisSpan = dbg3 "processing span" $
|
||||
OneSpan begin end valueBefore valueAfter cashFlow pnl
|
||||
OneSpan b e valueBefore valueAfter cashFlow pnl
|
||||
|
||||
irr <- internalRateOfReturn showCashFlow prettyTables thisSpan
|
||||
twr <- timeWeightedReturn showCashFlow prettyTables investmentsQuery trans mixedAmountValue thisSpan
|
||||
let cashFlowAmt = maNegate . maSum $ map snd cashFlow
|
||||
let smallIsZero x = if abs x < 0.01 then 0.0 else x
|
||||
return [ showDate begin
|
||||
, showDate (addDays (-1) end)
|
||||
return [ showDate b
|
||||
, showDate (addDays (-1) e)
|
||||
, T.pack $ showMixedAmount valueBefore
|
||||
, T.pack $ showMixedAmount cashFlowAmt
|
||||
, T.pack $ showMixedAmount valueAfter
|
||||
@ -198,7 +201,7 @@ timeWeightedReturn showCashFlow prettyTables investmentsQuery trans mixedAmountV
|
||||
tail $
|
||||
scanl
|
||||
(\(_, _, unitPrice, unitBalance) (date, amt) ->
|
||||
let valueOnDate = unMix $ mixedAmountValue end date $ total trans (And [investmentsQuery, Date (DateSpan Nothing (Just date))])
|
||||
let valueOnDate = unMix $ mixedAmountValue end date $ total trans (And [investmentsQuery, Date (DateSpan Nothing (Just $ Exact date))])
|
||||
in
|
||||
case amt of
|
||||
Right amt' ->
|
||||
|
@ -834,16 +834,7 @@ P 2022-01-01 AAAA $1.40
|
||||
expenses:tax:us:2021 $500 ; plus means added to this account (debit)
|
||||
; revenue/expense categories are also "accounts"
|
||||
|
||||
2022-01-01 Whole Foods | payee name and description can be separated by a pipe char ; tag1:
|
||||
; Transaction or posting comments can contain searchable tags,
|
||||
; written NAME: or NAME:VALUE (value ends at comma or end of line).
|
||||
; There's tag1 above with an empty value, and here's tag2:with a five word value
|
||||
expenses:food $50
|
||||
assets:checking $-50
|
||||
; A few tags have special meaning.
|
||||
; A "date" tag on a posting adjusts its date. (Doesn't affect the transaction date).
|
||||
; date:2022-01-03, the checking posting cleared two days later.
|
||||
|
||||
Kv
|
||||
2022-01-01 ; The description is optional.
|
||||
; Any currency/commodity symbols are allowed, on either side.
|
||||
assets:cash:wallet GBP -10
|
||||
@ -4360,7 +4351,7 @@ file.
|
||||
|
||||
## Report start & end date
|
||||
|
||||
By default, most hledger reports will show the full span of time represented by the journal data.
|
||||
By default, most hledger reports will show the full span of time represented by the journal.
|
||||
The report start date will be the earliest transaction or posting date,
|
||||
and the report end date will be the latest transaction, posting, or market price date.
|
||||
|
||||
@ -4401,11 +4392,12 @@ Examples:
|
||||
|
||||
## Smart dates
|
||||
|
||||
hledger's user interfaces accept a flexible "smart date" syntax.
|
||||
Smart dates allow some english words, can be relative to today's date,
|
||||
and can have less-significant date parts omitted (defaulting to 1).
|
||||
|
||||
Examples:
|
||||
hledger's user interfaces accept a "smart date" syntax for added convenience.
|
||||
Smart dates optionally can
|
||||
be relative to today's date,
|
||||
be written with english words,
|
||||
and have less-significant parts omitted (missing parts are inferred as 1).
|
||||
Some examples:
|
||||
|
||||
| | |
|
||||
|----------------------------------------------|---------------------------------------------------------------------------------------|
|
||||
@ -4423,7 +4415,7 @@ Examples:
|
||||
| `20181201` | 8 digit YYYYMMDD with valid year month and day |
|
||||
| `201812` | 6 digit YYYYMM with valid year and month |
|
||||
|
||||
Counterexamples - malformed digit sequences might give surprising results:
|
||||
Some counterexamples - malformed digit sequences might give surprising results:
|
||||
|
||||
| | |
|
||||
|-------------|-------------------------------------------------------------------|
|
||||
@ -4432,16 +4424,17 @@ Counterexamples - malformed digit sequences might give surprising results:
|
||||
| `20181232` | 8 digits with an invalid day gives an error |
|
||||
| `201801012` | 9+ digits beginning with a valid YYYYMMDD gives an error |
|
||||
|
||||
Note "today's date" can be overridden with the `--today` option, in case it's
|
||||
needed for testing or for recreating old reports. (Except for periodic
|
||||
transaction rules; those are not affected by `--today`.)
|
||||
"Today's date" can be overridden with the `--today` option, in case
|
||||
it's needed for testing or for recreating old reports. (Except for
|
||||
periodic transaction rules, which are not affected by `--today`.)
|
||||
|
||||
## Report intervals
|
||||
|
||||
A report interval can be specified so that commands like
|
||||
[register](#register), [balance](#balance) and [activity](#activity)
|
||||
A report interval can be specified so that reports like
|
||||
[register](#register), [balance](#balance) or [activity](#activity)
|
||||
become multi-period, showing each subperiod as a separate row or column.
|
||||
These "standard" report intervals can be enabled by using the corresponding flag:
|
||||
|
||||
The following standard intervals can be enabled with command-line flags:
|
||||
|
||||
- `-D/--daily`
|
||||
- `-W/--weekly`
|
||||
@ -4449,42 +4442,49 @@ These "standard" report intervals can be enabled by using the corresponding flag
|
||||
- `-Q/--quarterly`
|
||||
- `-Y/--yearly`
|
||||
|
||||
More complex intervals can be specified using `-p/--period` (see below).
|
||||
More complex intervals can be specified using `-p/--period`, described below.
|
||||
|
||||
Specifying a report interval other than daily can cause a report's
|
||||
start date and end date to be adjusted in some cases:
|
||||
## Date adjustment
|
||||
|
||||
- If the report start date is specified explicitly, periods will start exactly on that date.
|
||||
Eg with `-M -b 2023/1/15',
|
||||
periods will begin on the 15th day of each month, starting from 2023-01-15.
|
||||
(Since hledger 1.29).
|
||||
With a report interval (other than daily), report start / end dates which
|
||||
have not been specified explicitly and in full (eg not `-b 2023-01-01`,
|
||||
but `-b 2023-01` or `-b 2023` or unspecified) are considered flexible:
|
||||
|
||||
- If the report start date is inferred, eg from the journal,
|
||||
it will be adjusted earlier if necessary to start on a natural interval boundary.
|
||||
Eg with `-M` by itself, and if the journal's earliest transaction is on 2023-02-04,
|
||||
periods will begin on the 1st of each month, starting from 2023-02-01.
|
||||
- A flexible start date will be automatically adjusted earlier if needed to
|
||||
fall on a natural interval boundary.
|
||||
- Similarly, a flexible end date will be adjusted later if needed
|
||||
to make the last period a whole interval (the same length as the others).
|
||||
|
||||
- The report end date will be adjusted later if necessary
|
||||
so that the last period is a whole interval, the same length as the others.
|
||||
Eg in the example above if the journal's latest transaction is on 2023-03-15,
|
||||
the report end date will be adjusted to 2023-04-01.
|
||||
This is convenient for producing clean periodic reports (this is traditional hledger behaviour).
|
||||
By contrast, fully-specified exact dates will not be adjusted (this is new in hledger 1.29).
|
||||
|
||||
An example: with a journal whose first date is 2023-01-10 and last date is 2023-03-20:
|
||||
|
||||
- `hledger bal -M -b 2023/1/15 -e 2023/3/10`\
|
||||
The report periods will begin on the 15th day of each month, starting from 2023-01-15,
|
||||
and the last period's last day will be 2023-03-09.
|
||||
(Exact start and end dates, neither is adjusted.)
|
||||
|
||||
- `hledger bal -M -b 2023-01 -e 2023-04` or `hledger bal -M`\
|
||||
The report periods will begin on the 1st of each month, starting from 2023-01-01,
|
||||
and the last period's last day will be 2023-03-31.
|
||||
(Flexible start and end dates, both are adjusted.)
|
||||
|
||||
## Period expressions
|
||||
|
||||
The `-p/--period` option accepts period expressions, a shorthand way
|
||||
of expressing a start date, end date, and/or report interval all at
|
||||
once.
|
||||
The `-p/--period` option specifies a period expression, which is a compact way
|
||||
of expressing a start date, end date, and/or report interval.
|
||||
|
||||
Here's a basic period expression specifying the first quarter of 2009. Note,
|
||||
hledger always treats start dates as inclusive and end dates as exclusive:
|
||||
Here's a period expression with a start and end date (specifying the first quarter of 2009):
|
||||
|
||||
| |
|
||||
|----------------------------------|
|
||||
| `-p "from 2009/1/1 to 2009/4/1"` |
|
||||
|
||||
Keywords like "from" and "to" are optional, and so are the spaces, as long
|
||||
as you don't run two dates together. "to" can also be written as ".." or "-".
|
||||
These are equivalent to the above:
|
||||
Several keywords like "from" and "to" are supported for readability; these are optional.
|
||||
"to" can also be written as ".." or "-".
|
||||
The spaces are also optional, as long as you don't run two dates together.
|
||||
So the following are equivalent to the above:
|
||||
|
||||
| |
|
||||
|---------------------------|
|
||||
@ -4492,17 +4492,17 @@ These are equivalent to the above:
|
||||
| `-p2009/1/1to2009/4/1` |
|
||||
| `-p2009/1/1..2009/4/1` |
|
||||
|
||||
Dates are [smart dates](#smart-dates), so if the current year is 2009, the
|
||||
above can also be written as:
|
||||
Dates are [smart dates](#smart-dates), so if the current year is 2009,
|
||||
these are also equivalent to the above:
|
||||
|
||||
| |
|
||||
|-------------------------|
|
||||
| `-p "1/1 4/1"` |
|
||||
| `-p "january-apr"` |
|
||||
| `-p "jan-apr"` |
|
||||
| `-p "this year to 4/1"` |
|
||||
|
||||
If you specify only one date, the missing start or end date will be the
|
||||
earliest or latest transaction in your journal:
|
||||
earliest or latest transaction date in the journal:
|
||||
|
||||
| | |
|
||||
|----------------------|-----------------------------------|
|
||||
@ -4511,16 +4511,15 @@ earliest or latest transaction in your journal:
|
||||
| `-p "from 2009"` | the same |
|
||||
| `-p "to 2009"` | everything before january 1, 2009 |
|
||||
|
||||
A single date with no "from" or "to" defines both the start and end date
|
||||
like so:
|
||||
You can also specify a period by writing a single partial or full date:
|
||||
|
||||
| | |
|
||||
|-----------------|-------------------------------------------------------------|
|
||||
| `-p "2009"` | the year 2009; equivalent to “2009/1/1 to 2010/1/1” |
|
||||
| `-p "2009/1"` | the month of jan; equivalent to “2009/1/1 to 2009/2/1” |
|
||||
| `-p "2009/1/1"` | just that day; equivalent to “2009/1/1 to 2009/1/2” |
|
||||
| | |
|
||||
|-----------------|-----------------------------------------------------------------|
|
||||
| `-p "2009"` | the year 2009; equivalent to “2009/1/1 to 2010/1/1” |
|
||||
| `-p "2009/1"` | the month of january 2009; equivalent to “2009/1/1 to 2009/2/1” |
|
||||
| `-p "2009/1/1"` | the first day of 2009; equivalent to “2009/1/1 to 2009/1/2” |
|
||||
|
||||
Or you can specify a single quarter like so:
|
||||
or by using the "Q" quarter-year syntax (case insensitive):
|
||||
|
||||
| | |
|
||||
|-----------------|-------------------------------------------------------------|
|
||||
@ -4529,10 +4528,8 @@ Or you can specify a single quarter like so:
|
||||
|
||||
### Period expressions with a report interval
|
||||
|
||||
`-p/--period`'s argument can also begin with, or entirely consist of,
|
||||
a [report interval](#report-intervals).
|
||||
This should be separated from the start/end dates (if any) by a space, or the word `in`.
|
||||
Some examples:
|
||||
A period expression can also begin with a [report interval](#report-intervals),
|
||||
separated from the start/end dates (if any) by a space or the word `in`:
|
||||
|
||||
| |
|
||||
|-----------------------------------------|
|
||||
@ -4540,38 +4537,27 @@ Some examples:
|
||||
| `-p "monthly in 2008"` |
|
||||
| `-p "quarterly"` |
|
||||
|
||||
Note a report interval can cause the report start/end dates to be adjusted in some cases,
|
||||
as described above in [Report intervals](#report-intervals).
|
||||
|
||||
### More complex report intervals
|
||||
|
||||
Period expressions allow some more complex kinds of interval to be specified, including:
|
||||
Some more complex intervals can be specified within period expressions, such as:
|
||||
|
||||
- `biweekly`
|
||||
- `biweekly` (every two weeks)
|
||||
- `fortnightly`
|
||||
- `bimonthly`
|
||||
- `bimonthly` (every two months)
|
||||
- `every day|week|month|quarter|year`
|
||||
- `every N days|weeks|months|quarters|years`
|
||||
|
||||
Examples:
|
||||
|
||||
| |
|
||||
|------------------------------------|
|
||||
| `-p "bimonthly from 2008"` |
|
||||
| `-p "every 2 weeks"` |
|
||||
| `-p "every 5 months from 2009/03"` |
|
||||
|
||||
Weekly on custom day:
|
||||
Weekly on a custom day:
|
||||
|
||||
- `every Nth day of week` (`th`, `nd`, `rd`, or `st` are all accepted after the number)
|
||||
- `every WEEKDAYNAME` (full or three-letter english weekday name, case insensitive)
|
||||
|
||||
Monthly on custom day:
|
||||
Monthly on a custom day:
|
||||
|
||||
- `every Nth day [of month]`
|
||||
- `every Nth WEEKDAYNAME [of month]`
|
||||
|
||||
Yearly on custom day:
|
||||
Yearly on a custom day:
|
||||
|
||||
- `every MM/DD [of year]` (month number and day of month number)
|
||||
- `every MONTHNAME DDth [of year]` (full or three-letter english month name, case insensitive, and day of month number)
|
||||
@ -4579,15 +4565,18 @@ Yearly on custom day:
|
||||
|
||||
Examples:
|
||||
|
||||
| | |
|
||||
|------------------------------|----------------------------------------------------------|
|
||||
| `-p "every 2nd day of week"` | periods will go from Tue to Tue |
|
||||
| `-p "every Tue"` | same |
|
||||
| `-p "every 15th day"` | period boundaries will be on 15th of each month |
|
||||
| `-p "every 2nd Monday"` | period boundaries will be on second Monday of each month |
|
||||
| `-p "every 11/05"` | yearly periods with boundaries on 5th of November |
|
||||
| `-p "every 5th November"` | same |
|
||||
| `-p "every Nov 5th"` | same |
|
||||
| | |
|
||||
|------------------------------------|----------------------------------------------------------|
|
||||
| `-p "bimonthly from 2008"` | |
|
||||
| `-p "every 2 weeks"` | |
|
||||
| `-p "every 5 months from 2009/03"` | |
|
||||
| `-p "every 2nd day of week"` | periods will go from Tue to Tue |
|
||||
| `-p "every Tue"` | same |
|
||||
| `-p "every 15th day"` | period boundaries will be on 15th of each month |
|
||||
| `-p "every 2nd Monday"` | period boundaries will be on second Monday of each month |
|
||||
| `-p "every 11/05"` | yearly periods with boundaries on 5th of November |
|
||||
| `-p "every 5th November"` | same |
|
||||
| `-p "every Nov 5th"` | same |
|
||||
|
||||
Show historical balances at end of the 15th day of each month (N is an end date, exclusive as always):
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user