simonmichael/hledger
1
1
Fork 0
mirror of https://github.com/simonmichael/hledger.git synced 2024-09-20 02:37:12 +03:00
Code Issues Projects Releases Wiki Activity

lib,cli: Replace parsedate and mkdatespan with direct applications of fromGregorian, transaction now takes Day instead of a date string.

Browse Source
This commit is contained in:
Stephen Morgan 2020-08-26 18:11:20 +10:00 committed by Simon Michael
parent f5a7c84065
commit 371b349b2e
16 changed files with 128 additions and 142 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

68
hledger-lib/Hledger/Data/Dates.hs
View File

@ -37,7 +37,6 @@ module Hledger.Data.Dates (
spanContainsDate, spanContainsDate,
periodContainsDate, periodContainsDate,
parsedateM, parsedateM,
parsedate,
showDate, showDate,
showDateSpan, showDateSpan,
showDateSpanMonthAbbrev, showDateSpanMonthAbbrev,
@ -73,7 +72,6 @@ module Hledger.Data.Dates (
yearp, yearp,
daysInSpan, daysInSpan,
maybePeriod, maybePeriod,
mkdatespan,
) )
where where
@ -172,34 +170,34 @@ spansSpan spans = DateSpan (maybe Nothing spanStart $ headMay spans) (maybe Noth
-- --
-- --
-- ==== Examples: -- ==== Examples:
-- >>> let t i d1 d2 = splitSpan i $ mkdatespan d1 d2 -- >>> let t i y1 m1 d1 y2 m2 d2 = splitSpan i $ DateSpan (Just $ fromGregorian y1 m1 d1) (Just $ 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
-- [DateSpan 2008Q1,DateSpan 2008Q2,DateSpan 2008Q3,DateSpan 2008Q4] -- [DateSpan 2008Q1,DateSpan 2008Q2,DateSpan 2008Q3,DateSpan 2008Q4]
-- >>> splitSpan (Quarters 1) nulldatespan -- >>> splitSpan (Quarters 1) nulldatespan
-- [DateSpan ..] -- [DateSpan ..]
-- >>> t (Days 1) "2008/01/01" "2008/01/01" -- an empty datespan -- >>> t (Days 1) 2008 01 01 2008 01 01 -- an empty datespan
-- [] -- []
-- >>> t (Quarters 1) "2008/01/01" "2008/01/01" -- >>> t (Quarters 1) 2008 01 01 2008 01 01
-- [] -- []
-- >>> t (Months 1) "2008/01/01" "2008/04/01" -- >>> t (Months 1) 2008 01 01 2008 04 01
-- [DateSpan 2008-01,DateSpan 2008-02,DateSpan 2008-03] -- [DateSpan 2008-01,DateSpan 2008-02,DateSpan 2008-03]
-- >>> t (Months 2) "2008/01/01" "2008/04/01" -- >>> t (Months 2) 2008 01 01 2008 04 01
-- [DateSpan 2008-01-01..2008-02-29,DateSpan 2008-03-01..2008-04-30] -- [DateSpan 2008-01-01..2008-02-29,DateSpan 2008-03-01..2008-04-30]
-- >>> t (Weeks 1) "2008/01/01" "2008/01/15" -- >>> t (Weeks 1) 2008 01 01 2008 01 15
-- [DateSpan 2007-12-31W01,DateSpan 2008-01-07W02,DateSpan 2008-01-14W03] -- [DateSpan 2007-12-31W01,DateSpan 2008-01-07W02,DateSpan 2008-01-14W03]
-- >>> t (Weeks 2) "2008/01/01" "2008/01/15" -- >>> t (Weeks 2) 2008 01 01 2008 01 15
-- [DateSpan 2007-12-31..2008-01-13,DateSpan 2008-01-14..2008-01-27] -- [DateSpan 2007-12-31..2008-01-13,DateSpan 2008-01-14..2008-01-27]
-- >>> t (DayOfMonth 2) "2008/01/01" "2008/04/01" -- >>> t (DayOfMonth 2) 2008 01 01 2008 04 01
-- [DateSpan 2007-12-02..2008-01-01,DateSpan 2008-01-02..2008-02-01,DateSpan 2008-02-02..2008-03-01,DateSpan 2008-03-02..2008-04-01] -- [DateSpan 2007-12-02..2008-01-01,DateSpan 2008-01-02..2008-02-01,DateSpan 2008-02-02..2008-03-01,DateSpan 2008-03-02..2008-04-01]
-- >>> t (WeekdayOfMonth 2 4) "2011/01/01" "2011/02/15" -- >>> t (WeekdayOfMonth 2 4) 2011 01 01 2011 02 15
-- [DateSpan 2010-12-09..2011-01-12,DateSpan 2011-01-13..2011-02-09,DateSpan 2011-02-10..2011-03-09] -- [DateSpan 2010-12-09..2011-01-12,DateSpan 2011-01-13..2011-02-09,DateSpan 2011-02-10..2011-03-09]
-- >>> t (DayOfWeek 2) "2011/01/01" "2011/01/15" -- >>> t (DayOfWeek 2) 2011 01 01 2011 01 15
-- [DateSpan 2010-12-28..2011-01-03,DateSpan 2011-01-04..2011-01-10,DateSpan 2011-01-11..2011-01-17] -- [DateSpan 2010-12-28..2011-01-03,DateSpan 2011-01-04..2011-01-10,DateSpan 2011-01-11..2011-01-17]
-- >>> t (DayOfYear 11 29) "2011/10/01" "2011/10/15" -- >>> t (DayOfYear 11 29) 2011 10 01 2011 10 15
-- [DateSpan 2010-11-29..2011-11-28] -- [DateSpan 2010-11-29..2011-11-28]
-- >>> t (DayOfYear 11 29) "2011/12/01" "2012/12/15" -- >>> t (DayOfYear 11 29) 2011 12 01 2012 12 15
-- [DateSpan 2011-11-29..2012-11-28,DateSpan 2012-11-29..2013-11-28] -- [DateSpan 2011-11-29..2012-11-28,DateSpan 2012-11-29..2013-11-28]
-- --
splitSpan :: Interval -> DateSpan -> [DateSpan] splitSpan :: Interval -> DateSpan -> [DateSpan]
@ -267,7 +265,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:
-- >>> mkdatespan "2018-01-01" "2018-01-03" `spanIntersect` mkdatespan "2018-01-03" "2018-01-05" -- >>> DateSpan (Just $ fromGregorian 2018 01 01) (Just $ fromGregorian 2018 01 03) `spanIntersect` DateSpan (Just $ fromGregorian 2018 01 03) (Just $ 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
@ -409,7 +407,7 @@ fixSmartDateStrEither' d s = case parsewith smartdateonly (T.toLower s) of
-- --
-- ==== Examples: -- ==== Examples:
-- >>> :set -XOverloadedStrings -- >>> :set -XOverloadedStrings
-- >>> let t = fixSmartDateStr (parsedate "2008/11/26") -- >>> let t = fixSmartDateStr (fromGregorian 2008 11 26)
-- >>> t "0000-01-01" -- >>> t "0000-01-01"
-- "0000-01-01" -- "0000-01-01"
-- >>> t "1999-12-02" -- >>> t "1999-12-02"
@ -542,7 +540,7 @@ startofyear day = fromGregorian y 1 1 where (y,_,_) = toGregorian day
-- Examples: lets take 2017-11-22. Year-long intervals covering it that -- Examples: lets take 2017-11-22. Year-long intervals covering it that
-- starts before Nov 22 will start in 2017. However -- starts before Nov 22 will start in 2017. However
-- intervals that start after Nov 23rd should start in 2016: -- intervals that start after Nov 23rd should start in 2016:
-- >>> let wed22nd = parsedate "2017-11-22" -- >>> let wed22nd = fromGregorian 2017 11 22
-- >>> nthdayofyearcontaining 11 21 wed22nd -- >>> nthdayofyearcontaining 11 21 wed22nd
-- 2017-11-21 -- 2017-11-21
-- >>> nthdayofyearcontaining 11 22 wed22nd -- >>> nthdayofyearcontaining 11 22 wed22nd
@ -573,7 +571,7 @@ nthdayofyearcontaining m md date
-- Examples: lets take 2017-11-22. Month-long intervals covering it that -- Examples: lets take 2017-11-22. Month-long intervals covering it that
-- start on 1st-22nd of month will start in Nov. However -- start on 1st-22nd of month will start in Nov. However
-- intervals that start on 23rd-30th of month should start in Oct: -- intervals that start on 23rd-30th of month should start in Oct:
-- >>> let wed22nd = parsedate "2017-11-22" -- >>> let wed22nd = fromGregorian 2017 11 22
-- >>> nthdayofmonthcontaining 1 wed22nd -- >>> nthdayofmonthcontaining 1 wed22nd
-- 2017-11-01 -- 2017-11-01
-- >>> nthdayofmonthcontaining 12 wed22nd -- >>> nthdayofmonthcontaining 12 wed22nd
@ -600,7 +598,7 @@ nthdayofmonthcontaining md date
-- Examples: 2017-11-22 is Wed. Week-long intervals that cover it and -- Examples: 2017-11-22 is Wed. Week-long intervals that cover it and
-- start on Mon, Tue or Wed will start in the same week. However -- start on Mon, Tue or Wed will start in the same week. However
-- intervals that start on Thu or Fri should start in prev week: -- intervals that start on Thu or Fri should start in prev week:
-- >>> let wed22nd = parsedate "2017-11-22" -- >>> let wed22nd = fromGregorian 2017 11 22
-- >>> nthdayofweekcontaining 1 wed22nd -- >>> nthdayofweekcontaining 1 wed22nd
-- 2017-11-20 -- 2017-11-20
-- >>> nthdayofweekcontaining 2 wed22nd -- >>> nthdayofweekcontaining 2 wed22nd
@ -624,7 +622,7 @@ nthdayofweekcontaining n d | nthOfSameWeek <= d = nthOfSameWeek
-- Examples: 2017-11-22 is 3rd Wed of Nov. Month-long intervals that cover it and -- Examples: 2017-11-22 is 3rd Wed of Nov. Month-long intervals that cover it and
-- start on 1st-4th Wed will start in Nov. However -- start on 1st-4th Wed will start in Nov. However
-- intervals that start on 4th Thu or Fri or later should start in Oct: -- intervals that start on 4th Thu or Fri or later should start in Oct:
-- >>> let wed22nd = parsedate "2017-11-22" -- >>> let wed22nd = fromGregorian 2017 11 22
-- >>> nthweekdayofmonthcontaining 1 3 wed22nd -- >>> nthweekdayofmonthcontaining 1 3 wed22nd
-- 2017-11-01 -- 2017-11-01
-- >>> nthweekdayofmonthcontaining 3 2 wed22nd -- >>> nthweekdayofmonthcontaining 3 2 wed22nd
@ -679,17 +677,6 @@ parsedateM s = asum [
parseTimeM True defaultTimeLocale "%Y.%m.%d" s parseTimeM True defaultTimeLocale "%Y.%m.%d" s
] ]
-- -- | Parse a date-time string to a time type, or raise an error.
-- parsedatetime :: String -> LocalTime
-- parsedatetime s = fromMaybe (error' $ "could not parse timestamp \"" ++ s ++ "\"")
-- (parsedatetimeM s)
-- | Like parsedateM, raising an error on parse failure.
parsedate :: String -> Day
parsedate s = fromMaybe (error' $ "could not parse date \"" ++ s ++ "\"") -- PARTIAL:
$ parsedateM s
{-| {-|
Parse a date in any of the formats allowed in Ledger's period expressions, and some others. Parse a date in any of the formats allowed in Ledger's period expressions, and some others.
Assumes any text in the parse stream has been lowercased. Assumes any text in the parse stream has been lowercased.
@ -835,7 +822,7 @@ weekday = do
-- resolving any relative start/end dates (only; it is not needed for -- resolving any relative start/end dates (only; it is not needed for
-- parsing the reporting interval). -- parsing the reporting interval).
-- --
-- >>> let p = parsePeriodExpr (parsedate "2008-11-26") -- >>> let p = parsePeriodExpr (fromGregorian 2008 11 26)
-- >>> p "from Aug to Oct" -- >>> p "from Aug to Oct"
-- Right (NoInterval,DateSpan 2008-08-01..2008-09-30) -- Right (NoInterval,DateSpan 2008-08-01..2008-09-30)
-- >>> p "aug to oct" -- >>> p "aug to oct"
@ -954,7 +941,7 @@ periodexprdatespanp rdate = choice $ map try [
] ]
-- | -- |
-- >>> parsewith (doubledatespanp (parsedate "2018/01/01") <* eof) "20180101-201804" -- >>> parsewith (doubledatespanp (fromGregorian 2018 01 01) <* eof) "20180101-201804"
-- Right DateSpan 2018Q1 -- Right DateSpan 2018Q1
doubledatespanp :: Day -> TextParser m DateSpan doubledatespanp :: Day -> TextParser m DateSpan
doubledatespanp rdate = liftA2 fromToSpan doubledatespanp rdate = liftA2 fromToSpan
@ -965,11 +952,11 @@ doubledatespanp rdate = liftA2 fromToSpan
fromToSpan = DateSpan `on` (Just . fixSmartDate rdate) fromToSpan = DateSpan `on` (Just . fixSmartDate rdate)
-- | -- |
-- >>> parsewith (quarterdatespanp (parsedate "2018/01/01") <* eof) "q1" -- >>> parsewith (quarterdatespanp (fromGregorian 2018 01 01) <* eof) "q1"
-- Right DateSpan 2018Q1 -- Right DateSpan 2018Q1
-- >>> parsewith (quarterdatespanp (parsedate "2018/01/01") <* eof) "Q1" -- >>> parsewith (quarterdatespanp (fromGregorian 2018 01 01) <* eof) "Q1"
-- Right DateSpan 2018Q1 -- Right DateSpan 2018Q1
-- >>> parsewith (quarterdatespanp (parsedate "2018/01/01") <* eof) "2020q4" -- >>> parsewith (quarterdatespanp (fromGregorian 2018 01 01) <* eof) "2020q4"
-- Right DateSpan 2020Q4 -- Right DateSpan 2020Q4
quarterdatespanp :: Day -> TextParser m DateSpan quarterdatespanp :: Day -> TextParser m DateSpan
quarterdatespanp rdate = do quarterdatespanp rdate = do
@ -998,11 +985,6 @@ justdatespanp rdate =
optional (string' "in" *> skipNonNewlineSpaces) optional (string' "in" *> skipNonNewlineSpaces)
*> (spanFromSmartDate rdate <$> smartdate) *> (spanFromSmartDate rdate <$> smartdate)
-- | Make a datespan from two valid date strings parseable by parsedate
-- (or raise an error). Eg: mkdatespan \"2011/1/1\" \"2011/12/31\".
mkdatespan :: String -> String -> DateSpan
mkdatespan = DateSpan `on` (Just . parsedate)
nulldatespan :: DateSpan nulldatespan :: DateSpan
nulldatespan = DateSpan Nothing Nothing nulldatespan = DateSpan Nothing Nothing

36
hledger-lib/Hledger/Data/Journal.hs
View File

@ -1295,7 +1295,7 @@ Right samplejournal = journalBalanceTransactions False $
txnTieKnot $ Transaction { txnTieKnot $ Transaction {
tindex=0, tindex=0,
tsourcepos=nullsourcepos, tsourcepos=nullsourcepos,
tdate=parsedate "2008/01/01", tdate=fromGregorian 2008 01 01,
tdate2=Nothing, tdate2=Nothing,
tstatus=Unmarked, tstatus=Unmarked,
tcode="", tcode="",
@ -1312,7 +1312,7 @@ Right samplejournal = journalBalanceTransactions False $
txnTieKnot $ Transaction { txnTieKnot $ Transaction {
tindex=0, tindex=0,
tsourcepos=nullsourcepos, tsourcepos=nullsourcepos,
tdate=parsedate "2008/06/01", tdate=fromGregorian 2008 06 01,
tdate2=Nothing, tdate2=Nothing,
tstatus=Unmarked, tstatus=Unmarked,
tcode="", tcode="",
@ -1329,7 +1329,7 @@ Right samplejournal = journalBalanceTransactions False $
txnTieKnot $ Transaction { txnTieKnot $ Transaction {
tindex=0, tindex=0,
tsourcepos=nullsourcepos, tsourcepos=nullsourcepos,
tdate=parsedate "2008/06/02", tdate=fromGregorian 2008 06 02,
tdate2=Nothing, tdate2=Nothing,
tstatus=Unmarked, tstatus=Unmarked,
tcode="", tcode="",
@ -1346,7 +1346,7 @@ Right samplejournal = journalBalanceTransactions False $
txnTieKnot $ Transaction { txnTieKnot $ Transaction {
tindex=0, tindex=0,
tsourcepos=nullsourcepos, tsourcepos=nullsourcepos,
tdate=parsedate "2008/06/03", tdate=fromGregorian 2008 06 03,
tdate2=Nothing, tdate2=Nothing,
tstatus=Cleared, tstatus=Cleared,
tcode="", tcode="",
@ -1363,7 +1363,7 @@ Right samplejournal = journalBalanceTransactions False $
txnTieKnot $ Transaction { txnTieKnot $ Transaction {
tindex=0, tindex=0,
tsourcepos=nullsourcepos, tsourcepos=nullsourcepos,
tdate=parsedate "2008/10/01", tdate=fromGregorian 2008 10 01,
tdate2=Nothing, tdate2=Nothing,
tstatus=Unmarked, tstatus=Unmarked,
tcode="", tcode="",
@ -1379,7 +1379,7 @@ Right samplejournal = journalBalanceTransactions False $
txnTieKnot $ Transaction { txnTieKnot $ Transaction {
tindex=0, tindex=0,
tsourcepos=nullsourcepos, tsourcepos=nullsourcepos,
tdate=parsedate "2008/12/31", tdate=fromGregorian 2008 12 31,
tdate2=Nothing, tdate2=Nothing,
tstatus=Unmarked, tstatus=Unmarked,
tcode="", tcode="",
@ -1398,11 +1398,11 @@ tests_Journal = tests "Journal" [
test "journalDateSpan" $ test "journalDateSpan" $
journalDateSpan True nulljournal{ journalDateSpan True nulljournal{
jtxns = [nulltransaction{tdate = parsedate "2014/02/01" jtxns = [nulltransaction{tdate = fromGregorian 2014 02 01
,tpostings = [posting{pdate=Just (parsedate "2014/01/10")}] ,tpostings = [posting{pdate=Just (fromGregorian 2014 01 10)}]
} }
,nulltransaction{tdate = parsedate "2014/09/01" ,nulltransaction{tdate = fromGregorian 2014 09 01
,tpostings = [posting{pdate2=Just (parsedate "2014/10/10")}] ,tpostings = [posting{pdate2=Just (fromGregorian 2014 10 10)}]
} }
] ]
} }
@ -1436,7 +1436,7 @@ tests_Journal = tests "Journal" [
--2019/01/01 --2019/01/01
-- (a) = 1 -- (a) = 1
nulljournal{ jtxns = [ nulljournal{ jtxns = [
transaction "2019/01/01" [ vpost' "a" missingamt (balassert (num 1)) ] transaction (fromGregorian 2019 01 01) [ vpost' "a" missingamt (balassert (num 1)) ]
]} ]}
assertRight ej assertRight ej
let Right j = ej let Right j = ej
@ -1449,8 +1449,8 @@ tests_Journal = tests "Journal" [
--2019/01/01 --2019/01/01
-- (a) 1 = 2 -- (a) 1 = 2
nulljournal{ jtxns = [ nulljournal{ jtxns = [
transaction "2019/01/01" [ vpost' "a" missingamt (balassert (num 1)) ] transaction (fromGregorian 2019 01 01) [ vpost' "a" missingamt (balassert (num 1)) ]
,transaction "2019/01/01" [ vpost' "a" (num 1) (balassert (num 2)) ] ,transaction (fromGregorian 2019 01 01) [ vpost' "a" (num 1) (balassert (num 2)) ]
]} ]}
,test "same-day-2" $ do ,test "same-day-2" $ do
@ -1463,12 +1463,12 @@ tests_Journal = tests "Journal" [
--2019/01/01 --2019/01/01
-- a 0 = 1 -- a 0 = 1
nulljournal{ jtxns = [ nulljournal{ jtxns = [
transaction "2019/01/01" [ vpost' "a" (num 2) (balassert (num 2)) ] transaction (fromGregorian 2019 01 01) [ vpost' "a" (num 2) (balassert (num 2)) ]
,transaction "2019/01/01" [ ,transaction (fromGregorian 2019 01 01) [
post' "b" (num 1) Nothing post' "b" (num 1) Nothing
,post' "a" missingamt Nothing ,post' "a" missingamt Nothing
] ]
,transaction "2019/01/01" [ post' "a" (num 0) (balassert (num 1)) ] ,transaction (fromGregorian 2019 01 01) [ post' "a" (num 0) (balassert (num 1)) ]
]} ]}
,test "out-of-order" $ do ,test "out-of-order" $ do
@ -1478,8 +1478,8 @@ tests_Journal = tests "Journal" [
--2019/1/1 --2019/1/1
-- (a) 1 = 1 -- (a) 1 = 1
nulljournal{ jtxns = [ nulljournal{ jtxns = [
transaction "2019/01/02" [ vpost' "a" (num 1) (balassert (num 2)) ] transaction (fromGregorian 2019 01 02) [ vpost' "a" (num 1) (balassert (num 2)) ]
,transaction "2019/01/01" [ vpost' "a" (num 1) (balassert (num 1)) ] ,transaction (fromGregorian 2019 01 01) [ vpost' "a" (num 1) (balassert (num 1)) ]
]} ]}
] ]

17
hledger-lib/Hledger/Data/PeriodicTransaction.hs
View File

@ -13,7 +13,7 @@ module Hledger.Data.PeriodicTransaction (
where where
#if !(MIN_VERSION_base(4,11,0)) #if !(MIN_VERSION_base(4,11,0))
import Data.Monoid ((<>)) import Data.Semigroup ((<>))
#endif #endif
import qualified Data.Text as T import qualified Data.Text as T
import Text.Printf import Text.Printf
@ -85,6 +85,7 @@ instance Show PeriodicTransaction where
-- - a generated-transaction: tag -- - a generated-transaction: tag
-- - a hidden _generated-transaction: tag which does not appear in the comment. -- - a hidden _generated-transaction: tag which does not appear in the comment.
-- --
-- >>> import Data.Time (fromGregorian)
-- >>> _ptgen "monthly from 2017/1 to 2017/4" -- >>> _ptgen "monthly from 2017/1 to 2017/4"
-- 2017-01-01 -- 2017-01-01
-- ; generated-transaction: ~ monthly from 2017/1 to 2017/4 -- ; generated-transaction: ~ monthly from 2017/1 to 2017/4
@ -207,17 +208,17 @@ instance Show PeriodicTransaction where
-- >>> _ptgen "yearly from 2017/1/14" -- >>> _ptgen "yearly from 2017/1/14"
-- *** Exception: Unable to generate transactions according to "yearly from 2017/1/14" because 2017-01-14 is not a first day of the Year -- *** Exception: Unable to generate transactions according to "yearly from 2017/1/14" because 2017-01-14 is not a first day of the Year
-- --
-- >>> 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 $ parsedate "2018-01-01") (Just $ parsedate "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 $ fromGregorian 2018 01 01) (Just $ fromGregorian 2018 01 03))
-- [] -- []
-- --
-- >>> _ptgenspan "every 3 months from 2019-05" (mkdatespan "2020-01-01" "2020-02-01") -- >>> _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" (mkdatespan "2020-02-01" "2020-03-01") -- >>> _ptgenspan "every 3 months from 2019-05" (DateSpan (Just $ fromGregorian 2020 02 01) (Just $ 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" (mkdatespan "2018-01-01" "2018-01-05") -- >>> _ptgenspan "every 3 days from 2018" (DateSpan (Just $ fromGregorian 2018 01 01) (Just $ 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
@ -226,7 +227,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" (mkdatespan "2018-01-02" "2018-01-05") -- >>> _ptgenspan "every 3 days from 2018" (DateSpan (Just $ fromGregorian 2018 01 02) (Just $ 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
@ -252,7 +253,7 @@ runPeriodicTransaction PeriodicTransaction{..} requestedspan =
-- If transaction does not have start/end date, we set them to start/end of requested span, -- If transaction does not have start/end date, we set them to start/end of requested span,
-- to avoid generating (infinitely) many events. -- to avoid generating (infinitely) many events.
alltxnspans = dbg3 "alltxnspans" $ ptinterval `splitSpan` (spanDefaultsFrom ptspan requestedspan) alltxnspans = dbg3 "alltxnspans" $ ptinterval `splitSpan` (spanDefaultsFrom ptspan requestedspan)
-- | Check that this date span begins at a boundary of this interval, -- | Check that this date span begins at a boundary of this interval,
-- or return an explanatory error message including the provided period expression -- or return an explanatory error message including the provided period expression
-- (from which the span and interval are derived). -- (from which the span and interval are derived).

42
hledger-lib/Hledger/Data/Transaction.hs
View File

@ -105,8 +105,8 @@ nulltransaction = Transaction {
} }
-- | Make a simple transaction with the given date and postings. -- | Make a simple transaction with the given date and postings.
transaction :: String -> [Posting] -> Transaction transaction :: Day -> [Posting] -> Transaction
transaction datestr ps = txnTieKnot $ nulltransaction{tdate=parsedate datestr, tpostings=ps} transaction day ps = txnTieKnot $ nulltransaction{tdate=day, tpostings=ps}
transactionPayee :: Transaction -> Text transactionPayee :: Transaction -> Text
transactionPayee = fst . payeeAndNoteFromDescription . tdescription transactionPayee = fst . payeeAndNoteFromDescription . tdescription
@ -669,8 +669,8 @@ tests_Transaction =
test "null transaction" $ showTransaction nulltransaction @?= "0000-01-01\n\n" test "null transaction" $ showTransaction nulltransaction @?= "0000-01-01\n\n"
, test "non-null transaction" $ showTransaction , test "non-null transaction" $ showTransaction
nulltransaction nulltransaction
{ tdate = parsedate "2012/05/14" { tdate = fromGregorian 2012 05 14
, tdate2 = Just $ parsedate "2012/05/15" , tdate2 = Just $ fromGregorian 2012 05 15
, tstatus = Unmarked , tstatus = Unmarked
, tcode = "code" , tcode = "code"
, tdescription = "desc" , tdescription = "desc"
@ -702,7 +702,7 @@ tests_Transaction =
0 0
"" ""
nullsourcepos nullsourcepos
(parsedate "2007/01/28") (fromGregorian 2007 01 28)
Nothing Nothing
Unmarked Unmarked
"" ""
@ -726,7 +726,7 @@ tests_Transaction =
0 0
"" ""
nullsourcepos nullsourcepos
(parsedate "2007/01/28") (fromGregorian 2007 01 28)
Nothing Nothing
Unmarked Unmarked
"" ""
@ -749,7 +749,7 @@ tests_Transaction =
0 0
"" ""
nullsourcepos nullsourcepos
(parsedate "2007/01/28") (fromGregorian 2007 01 28)
Nothing Nothing
Unmarked Unmarked
"" ""
@ -765,7 +765,7 @@ tests_Transaction =
0 0
"" ""
nullsourcepos nullsourcepos
(parsedate "2010/01/01") (fromGregorian 2010 01 01)
Nothing Nothing
Unmarked Unmarked
"" ""
@ -786,7 +786,7 @@ tests_Transaction =
0 0
"" ""
nullsourcepos nullsourcepos
(parsedate "2007/01/28") (fromGregorian 2007 01 28)
Nothing Nothing
Unmarked Unmarked
"" ""
@ -802,7 +802,7 @@ tests_Transaction =
0 0
"" ""
nullsourcepos nullsourcepos
(parsedate "2007/01/28") (fromGregorian 2007 01 28)
Nothing Nothing
Unmarked Unmarked
"" ""
@ -820,7 +820,7 @@ tests_Transaction =
0 0
"" ""
nullsourcepos nullsourcepos
(parsedate "2007/01/28") (fromGregorian 2007 01 28)
Nothing Nothing
Unmarked Unmarked
"" ""
@ -837,7 +837,7 @@ tests_Transaction =
0 0
"" ""
nullsourcepos nullsourcepos
(parsedate "2007/01/28") (fromGregorian 2007 01 28)
Nothing Nothing
Unmarked Unmarked
"" ""
@ -856,7 +856,7 @@ tests_Transaction =
0 0
"" ""
nullsourcepos nullsourcepos
(parsedate "2011/01/01") (fromGregorian 2011 01 01)
Nothing Nothing
Unmarked Unmarked
"" ""
@ -874,7 +874,7 @@ tests_Transaction =
0 0
"" ""
nullsourcepos nullsourcepos
(parsedate "2011/01/01") (fromGregorian 2011 01 01)
Nothing Nothing
Unmarked Unmarked
"" ""
@ -893,7 +893,7 @@ tests_Transaction =
0 0
"" ""
nullsourcepos nullsourcepos
(parsedate "2009/01/01") (fromGregorian 2009 01 01)
Nothing Nothing
Unmarked Unmarked
"" ""
@ -911,7 +911,7 @@ tests_Transaction =
0 0
"" ""
nullsourcepos nullsourcepos
(parsedate "2009/01/01") (fromGregorian 2009 01 01)
Nothing Nothing
Unmarked Unmarked
"" ""
@ -929,7 +929,7 @@ tests_Transaction =
0 0
"" ""
nullsourcepos nullsourcepos
(parsedate "2009/01/01") (fromGregorian 2009 01 01)
Nothing Nothing
Unmarked Unmarked
"" ""
@ -944,7 +944,7 @@ tests_Transaction =
0 0
"" ""
nullsourcepos nullsourcepos
(parsedate "2009/01/01") (fromGregorian 2009 01 01)
Nothing Nothing
Unmarked Unmarked
"" ""
@ -959,7 +959,7 @@ tests_Transaction =
0 0
"" ""
nullsourcepos nullsourcepos
(parsedate "2009/01/01") (fromGregorian 2009 01 01)
Nothing Nothing
Unmarked Unmarked
"" ""
@ -978,7 +978,7 @@ tests_Transaction =
0 0
"" ""
nullsourcepos nullsourcepos
(parsedate "2009/01/01") (fromGregorian 2009 01 01)
Nothing Nothing
Unmarked Unmarked
"" ""
@ -996,7 +996,7 @@ tests_Transaction =
0 0
"" ""
nullsourcepos nullsourcepos
(parsedate "2009/01/01") (fromGregorian 2009 01 01)
Nothing Nothing
Unmarked Unmarked
"" ""

24
hledger-lib/Hledger/Data/Valuation.hs
View File

@ -38,7 +38,7 @@ import Data.List.Extra (nubSortBy)
import qualified Data.Map as M import qualified Data.Map as M
import Data.Maybe import Data.Maybe
import qualified Data.Text as T import qualified Data.Text as T
import Data.Time.Calendar (Day) import Data.Time.Calendar (Day, fromGregorian)
import Data.MemoUgly (memo) import Data.MemoUgly (memo)
import GHC.Generics (Generic) import GHC.Generics (Generic)
import Safe (headMay) import Safe (headMay)
@ -46,7 +46,6 @@ import Safe (headMay)
import Hledger.Utils import Hledger.Utils
import Hledger.Data.Types import Hledger.Data.Types
import Hledger.Data.Amount import Hledger.Data.Amount
import Hledger.Data.Dates (parsedate)
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
@ -268,21 +267,20 @@ priceLookup makepricegraph d from mto =
tests_priceLookup = tests_priceLookup =
let let
d = parsedate p y m d from q to = MarketPrice{mpdate=fromGregorian y m d, mpfrom=from, mpto=to, mprate=q}
p date from q to = MarketPrice{mpdate=d date, mpfrom=from, mpto=to, mprate=q}
ps1 = [ ps1 = [
p "2000/01/01" "A" 10 "B" p 2000 01 01 "A" 10 "B"
,p "2000/01/01" "B" 10 "C" ,p 2000 01 01 "B" 10 "C"
,p "2000/01/01" "C" 10 "D" ,p 2000 01 01 "C" 10 "D"
,p "2000/01/01" "E" 2 "D" ,p 2000 01 01 "E" 2 "D"
,p "2001/01/01" "A" 11 "B" ,p 2001 01 01 "A" 11 "B"
] ]
makepricegraph = makePriceGraph ps1 [] makepricegraph = makePriceGraph ps1 []
in test "priceLookup" $ do in test "priceLookup" $ do
priceLookup makepricegraph (d "1999/01/01") "A" Nothing @?= Nothing priceLookup makepricegraph (fromGregorian 1999 01 01) "A" Nothing @?= Nothing
priceLookup makepricegraph (d "2000/01/01") "A" Nothing @?= Just ("B",10) priceLookup makepricegraph (fromGregorian 2000 01 01) "A" Nothing @?= Just ("B",10)
priceLookup makepricegraph (d "2000/01/01") "B" (Just "A") @?= Just ("A",0.1) priceLookup makepricegraph (fromGregorian 2000 01 01) "B" (Just "A") @?= Just ("A",0.1)
priceLookup makepricegraph (d "2000/01/01") "A" (Just "E") @?= Just ("E",500) priceLookup makepricegraph (fromGregorian 2000 01 01) "A" (Just "E") @?= Just ("E",500)
-- | Build the graph of commodity conversion prices for a given day. -- | Build the graph of commodity conversion prices for a given day.
-- Converts a list of declared market prices in parse order, and a -- Converts a list of declared market prices in parse order, and a

10
hledger-lib/Hledger/Query.hs
View File

@ -791,8 +791,8 @@ tests_Query = tests "Query" [
(simplifyQuery $ And [Any,Any]) @?= (Any) (simplifyQuery $ And [Any,Any]) @?= (Any)
(simplifyQuery $ And [Acct "b",Any]) @?= (Acct "b") (simplifyQuery $ And [Acct "b",Any]) @?= (Acct "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 $ parsedate "2013-01-01")), Date (DateSpan (Just $ parsedate "2012-01-01") Nothing)]) (simplifyQuery $ And [Date (DateSpan Nothing (Just $ fromGregorian 2013 01 01)), Date (DateSpan (Just $ fromGregorian 2012 01 01) Nothing)])
@?= (Date (DateSpan (Just $ parsedate "2012-01-01") (Just $ parsedate "2013-01-01"))) @?= (Date (DateSpan (Just $ fromGregorian 2012 01 01) (Just $ fromGregorian 2013 01 01)))
(simplifyQuery $ And [Or [],Or [Desc "b b"]]) @?= (Desc "b b") (simplifyQuery $ And [Or [],Or [Desc "b b"]]) @?= (Desc "b b")
,test "parseQuery" $ do ,test "parseQuery" $ do
@ -831,9 +831,9 @@ tests_Query = tests "Query" [
parseQueryTerm nulldate "payee:x" @?= Right (Left $ Tag "payee" (Just "x")) parseQueryTerm nulldate "payee:x" @?= Right (Left $ Tag "payee" (Just "x"))
parseQueryTerm nulldate "note:x" @?= Right (Left $ Tag "note" (Just "x")) parseQueryTerm nulldate "note:x" @?= Right (Left $ Tag "note" (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 $ parsedate "2008/01/01") (Just $ parsedate "2009/01/01")) parseQueryTerm nulldate "date:2008" @?= Right (Left $ Date $ DateSpan (Just $ fromGregorian 2008 01 01) (Just $ fromGregorian 2009 01 01))
parseQueryTerm nulldate "date:from 2012/5/17" @?= Right (Left $ Date $ DateSpan (Just $ parsedate "2012/05/17") Nothing) parseQueryTerm nulldate "date:from 2012/5/17" @?= Right (Left $ Date $ DateSpan (Just $ fromGregorian 2012 05 17) Nothing)
parseQueryTerm nulldate "date:20180101-201804" @?= Right (Left $ Date $ DateSpan (Just $ parsedate "2018/01/01") (Just $ parsedate "2018/04/01")) parseQueryTerm nulldate "date:20180101-201804" @?= Right (Left $ Date $ DateSpan (Just $ fromGregorian 2018 01 01) (Just $ 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 "a" Nothing) parseQueryTerm nulldate "tag:a" @?= Right (Left $ Tag "a" Nothing)
parseQueryTerm nulldate "tag:a=some value" @?= Right (Left $ Tag "a" (Just "some value")) parseQueryTerm nulldate "tag:a=some value" @?= Right (Left $ Tag "a" (Just "some value"))

6
hledger-lib/Hledger/Read.hs
View File

@ -67,7 +67,7 @@ import System.Info (os)
import System.IO (stderr, writeFile) import System.IO (stderr, writeFile)
import Text.Printf (hPrintf, printf) import Text.Printf (hPrintf, printf)
import Hledger.Data.Dates (getCurrentDay, parsedate, showDate) import Hledger.Data.Dates (getCurrentDay, parsedateM, showDate)
import Hledger.Data.Types import Hledger.Data.Types
import Hledger.Read.Common import Hledger.Read.Common
import Hledger.Read.JournalReader as JournalReader import Hledger.Read.JournalReader as JournalReader
@ -251,9 +251,11 @@ saveLatestDates dates f = writeFile (latestDatesFileFor f) $ unlines $ map showD
previousLatestDates :: FilePath -> IO LatestDates previousLatestDates :: FilePath -> IO LatestDates
previousLatestDates f = do previousLatestDates f = do
let latestfile = latestDatesFileFor f let latestfile = latestDatesFileFor f
parsedate s = maybe (fail $ "could not parse date \"" ++ s ++ "\"") return $
parsedateM s
exists <- doesFileExist latestfile exists <- doesFileExist latestfile
if exists if exists
then map (parsedate . strip) . lines . strip . T.unpack <$> readFileStrictly latestfile then traverse (parsedate . T.unpack . T.strip) . T.lines =<< readFileStrictly latestfile
else return [] else return []
-- | Where to save latest transaction dates for the given file path. -- | Where to save latest transaction dates for the given file path.

6
hledger-lib/Hledger/Read/CsvReader.hs
View File

@ -887,7 +887,7 @@ transactionFromCsvRecord sourcepos rules record = t
-- ruleval = csvRuleValue rules record :: DirectiveName -> Maybe String -- ruleval = csvRuleValue rules record :: DirectiveName -> Maybe String
field = hledgerField rules record :: HledgerFieldName -> Maybe FieldTemplate field = hledgerField rules record :: HledgerFieldName -> Maybe FieldTemplate
fieldval = hledgerFieldValue rules record :: HledgerFieldName -> Maybe String fieldval = hledgerFieldValue rules record :: HledgerFieldName -> Maybe String
parsedate' = parseDateWithCustomOrDefaultFormats (rule "date-format") parsedate = parseDateWithCustomOrDefaultFormats (rule "date-format")
mkdateerror datefield datevalue mdateformat = unlines mkdateerror datefield datevalue mdateformat = unlines
["error: could not parse \""++datevalue++"\" as a date using date format " ["error: could not parse \""++datevalue++"\" as a date using date format "
++maybe "\"YYYY/M/D\", \"YYYY-M-D\" or \"YYYY.M.D\"" show mdateformat ++maybe "\"YYYY/M/D\", \"YYYY-M-D\" or \"YYYY.M.D\"" show mdateformat
@ -911,9 +911,9 @@ transactionFromCsvRecord sourcepos rules record = t
mdateformat = rule "date-format" mdateformat = rule "date-format"
date = fromMaybe "" $ fieldval "date" date = fromMaybe "" $ fieldval "date"
-- PARTIAL: -- PARTIAL:
date' = fromMaybe (error' $ mkdateerror "date" date mdateformat) $ parsedate' date date' = fromMaybe (error' $ mkdateerror "date" date mdateformat) $ parsedate date
mdate2 = fieldval "date2" mdate2 = fieldval "date2"
mdate2' = maybe Nothing (maybe (error' $ mkdateerror "date2" (fromMaybe "" mdate2) mdateformat) Just . parsedate') mdate2 mdate2' = maybe Nothing (maybe (error' $ mkdateerror "date2" (fromMaybe "" mdate2) mdateformat) Just . parsedate) mdate2
status = status =
case fieldval "status" of case fieldval "status" of
Nothing -> Unmarked Nothing -> Unmarked

4
hledger-lib/Hledger/Reports/BalanceReport.hs
View File

@ -82,8 +82,8 @@ Right samplejournal2 =
txnTieKnot Transaction{ txnTieKnot Transaction{
tindex=0, tindex=0,
tsourcepos=nullsourcepos, tsourcepos=nullsourcepos,
tdate=parsedate "2008/01/01", tdate=fromGregorian 2008 01 01,
tdate2=Just $ parsedate "2009/01/01", tdate2=Just $ fromGregorian 2009 01 01,
tstatus=Unmarked, tstatus=Unmarked,
tcode="", tcode="",
tdescription="income", tdescription="income",

9
hledger-lib/Hledger/Reports/EntriesReport.hs
View File

@ -14,9 +14,10 @@ module Hledger.Reports.EntriesReport (
) )
where where
import Data.List import Data.List (sortBy)
import Data.Maybe import Data.Maybe (fromMaybe)
import Data.Ord import Data.Ord (comparing)
import Data.Time (fromGregorian)
import Hledger.Data import Hledger.Data
import Hledger.Query import Hledger.Query
@ -50,7 +51,7 @@ entriesReport ropts@ReportOpts{..} q j@Journal{..} =
tests_EntriesReport = tests "EntriesReport" [ tests_EntriesReport = tests "EntriesReport" [
tests "entriesReport" [ tests "entriesReport" [
test "not acct" $ (length $ entriesReport defreportopts (Not $ Acct "bank") samplejournal) @?= 1 test "not acct" $ (length $ entriesReport defreportopts (Not $ Acct "bank") samplejournal) @?= 1
,test "date" $ (length $ entriesReport defreportopts (Date $ mkdatespan "2008/06/01" "2008/07/01") samplejournal) @?= 3 ,test "date" $ (length $ entriesReport defreportopts (Date $ DateSpan (Just $ fromGregorian 2008 06 01) (Just $ fromGregorian 2008 07 01)) samplejournal) @?= 3
] ]
] ]

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

@ -286,7 +286,7 @@ tests_PostingsReport = tests "PostingsReport" [
(length $ snd $ postingsReport defreportopts (Acct "assets:bank:checking") samplejournal) @?= 5 (length $ snd $ postingsReport defreportopts (Acct "assets:bank:checking") samplejournal) @?= 5
-- (defreportopts, And [Acct "a a", Acct "'b"], samplejournal2) `gives` 0 -- (defreportopts, And [Acct "a a", Acct "'b"], samplejournal2) `gives` 0
-- [(Just (parsedate "2008-01-01","income"),assets:bank:checking $1,$1) -- [(Just (fromGregorian 2008 01 01,"income"),assets:bank:checking $1,$1)
-- ,(Nothing,income:salary $-1,0) -- ,(Nothing,income:salary $-1,0)
-- ,(Just (2008-06-01,"gift"),assets:bank:checking $1,$1) -- ,(Just (2008-06-01,"gift"),assets:bank:checking $1,$1)
-- ,(Nothing,income:gifts $-1,0) -- ,(Nothing,income:gifts $-1,0)
@ -437,7 +437,7 @@ tests_PostingsReport = tests "PostingsReport" [
-- ,tests_summarisePostingsInDateSpan = [ -- ,tests_summarisePostingsInDateSpan = [
-- "summarisePostingsInDateSpan" ~: do -- "summarisePostingsInDateSpan" ~: do
-- let gives (b,e,depth,showempty,ps) = -- let gives (b,e,depth,showempty,ps) =
-- (summarisePostingsInDateSpan (mkdatespan b e) depth showempty ps `is`) -- (summarisePostingsInDateSpan (DateSpan b e) depth showempty ps `is`)
-- let ps = -- let ps =
-- [ -- [
-- nullposting{lpdescription="desc",lpaccount="expenses:food:groceries",lpamount=Mixed [usd 1]} -- nullposting{lpdescription="desc",lpaccount="expenses:food:groceries",lpamount=Mixed [usd 1]}
@ -449,25 +449,25 @@ tests_PostingsReport = tests "PostingsReport" [
-- [] -- []
-- ("2008/01/01","2009/01/01",0,9999,True,[]) `gives` -- ("2008/01/01","2009/01/01",0,9999,True,[]) `gives`
-- [ -- [
-- nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31"} -- nullposting{lpdate=fromGregorian 2008 01 01,lpdescription="- 2008/12/31"}
-- ] -- ]
-- ("2008/01/01","2009/01/01",0,9999,False,ts) `gives` -- ("2008/01/01","2009/01/01",0,9999,False,ts) `gives`
-- [ -- [
-- nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses:food", lpamount=Mixed [usd 4]} -- nullposting{lpdate=fromGregorian 2008 01 01,lpdescription="- 2008/12/31",lpaccount="expenses:food", lpamount=Mixed [usd 4]}
-- ,nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses:food:dining", lpamount=Mixed [usd 10]} -- ,nullposting{lpdate=fromGregorian 2008 01 01,lpdescription="- 2008/12/31",lpaccount="expenses:food:dining", lpamount=Mixed [usd 10]}
-- ,nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses:food:groceries",lpamount=Mixed [usd 1]} -- ,nullposting{lpdate=fromGregorian 2008 01 01,lpdescription="- 2008/12/31",lpaccount="expenses:food:groceries",lpamount=Mixed [usd 1]}
-- ] -- ]
-- ("2008/01/01","2009/01/01",0,2,False,ts) `gives` -- ("2008/01/01","2009/01/01",0,2,False,ts) `gives`
-- [ -- [
-- nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses:food",lpamount=Mixed [usd 15]} -- nullposting{lpdate=fromGregorian 2008 01 01,lpdescription="- 2008/12/31",lpaccount="expenses:food",lpamount=Mixed [usd 15]}
-- ] -- ]
-- ("2008/01/01","2009/01/01",0,1,False,ts) `gives` -- ("2008/01/01","2009/01/01",0,1,False,ts) `gives`
-- [ -- [
-- nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses",lpamount=Mixed [usd 15]} -- nullposting{lpdate=fromGregorian 2008 01 01,lpdescription="- 2008/12/31",lpaccount="expenses",lpamount=Mixed [usd 15]}
-- ] -- ]
-- ("2008/01/01","2009/01/01",0,0,False,ts) `gives` -- ("2008/01/01","2009/01/01",0,0,False,ts) `gives`
-- [ -- [
-- nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="",lpamount=Mixed [usd 15]} -- nullposting{lpdate=fromGregorian 2008 01 01,lpdescription="- 2008/12/31",lpaccount="",lpamount=Mixed [usd 15]}
-- ] -- ]
] ]

8
hledger-lib/Hledger/Reports/ReportOptions.hs
View File

@ -575,15 +575,15 @@ tests_ReportOptions = tests "ReportOptions" [
queryFromOpts nulldate defreportopts @?= Any queryFromOpts nulldate defreportopts @?= Any
queryFromOpts nulldate defreportopts{query_="a"} @?= Acct "a" queryFromOpts nulldate defreportopts{query_="a"} @?= Acct "a"
queryFromOpts nulldate defreportopts{query_="desc:'a a'"} @?= Desc "a a" queryFromOpts nulldate defreportopts{query_="desc:'a a'"} @?= Desc "a a"
queryFromOpts nulldate defreportopts{period_=PeriodFrom (parsedate "2012/01/01"),query_="date:'to 2013'" } queryFromOpts nulldate defreportopts{period_=PeriodFrom (fromGregorian 2012 01 01),query_="date:'to 2013'" }
@?= (Date $ mkdatespan "2012/01/01" "2013/01/01") @?= (Date $ DateSpan (Just $ fromGregorian 2012 01 01) (Just $ fromGregorian 2013 01 01))
queryFromOpts nulldate defreportopts{query_="date2:'in 2012'"} @?= (Date2 $ mkdatespan "2012/01/01" "2013/01/01") queryFromOpts nulldate defreportopts{query_="date2:'in 2012'"} @?= (Date2 $ DateSpan (Just $ fromGregorian 2012 01 01) (Just $ fromGregorian 2013 01 01))
queryFromOpts nulldate defreportopts{query_="'a a' 'b"} @?= Or [Acct "a a", Acct "'b"] queryFromOpts nulldate defreportopts{query_="'a a' 'b"} @?= Or [Acct "a a", Acct "'b"]
,test "queryOptsFromOpts" $ do ,test "queryOptsFromOpts" $ do
queryOptsFromOpts nulldate defreportopts @?= [] queryOptsFromOpts nulldate defreportopts @?= []
queryOptsFromOpts nulldate defreportopts{query_="a"} @?= [] queryOptsFromOpts nulldate defreportopts{query_="a"} @?= []
queryOptsFromOpts nulldate defreportopts{period_=PeriodFrom (parsedate "2012/01/01") queryOptsFromOpts nulldate defreportopts{period_=PeriodFrom (fromGregorian 2012 01 01)
,query_="date:'to 2013'"} @?= [] ,query_="date:'to 2013'"} @?= []
] ]

14
hledger/Hledger/Cli/Commands.hs
View File

@ -363,7 +363,7 @@ tests_Commands = tests "Commands" [
-- test data -- test data
-- date1 = parsedate "2008/11/26" -- date1 = fromGregorian 2008 11 26
-- t1 = LocalTime date1 midday -- t1 = LocalTime date1 midday
{- {-
@ -569,7 +569,7 @@ journal7 = nulljournal {jtxns =
txnTieKnot Transaction { txnTieKnot Transaction {
tindex=0, tindex=0,
tsourcepos=nullsourcepos, tsourcepos=nullsourcepos,
tdate=parsedate "2007/01/01", tdate=fromGregorian 2007 01 01,
tdate2=Nothing, tdate2=Nothing,
tstatus=Unmarked, tstatus=Unmarked,
tcode="*", tcode="*",
@ -586,7 +586,7 @@ journal7 = nulljournal {jtxns =
txnTieKnot Transaction { txnTieKnot Transaction {
tindex=0, tindex=0,
tsourcepos=nullsourcepos, tsourcepos=nullsourcepos,
tdate=parsedate "2007/02/01", tdate=fromGregorian 2007 02 01,
tdate2=Nothing, tdate2=Nothing,
tstatus=Unmarked, tstatus=Unmarked,
tcode="*", tcode="*",
@ -603,7 +603,7 @@ journal7 = nulljournal {jtxns =
txnTieKnot Transaction { txnTieKnot Transaction {
tindex=0, tindex=0,
tsourcepos=nullsourcepos, tsourcepos=nullsourcepos,
tdate=parsedate "2007/01/02", tdate=fromGregorian 2007 01 02,
tdate2=Nothing, tdate2=Nothing,
tstatus=Unmarked, tstatus=Unmarked,
tcode="*", tcode="*",
@ -620,7 +620,7 @@ journal7 = nulljournal {jtxns =
txnTieKnot Transaction { txnTieKnot Transaction {
tindex=0, tindex=0,
tsourcepos=nullsourcepos, tsourcepos=nullsourcepos,
tdate=parsedate "2007/01/03", tdate=fromGregorian 2007 01 03,
tdate2=Nothing, tdate2=Nothing,
tstatus=Unmarked, tstatus=Unmarked,
tcode="*", tcode="*",
@ -637,7 +637,7 @@ journal7 = nulljournal {jtxns =
txnTieKnot Transaction { txnTieKnot Transaction {
tindex=0, tindex=0,
tsourcepos=nullsourcepos, tsourcepos=nullsourcepos,
tdate=parsedate "2007/01/03", tdate=fromGregorian 2007 01 03,
tdate2=Nothing, tdate2=Nothing,
tstatus=Unmarked, tstatus=Unmarked,
tcode="*", tcode="*",
@ -654,7 +654,7 @@ journal7 = nulljournal {jtxns =
txnTieKnot Transaction { txnTieKnot Transaction {
tindex=0, tindex=0,
tsourcepos=nullsourcepos, tsourcepos=nullsourcepos,
tdate=parsedate "2007/01/03", tdate=fromGregorian 2007 01 03,
tdate2=Nothing, tdate2=Nothing,
tstatus=Unmarked, tstatus=Unmarked,
tcode="*", tcode="*",

3
hledger/Hledger/Cli/Commands/Balance.hs
View File

@ -258,6 +258,7 @@ import Data.Maybe
--import qualified Data.Map as Map --import qualified Data.Map as Map
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy as TL
import Data.Time (fromGregorian)
import System.Console.CmdArgs.Explicit as C import System.Console.CmdArgs.Explicit as C
import Lucid as L import Lucid as L
import Text.Printf (printf) import Text.Printf (printf)
@ -639,7 +640,7 @@ tests_Balance = tests "Balance" [
test "unicode in balance layout" $ do test "unicode in balance layout" $ do
j <- readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n" j <- readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n"
let opts = defreportopts let opts = defreportopts
balanceReportAsText opts (balanceReport opts (queryFromOpts (parsedate "2008/11/26") opts) j) balanceReportAsText opts (balanceReport opts (queryFromOpts (fromGregorian 2008 11 26) opts) j)
@?= @?=
unlines unlines
[" -100 актив:наличные" [" -100 актив:наличные"

3
hledger/Hledger/Cli/Commands/Register.hs
View File

@ -23,6 +23,7 @@ import Data.Maybe
-- import Data.Text (Text) -- import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy as TL
import Data.Time (fromGregorian)
import System.Console.CmdArgs.Explicit import System.Console.CmdArgs.Explicit
import Hledger.Read.CsvReader (CSV, CsvRecord, printCSV) import Hledger.Read.CsvReader (CSV, CsvRecord, printCSV)
@ -200,7 +201,7 @@ tests_Register = tests "Register" [
test "unicode in register layout" $ do test "unicode in register layout" $ do
j <- readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n" j <- readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n"
let opts = defreportopts let opts = defreportopts
(postingsReportAsText defcliopts $ postingsReport opts (queryFromOpts (parsedate "2008/11/26") opts) j) (postingsReportAsText defcliopts $ postingsReport opts (queryFromOpts (fromGregorian 2008 11 26) opts) j)
@?= @?=
unlines unlines
["2009-01-01 медвежья шкура расходы:покупки 100 100" ["2009-01-01 медвежья шкура расходы:покупки 100 100"

2
hledger/Hledger/Cli/Utils.hs
View File

@ -303,7 +303,7 @@ tests_Cli_Utils = tests "Utils" [
-- -- all prices for consistent timing. -- -- all prices for consistent timing.
-- let ropts = defreportopts{ -- let ropts = defreportopts{
-- value_=True, -- value_=True,
-- period_=PeriodTo $ parsedate "3000-01-01" -- period_=PeriodTo $ fromGregorian 3000 01 01
-- } -- }
-- j' <- journalApplyValue ropts j -- j' <- journalApplyValue ropts j
-- sum (journalAmounts j') `seq` return () -- sum (journalAmounts j') `seq` return ()