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