From 371b349b2e531af7eb47ad2307f7e8e1d9cd9e2b Mon Sep 17 00:00:00 2001 From: Stephen Morgan Date: Wed, 26 Aug 2020 18:11:20 +1000 Subject: [PATCH] lib,cli: Replace parsedate and mkdatespan with direct applications of fromGregorian, transaction now takes Day instead of a date string. --- hledger-lib/Hledger/Data/Dates.hs | 68 +++++++------------ hledger-lib/Hledger/Data/Journal.hs | 36 +++++----- .../Hledger/Data/PeriodicTransaction.hs | 17 ++--- hledger-lib/Hledger/Data/Transaction.hs | 42 ++++++------ hledger-lib/Hledger/Data/Valuation.hs | 24 +++---- hledger-lib/Hledger/Query.hs | 10 +-- hledger-lib/Hledger/Read.hs | 6 +- hledger-lib/Hledger/Read/CsvReader.hs | 6 +- hledger-lib/Hledger/Reports/BalanceReport.hs | 4 +- hledger-lib/Hledger/Reports/EntriesReport.hs | 9 +-- hledger-lib/Hledger/Reports/PostingsReport.hs | 18 ++--- hledger-lib/Hledger/Reports/ReportOptions.hs | 8 +-- hledger/Hledger/Cli/Commands.hs | 14 ++-- hledger/Hledger/Cli/Commands/Balance.hs | 3 +- hledger/Hledger/Cli/Commands/Register.hs | 3 +- hledger/Hledger/Cli/Utils.hs | 2 +- 16 files changed, 128 insertions(+), 142 deletions(-) diff --git a/hledger-lib/Hledger/Data/Dates.hs b/hledger-lib/Hledger/Data/Dates.hs index a60d11aa4..469e1bd7f 100644 --- a/hledger-lib/Hledger/Data/Dates.hs +++ b/hledger-lib/Hledger/Data/Dates.hs @@ -37,7 +37,6 @@ module Hledger.Data.Dates ( spanContainsDate, periodContainsDate, parsedateM, - parsedate, showDate, showDateSpan, showDateSpanMonthAbbrev, @@ -73,7 +72,6 @@ module Hledger.Data.Dates ( yearp, daysInSpan, maybePeriod, - mkdatespan, ) where @@ -172,34 +170,34 @@ spansSpan spans = DateSpan (maybe Nothing spanStart $ headMay spans) (maybe Noth -- -- -- ==== Examples: --- >>> let t i d1 d2 = splitSpan i $ mkdatespan d1 d2 --- >>> t NoInterval "2008/01/01" "2009/01/01" +-- >>> 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 -- [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] -- >>> splitSpan (Quarters 1) nulldatespan -- [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] --- >>> 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] --- >>> 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] --- >>> 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] --- >>> 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] --- >>> 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] --- >>> 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] --- >>> 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] --- >>> 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] -- splitSpan :: Interval -> DateSpan -> [DateSpan] @@ -267,7 +265,7 @@ spansIntersect (d:ds) = d `spanIntersect` (spansIntersect ds) -- | Calculate the intersection of two datespans. -- -- For non-intersecting spans, gives an empty span beginning on the second's start date: --- >>> 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 spanIntersect (DateSpan b1 e1) (DateSpan b2 e2) = DateSpan b e where @@ -409,7 +407,7 @@ fixSmartDateStrEither' d s = case parsewith smartdateonly (T.toLower s) of -- -- ==== Examples: -- >>> :set -XOverloadedStrings --- >>> let t = fixSmartDateStr (parsedate "2008/11/26") +-- >>> let t = fixSmartDateStr (fromGregorian 2008 11 26) -- >>> t "0000-01-01" -- "0000-01-01" -- >>> 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 -- starts before Nov 22 will start in 2017. However -- 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 -- 2017-11-21 -- >>> nthdayofyearcontaining 11 22 wed22nd @@ -573,7 +571,7 @@ nthdayofyearcontaining m md date -- Examples: lets take 2017-11-22. Month-long intervals covering it that -- start on 1st-22nd of month will start in Nov. However -- 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 -- 2017-11-01 -- >>> nthdayofmonthcontaining 12 wed22nd @@ -600,7 +598,7 @@ nthdayofmonthcontaining md date -- 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 -- 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 -- 2017-11-20 -- >>> 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 -- start on 1st-4th Wed will start in Nov. However -- 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 -- 2017-11-01 -- >>> nthweekdayofmonthcontaining 3 2 wed22nd @@ -679,17 +677,6 @@ parsedateM s = asum [ 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. 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 -- parsing the reporting interval). -- --- >>> let p = parsePeriodExpr (parsedate "2008-11-26") +-- >>> let p = parsePeriodExpr (fromGregorian 2008 11 26) -- >>> p "from Aug to Oct" -- Right (NoInterval,DateSpan 2008-08-01..2008-09-30) -- >>> 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 doubledatespanp :: Day -> TextParser m DateSpan doubledatespanp rdate = liftA2 fromToSpan @@ -965,11 +952,11 @@ doubledatespanp rdate = liftA2 fromToSpan 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 --- >>> parsewith (quarterdatespanp (parsedate "2018/01/01") <* eof) "Q1" +-- >>> parsewith (quarterdatespanp (fromGregorian 2018 01 01) <* eof) "Q1" -- Right DateSpan 2018Q1 --- >>> parsewith (quarterdatespanp (parsedate "2018/01/01") <* eof) "2020q4" +-- >>> parsewith (quarterdatespanp (fromGregorian 2018 01 01) <* eof) "2020q4" -- Right DateSpan 2020Q4 quarterdatespanp :: Day -> TextParser m DateSpan quarterdatespanp rdate = do @@ -998,11 +985,6 @@ justdatespanp rdate = optional (string' "in" *> skipNonNewlineSpaces) *> (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 Nothing Nothing diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index ac46f682a..f643a95fb 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -1295,7 +1295,7 @@ Right samplejournal = journalBalanceTransactions False $ txnTieKnot $ Transaction { tindex=0, tsourcepos=nullsourcepos, - tdate=parsedate "2008/01/01", + tdate=fromGregorian 2008 01 01, tdate2=Nothing, tstatus=Unmarked, tcode="", @@ -1312,7 +1312,7 @@ Right samplejournal = journalBalanceTransactions False $ txnTieKnot $ Transaction { tindex=0, tsourcepos=nullsourcepos, - tdate=parsedate "2008/06/01", + tdate=fromGregorian 2008 06 01, tdate2=Nothing, tstatus=Unmarked, tcode="", @@ -1329,7 +1329,7 @@ Right samplejournal = journalBalanceTransactions False $ txnTieKnot $ Transaction { tindex=0, tsourcepos=nullsourcepos, - tdate=parsedate "2008/06/02", + tdate=fromGregorian 2008 06 02, tdate2=Nothing, tstatus=Unmarked, tcode="", @@ -1346,7 +1346,7 @@ Right samplejournal = journalBalanceTransactions False $ txnTieKnot $ Transaction { tindex=0, tsourcepos=nullsourcepos, - tdate=parsedate "2008/06/03", + tdate=fromGregorian 2008 06 03, tdate2=Nothing, tstatus=Cleared, tcode="", @@ -1363,7 +1363,7 @@ Right samplejournal = journalBalanceTransactions False $ txnTieKnot $ Transaction { tindex=0, tsourcepos=nullsourcepos, - tdate=parsedate "2008/10/01", + tdate=fromGregorian 2008 10 01, tdate2=Nothing, tstatus=Unmarked, tcode="", @@ -1379,7 +1379,7 @@ Right samplejournal = journalBalanceTransactions False $ txnTieKnot $ Transaction { tindex=0, tsourcepos=nullsourcepos, - tdate=parsedate "2008/12/31", + tdate=fromGregorian 2008 12 31, tdate2=Nothing, tstatus=Unmarked, tcode="", @@ -1398,11 +1398,11 @@ tests_Journal = tests "Journal" [ test "journalDateSpan" $ journalDateSpan True nulljournal{ - jtxns = [nulltransaction{tdate = parsedate "2014/02/01" - ,tpostings = [posting{pdate=Just (parsedate "2014/01/10")}] + jtxns = [nulltransaction{tdate = fromGregorian 2014 02 01 + ,tpostings = [posting{pdate=Just (fromGregorian 2014 01 10)}] } - ,nulltransaction{tdate = parsedate "2014/09/01" - ,tpostings = [posting{pdate2=Just (parsedate "2014/10/10")}] + ,nulltransaction{tdate = fromGregorian 2014 09 01 + ,tpostings = [posting{pdate2=Just (fromGregorian 2014 10 10)}] } ] } @@ -1436,7 +1436,7 @@ tests_Journal = tests "Journal" [ --2019/01/01 -- (a) = 1 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 let Right j = ej @@ -1449,8 +1449,8 @@ tests_Journal = tests "Journal" [ --2019/01/01 -- (a) 1 = 2 nulljournal{ jtxns = [ - transaction "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" missingamt (balassert (num 1)) ] + ,transaction (fromGregorian 2019 01 01) [ vpost' "a" (num 1) (balassert (num 2)) ] ]} ,test "same-day-2" $ do @@ -1463,12 +1463,12 @@ tests_Journal = tests "Journal" [ --2019/01/01 -- a 0 = 1 nulljournal{ jtxns = [ - transaction "2019/01/01" [ vpost' "a" (num 2) (balassert (num 2)) ] - ,transaction "2019/01/01" [ + transaction (fromGregorian 2019 01 01) [ vpost' "a" (num 2) (balassert (num 2)) ] + ,transaction (fromGregorian 2019 01 01) [ post' "b" (num 1) 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 @@ -1478,8 +1478,8 @@ tests_Journal = tests "Journal" [ --2019/1/1 -- (a) 1 = 1 nulljournal{ jtxns = [ - transaction "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 02) [ vpost' "a" (num 1) (balassert (num 2)) ] + ,transaction (fromGregorian 2019 01 01) [ vpost' "a" (num 1) (balassert (num 1)) ] ]} ] diff --git a/hledger-lib/Hledger/Data/PeriodicTransaction.hs b/hledger-lib/Hledger/Data/PeriodicTransaction.hs index 35d4ead39..57487be00 100644 --- a/hledger-lib/Hledger/Data/PeriodicTransaction.hs +++ b/hledger-lib/Hledger/Data/PeriodicTransaction.hs @@ -13,7 +13,7 @@ module Hledger.Data.PeriodicTransaction ( where #if !(MIN_VERSION_base(4,11,0)) -import Data.Monoid ((<>)) +import Data.Semigroup ((<>)) #endif import qualified Data.Text as T import Text.Printf @@ -85,6 +85,7 @@ instance Show PeriodicTransaction where -- - a generated-transaction: tag -- - a hidden _generated-transaction: tag which does not appear in the comment. -- +-- >>> import Data.Time (fromGregorian) -- >>> _ptgen "monthly from 2017/1 to 2017/4" -- 2017-01-01 -- ; generated-transaction: ~ monthly from 2017/1 to 2017/4 @@ -207,17 +208,17 @@ instance Show PeriodicTransaction where -- >>> _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 -- --- >>> 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" (mkdatespan "2020-02-01" "2020-03-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" (DateSpan (Just $ fromGregorian 2020 02 01) (Just $ fromGregorian 2020 03 01)) -- 2020-02-01 -- ; generated-transaction: ~ every 3 months from 2019-05 -- a $1.00 -- --- >>> _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 -- ; generated-transaction: ~ every 3 days from 2018 -- a $1.00 @@ -226,7 +227,7 @@ instance Show PeriodicTransaction where -- ; generated-transaction: ~ every 3 days from 2018 -- a $1.00 -- --- >>> _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 -- ; generated-transaction: ~ every 3 days from 2018 -- 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, -- to avoid generating (infinitely) many events. alltxnspans = dbg3 "alltxnspans" $ ptinterval `splitSpan` (spanDefaultsFrom ptspan requestedspan) - + -- | Check that this date span begins at a boundary of this interval, -- or return an explanatory error message including the provided period expression -- (from which the span and interval are derived). diff --git a/hledger-lib/Hledger/Data/Transaction.hs b/hledger-lib/Hledger/Data/Transaction.hs index 5ca0b0cd3..6720187bf 100644 --- a/hledger-lib/Hledger/Data/Transaction.hs +++ b/hledger-lib/Hledger/Data/Transaction.hs @@ -105,8 +105,8 @@ nulltransaction = Transaction { } -- | Make a simple transaction with the given date and postings. -transaction :: String -> [Posting] -> Transaction -transaction datestr ps = txnTieKnot $ nulltransaction{tdate=parsedate datestr, tpostings=ps} +transaction :: Day -> [Posting] -> Transaction +transaction day ps = txnTieKnot $ nulltransaction{tdate=day, tpostings=ps} transactionPayee :: Transaction -> Text transactionPayee = fst . payeeAndNoteFromDescription . tdescription @@ -669,8 +669,8 @@ tests_Transaction = test "null transaction" $ showTransaction nulltransaction @?= "0000-01-01\n\n" , test "non-null transaction" $ showTransaction nulltransaction - { tdate = parsedate "2012/05/14" - , tdate2 = Just $ parsedate "2012/05/15" + { tdate = fromGregorian 2012 05 14 + , tdate2 = Just $ fromGregorian 2012 05 15 , tstatus = Unmarked , tcode = "code" , tdescription = "desc" @@ -702,7 +702,7 @@ tests_Transaction = 0 "" nullsourcepos - (parsedate "2007/01/28") + (fromGregorian 2007 01 28) Nothing Unmarked "" @@ -726,7 +726,7 @@ tests_Transaction = 0 "" nullsourcepos - (parsedate "2007/01/28") + (fromGregorian 2007 01 28) Nothing Unmarked "" @@ -749,7 +749,7 @@ tests_Transaction = 0 "" nullsourcepos - (parsedate "2007/01/28") + (fromGregorian 2007 01 28) Nothing Unmarked "" @@ -765,7 +765,7 @@ tests_Transaction = 0 "" nullsourcepos - (parsedate "2010/01/01") + (fromGregorian 2010 01 01) Nothing Unmarked "" @@ -786,7 +786,7 @@ tests_Transaction = 0 "" nullsourcepos - (parsedate "2007/01/28") + (fromGregorian 2007 01 28) Nothing Unmarked "" @@ -802,7 +802,7 @@ tests_Transaction = 0 "" nullsourcepos - (parsedate "2007/01/28") + (fromGregorian 2007 01 28) Nothing Unmarked "" @@ -820,7 +820,7 @@ tests_Transaction = 0 "" nullsourcepos - (parsedate "2007/01/28") + (fromGregorian 2007 01 28) Nothing Unmarked "" @@ -837,7 +837,7 @@ tests_Transaction = 0 "" nullsourcepos - (parsedate "2007/01/28") + (fromGregorian 2007 01 28) Nothing Unmarked "" @@ -856,7 +856,7 @@ tests_Transaction = 0 "" nullsourcepos - (parsedate "2011/01/01") + (fromGregorian 2011 01 01) Nothing Unmarked "" @@ -874,7 +874,7 @@ tests_Transaction = 0 "" nullsourcepos - (parsedate "2011/01/01") + (fromGregorian 2011 01 01) Nothing Unmarked "" @@ -893,7 +893,7 @@ tests_Transaction = 0 "" nullsourcepos - (parsedate "2009/01/01") + (fromGregorian 2009 01 01) Nothing Unmarked "" @@ -911,7 +911,7 @@ tests_Transaction = 0 "" nullsourcepos - (parsedate "2009/01/01") + (fromGregorian 2009 01 01) Nothing Unmarked "" @@ -929,7 +929,7 @@ tests_Transaction = 0 "" nullsourcepos - (parsedate "2009/01/01") + (fromGregorian 2009 01 01) Nothing Unmarked "" @@ -944,7 +944,7 @@ tests_Transaction = 0 "" nullsourcepos - (parsedate "2009/01/01") + (fromGregorian 2009 01 01) Nothing Unmarked "" @@ -959,7 +959,7 @@ tests_Transaction = 0 "" nullsourcepos - (parsedate "2009/01/01") + (fromGregorian 2009 01 01) Nothing Unmarked "" @@ -978,7 +978,7 @@ tests_Transaction = 0 "" nullsourcepos - (parsedate "2009/01/01") + (fromGregorian 2009 01 01) Nothing Unmarked "" @@ -996,7 +996,7 @@ tests_Transaction = 0 "" nullsourcepos - (parsedate "2009/01/01") + (fromGregorian 2009 01 01) Nothing Unmarked "" diff --git a/hledger-lib/Hledger/Data/Valuation.hs b/hledger-lib/Hledger/Data/Valuation.hs index a6ba473b5..03fafd24e 100644 --- a/hledger-lib/Hledger/Data/Valuation.hs +++ b/hledger-lib/Hledger/Data/Valuation.hs @@ -38,7 +38,7 @@ import Data.List.Extra (nubSortBy) import qualified Data.Map as M import Data.Maybe import qualified Data.Text as T -import Data.Time.Calendar (Day) +import Data.Time.Calendar (Day, fromGregorian) import Data.MemoUgly (memo) import GHC.Generics (Generic) import Safe (headMay) @@ -46,7 +46,6 @@ import Safe (headMay) import Hledger.Utils import Hledger.Data.Types import Hledger.Data.Amount -import Hledger.Data.Dates (parsedate) ------------------------------------------------------------------------------ @@ -268,21 +267,20 @@ priceLookup makepricegraph d from mto = tests_priceLookup = let - d = parsedate - p date from q to = MarketPrice{mpdate=d date, mpfrom=from, mpto=to, mprate=q} + p y m d from q to = MarketPrice{mpdate=fromGregorian y m d, mpfrom=from, mpto=to, mprate=q} ps1 = [ - p "2000/01/01" "A" 10 "B" - ,p "2000/01/01" "B" 10 "C" - ,p "2000/01/01" "C" 10 "D" - ,p "2000/01/01" "E" 2 "D" - ,p "2001/01/01" "A" 11 "B" + p 2000 01 01 "A" 10 "B" + ,p 2000 01 01 "B" 10 "C" + ,p 2000 01 01 "C" 10 "D" + ,p 2000 01 01 "E" 2 "D" + ,p 2001 01 01 "A" 11 "B" ] makepricegraph = makePriceGraph ps1 [] in test "priceLookup" $ do - priceLookup makepricegraph (d "1999/01/01") "A" Nothing @?= Nothing - priceLookup makepricegraph (d "2000/01/01") "A" Nothing @?= Just ("B",10) - priceLookup makepricegraph (d "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 1999 01 01) "A" Nothing @?= Nothing + priceLookup makepricegraph (fromGregorian 2000 01 01) "A" Nothing @?= Just ("B",10) + priceLookup makepricegraph (fromGregorian 2000 01 01) "B" (Just "A") @?= Just ("A",0.1) + priceLookup makepricegraph (fromGregorian 2000 01 01) "A" (Just "E") @?= Just ("E",500) -- | Build the graph of commodity conversion prices for a given day. -- Converts a list of declared market prices in parse order, and a diff --git a/hledger-lib/Hledger/Query.hs b/hledger-lib/Hledger/Query.hs index fe89a0692..3948ba9b5 100644 --- a/hledger-lib/Hledger/Query.hs +++ b/hledger-lib/Hledger/Query.hs @@ -791,8 +791,8 @@ tests_Query = tests "Query" [ (simplifyQuery $ And [Any,Any]) @?= (Any) (simplifyQuery $ And [Acct "b",Any]) @?= (Acct "b") (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)]) - @?= (Date (DateSpan (Just $ parsedate "2012-01-01") (Just $ parsedate "2013-01-01"))) + (simplifyQuery $ And [Date (DateSpan Nothing (Just $ fromGregorian 2013 01 01)), Date (DateSpan (Just $ fromGregorian 2012 01 01) Nothing)]) + @?= (Date (DateSpan (Just $ fromGregorian 2012 01 01) (Just $ fromGregorian 2013 01 01))) (simplifyQuery $ And [Or [],Or [Desc "b b"]]) @?= (Desc "b b") ,test "parseQuery" $ do @@ -831,9 +831,9 @@ tests_Query = tests "Query" [ parseQueryTerm nulldate "payee:x" @?= Right (Left $ Tag "payee" (Just "x")) parseQueryTerm nulldate "note:x" @?= Right (Left $ Tag "note" (Just "x")) 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:from 2012/5/17" @?= Right (Left $ Date $ DateSpan (Just $ parsedate "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:2008" @?= Right (Left $ Date $ DateSpan (Just $ fromGregorian 2008 01 01) (Just $ fromGregorian 2009 01 01)) + parseQueryTerm nulldate "date:from 2012/5/17" @?= Right (Left $ Date $ DateSpan (Just $ fromGregorian 2012 05 17) Nothing) + parseQueryTerm nulldate "date:20180101-201804" @?= Right (Left $ Date $ DateSpan (Just $ fromGregorian 2018 01 01) (Just $ fromGregorian 2018 04 01)) parseQueryTerm nulldate "inacct:a" @?= Right (Right $ QueryOptInAcct "a") parseQueryTerm nulldate "tag:a" @?= Right (Left $ Tag "a" Nothing) parseQueryTerm nulldate "tag:a=some value" @?= Right (Left $ Tag "a" (Just "some value")) diff --git a/hledger-lib/Hledger/Read.hs b/hledger-lib/Hledger/Read.hs index 805551306..84a3a270d 100644 --- a/hledger-lib/Hledger/Read.hs +++ b/hledger-lib/Hledger/Read.hs @@ -67,7 +67,7 @@ import System.Info (os) import System.IO (stderr, writeFile) 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.Read.Common import Hledger.Read.JournalReader as JournalReader @@ -251,9 +251,11 @@ saveLatestDates dates f = writeFile (latestDatesFileFor f) $ unlines $ map showD previousLatestDates :: FilePath -> IO LatestDates previousLatestDates f = do let latestfile = latestDatesFileFor f + parsedate s = maybe (fail $ "could not parse date \"" ++ s ++ "\"") return $ + parsedateM s exists <- doesFileExist latestfile 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 [] -- | Where to save latest transaction dates for the given file path. diff --git a/hledger-lib/Hledger/Read/CsvReader.hs b/hledger-lib/Hledger/Read/CsvReader.hs index 4c8f91d02..298a315ce 100644 --- a/hledger-lib/Hledger/Read/CsvReader.hs +++ b/hledger-lib/Hledger/Read/CsvReader.hs @@ -887,7 +887,7 @@ transactionFromCsvRecord sourcepos rules record = t -- ruleval = csvRuleValue rules record :: DirectiveName -> Maybe String field = hledgerField rules record :: HledgerFieldName -> Maybe FieldTemplate fieldval = hledgerFieldValue rules record :: HledgerFieldName -> Maybe String - parsedate' = parseDateWithCustomOrDefaultFormats (rule "date-format") + parsedate = parseDateWithCustomOrDefaultFormats (rule "date-format") mkdateerror datefield datevalue mdateformat = unlines ["error: could not parse \""++datevalue++"\" as a date using date format " ++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" date = fromMaybe "" $ fieldval "date" -- PARTIAL: - date' = fromMaybe (error' $ mkdateerror "date" date mdateformat) $ parsedate' date + date' = fromMaybe (error' $ mkdateerror "date" date mdateformat) $ parsedate date 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 = case fieldval "status" of Nothing -> Unmarked diff --git a/hledger-lib/Hledger/Reports/BalanceReport.hs b/hledger-lib/Hledger/Reports/BalanceReport.hs index 2ec748451..af56c5824 100644 --- a/hledger-lib/Hledger/Reports/BalanceReport.hs +++ b/hledger-lib/Hledger/Reports/BalanceReport.hs @@ -82,8 +82,8 @@ Right samplejournal2 = txnTieKnot Transaction{ tindex=0, tsourcepos=nullsourcepos, - tdate=parsedate "2008/01/01", - tdate2=Just $ parsedate "2009/01/01", + tdate=fromGregorian 2008 01 01, + tdate2=Just $ fromGregorian 2009 01 01, tstatus=Unmarked, tcode="", tdescription="income", diff --git a/hledger-lib/Hledger/Reports/EntriesReport.hs b/hledger-lib/Hledger/Reports/EntriesReport.hs index bb5f60f5f..b1249c1da 100644 --- a/hledger-lib/Hledger/Reports/EntriesReport.hs +++ b/hledger-lib/Hledger/Reports/EntriesReport.hs @@ -14,9 +14,10 @@ module Hledger.Reports.EntriesReport ( ) where -import Data.List -import Data.Maybe -import Data.Ord +import Data.List (sortBy) +import Data.Maybe (fromMaybe) +import Data.Ord (comparing) +import Data.Time (fromGregorian) import Hledger.Data import Hledger.Query @@ -50,7 +51,7 @@ entriesReport ropts@ReportOpts{..} q j@Journal{..} = tests_EntriesReport = tests "EntriesReport" [ tests "entriesReport" [ 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 ] ] diff --git a/hledger-lib/Hledger/Reports/PostingsReport.hs b/hledger-lib/Hledger/Reports/PostingsReport.hs index 3024b9877..862d91951 100644 --- a/hledger-lib/Hledger/Reports/PostingsReport.hs +++ b/hledger-lib/Hledger/Reports/PostingsReport.hs @@ -286,7 +286,7 @@ tests_PostingsReport = tests "PostingsReport" [ (length $ snd $ postingsReport defreportopts (Acct "assets:bank:checking") samplejournal) @?= 5 -- (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) -- ,(Just (2008-06-01,"gift"),assets:bank:checking $1,$1) -- ,(Nothing,income:gifts $-1,0) @@ -437,7 +437,7 @@ tests_PostingsReport = tests "PostingsReport" [ -- ,tests_summarisePostingsInDateSpan = [ -- "summarisePostingsInDateSpan" ~: do -- 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 = -- [ -- 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` -- [ - -- 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` -- [ - -- nullposting{lpdate=parsedate "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=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", lpamount=Mixed [usd 4]} + -- ,nullposting{lpdate=fromGregorian 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:groceries",lpamount=Mixed [usd 1]} -- ] -- ("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` -- [ - -- 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` -- [ - -- 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]} -- ] ] diff --git a/hledger-lib/Hledger/Reports/ReportOptions.hs b/hledger-lib/Hledger/Reports/ReportOptions.hs index 2ac7c611f..c6dea8783 100644 --- a/hledger-lib/Hledger/Reports/ReportOptions.hs +++ b/hledger-lib/Hledger/Reports/ReportOptions.hs @@ -575,15 +575,15 @@ tests_ReportOptions = tests "ReportOptions" [ queryFromOpts nulldate defreportopts @?= Any queryFromOpts nulldate defreportopts{query_="a"} @?= Acct "a" queryFromOpts nulldate defreportopts{query_="desc:'a a'"} @?= Desc "a a" - queryFromOpts nulldate defreportopts{period_=PeriodFrom (parsedate "2012/01/01"),query_="date:'to 2013'" } - @?= (Date $ mkdatespan "2012/01/01" "2013/01/01") - queryFromOpts nulldate defreportopts{query_="date2:'in 2012'"} @?= (Date2 $ mkdatespan "2012/01/01" "2013/01/01") + queryFromOpts nulldate defreportopts{period_=PeriodFrom (fromGregorian 2012 01 01),query_="date:'to 2013'" } + @?= (Date $ DateSpan (Just $ fromGregorian 2012 01 01) (Just $ fromGregorian 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"] ,test "queryOptsFromOpts" $ do queryOptsFromOpts nulldate defreportopts @?= [] 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'"} @?= [] ] diff --git a/hledger/Hledger/Cli/Commands.hs b/hledger/Hledger/Cli/Commands.hs index e3ba51d8d..17d5bf55f 100644 --- a/hledger/Hledger/Cli/Commands.hs +++ b/hledger/Hledger/Cli/Commands.hs @@ -363,7 +363,7 @@ tests_Commands = tests "Commands" [ -- test data --- date1 = parsedate "2008/11/26" +-- date1 = fromGregorian 2008 11 26 -- t1 = LocalTime date1 midday {- @@ -569,7 +569,7 @@ journal7 = nulljournal {jtxns = txnTieKnot Transaction { tindex=0, tsourcepos=nullsourcepos, - tdate=parsedate "2007/01/01", + tdate=fromGregorian 2007 01 01, tdate2=Nothing, tstatus=Unmarked, tcode="*", @@ -586,7 +586,7 @@ journal7 = nulljournal {jtxns = txnTieKnot Transaction { tindex=0, tsourcepos=nullsourcepos, - tdate=parsedate "2007/02/01", + tdate=fromGregorian 2007 02 01, tdate2=Nothing, tstatus=Unmarked, tcode="*", @@ -603,7 +603,7 @@ journal7 = nulljournal {jtxns = txnTieKnot Transaction { tindex=0, tsourcepos=nullsourcepos, - tdate=parsedate "2007/01/02", + tdate=fromGregorian 2007 01 02, tdate2=Nothing, tstatus=Unmarked, tcode="*", @@ -620,7 +620,7 @@ journal7 = nulljournal {jtxns = txnTieKnot Transaction { tindex=0, tsourcepos=nullsourcepos, - tdate=parsedate "2007/01/03", + tdate=fromGregorian 2007 01 03, tdate2=Nothing, tstatus=Unmarked, tcode="*", @@ -637,7 +637,7 @@ journal7 = nulljournal {jtxns = txnTieKnot Transaction { tindex=0, tsourcepos=nullsourcepos, - tdate=parsedate "2007/01/03", + tdate=fromGregorian 2007 01 03, tdate2=Nothing, tstatus=Unmarked, tcode="*", @@ -654,7 +654,7 @@ journal7 = nulljournal {jtxns = txnTieKnot Transaction { tindex=0, tsourcepos=nullsourcepos, - tdate=parsedate "2007/01/03", + tdate=fromGregorian 2007 01 03, tdate2=Nothing, tstatus=Unmarked, tcode="*", diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs index 843197185..1dc71e2ea 100644 --- a/hledger/Hledger/Cli/Commands/Balance.hs +++ b/hledger/Hledger/Cli/Commands/Balance.hs @@ -258,6 +258,7 @@ import Data.Maybe --import qualified Data.Map as Map import qualified Data.Text as T import qualified Data.Text.Lazy as TL +import Data.Time (fromGregorian) import System.Console.CmdArgs.Explicit as C import Lucid as L import Text.Printf (printf) @@ -639,7 +640,7 @@ tests_Balance = tests "Balance" [ test "unicode in balance layout" $ do j <- readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n" 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 [" -100 актив:наличные" diff --git a/hledger/Hledger/Cli/Commands/Register.hs b/hledger/Hledger/Cli/Commands/Register.hs index eed3be41d..5d9a31e6a 100644 --- a/hledger/Hledger/Cli/Commands/Register.hs +++ b/hledger/Hledger/Cli/Commands/Register.hs @@ -23,6 +23,7 @@ import Data.Maybe -- import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Lazy as TL +import Data.Time (fromGregorian) import System.Console.CmdArgs.Explicit import Hledger.Read.CsvReader (CSV, CsvRecord, printCSV) @@ -200,7 +201,7 @@ tests_Register = tests "Register" [ test "unicode in register layout" $ do j <- readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n" 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 ["2009-01-01 медвежья шкура расходы:покупки 100 100" diff --git a/hledger/Hledger/Cli/Utils.hs b/hledger/Hledger/Cli/Utils.hs index 8261cba2e..3373ed571 100644 --- a/hledger/Hledger/Cli/Utils.hs +++ b/hledger/Hledger/Cli/Utils.hs @@ -303,7 +303,7 @@ tests_Cli_Utils = tests "Utils" [ -- -- all prices for consistent timing. -- let ropts = defreportopts{ -- value_=True, - -- period_=PeriodTo $ parsedate "3000-01-01" + -- period_=PeriodTo $ fromGregorian 3000 01 01 -- } -- j' <- journalApplyValue ropts j -- sum (journalAmounts j') `seq` return ()