diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index 716cf79ff..990dd0230 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -1324,16 +1324,16 @@ tests_Journal = tests "Journal" [ ,tests "journalBalanceTransactions" [ - test "balance-assignment" $ do + test "balance-assignment" $ testCaseSteps "sometests" $ \_step -> do let ej = journalBalanceTransactions True $ --2019/01/01 -- (a) = 1 nulljournal{ jtxns = [ transaction "2019/01/01" [ vpost' "a" missingamt (balassert (num 1)) ] ]} - expectRight ej + assertRight ej let Right j = ej - (jtxns j & head & tpostings & head & pamount) `is` Mixed [num 1] + (jtxns j & head & tpostings & head & pamount) @?= Mixed [num 1] ,test "same-day-1" $ do expectRight $ journalBalanceTransactions True $ diff --git a/hledger-lib/Hledger/Data/StringFormat.hs b/hledger-lib/Hledger/Data/StringFormat.hs index 86aa80994..094c08d7c 100644 --- a/hledger-lib/Hledger/Data/StringFormat.hs +++ b/hledger-lib/Hledger/Data/StringFormat.hs @@ -18,7 +18,7 @@ import "base-compat-batteries" Prelude.Compat import Numeric import Data.Char (isPrint) import Data.Maybe -import qualified Data.Text as T +-- import qualified Data.Text as T import Text.Megaparsec import Text.Megaparsec.Char @@ -157,7 +157,7 @@ tests_StringFormat = tests "StringFormat" [ ] ,tests "parseStringFormat" $ - let s `gives` expected = test (T.pack s) $ parseStringFormat s `is` Right expected + let s `gives` expected = test s $ parseStringFormat s `is` Right expected in [ "" `gives` (defaultStringFormatStyle []) , "D" `gives` (defaultStringFormatStyle [FormatLiteral "D"]) diff --git a/hledger-lib/Hledger/Data/Timeclock.hs b/hledger-lib/Hledger/Data/Timeclock.hs index 9f7e6258c..30db87c87 100644 --- a/hledger-lib/Hledger/Data/Timeclock.hs +++ b/hledger-lib/Hledger/Data/Timeclock.hs @@ -115,32 +115,31 @@ entryFromTimeclockInOut i o -- tests tests_Timeclock = tests "Timeclock" [ - do - today <- io getCurrentDay - now' <- io getCurrentTime - tz <- io getCurrentTimeZone - let now = utcToLocalTime tz now' - nowstr = showtime now - yesterday = prevday today - clockin = TimeclockEntry nullsourcepos In - mktime d = LocalTime d . fromMaybe midnight . + testCaseSteps "timeclockEntriesToTransactions tests" $ \step -> do + step "gathering data" + today <- getCurrentDay + now' <- getCurrentTime + tz <- getCurrentTimeZone + let now = utcToLocalTime tz now' + nowstr = showtime now + yesterday = prevday today + clockin = TimeclockEntry nullsourcepos In + mktime d = LocalTime d . fromMaybe midnight . #if MIN_VERSION_time(1,5,0) - parseTimeM True defaultTimeLocale "%H:%M:%S" + parseTimeM True defaultTimeLocale "%H:%M:%S" #else - parseTime defaultTimeLocale "%H:%M:%S" + parseTime defaultTimeLocale "%H:%M:%S" #endif - showtime = formatTime defaultTimeLocale "%H:%M" - txndescs = map (T.unpack . tdescription) . timeclockEntriesToTransactions now - future = utcToLocalTime tz $ addUTCTime 100 now' - futurestr = showtime future - tests "timeclockEntriesToTransactions" [ - test "started yesterday, split session at midnight" $ - txndescs [clockin (mktime yesterday "23:00:00") "" ""] `is` ["23:00-23:59","00:00-"++nowstr] - ,test "split multi-day sessions at each midnight" $ - txndescs [clockin (mktime (addDays (-2) today) "23:00:00") "" ""] `is `["23:00-23:59","00:00-23:59","00:00-"++nowstr] - ,test "auto-clock-out if needed" $ - txndescs [clockin (mktime today "00:00:00") "" ""] `is` ["00:00-"++nowstr] - ,test "use the clockin time for auto-clockout if it's in the future" $ - txndescs [clockin future "" ""] `is` [printf "%s-%s" futurestr futurestr] - ] + showtime = formatTime defaultTimeLocale "%H:%M" + txndescs = map (T.unpack . tdescription) . timeclockEntriesToTransactions now + future = utcToLocalTime tz $ addUTCTime 100 now' + futurestr = showtime future + step "started yesterday, split session at midnight" + txndescs [clockin (mktime yesterday "23:00:00") "" ""] @?= ["23:00-23:59","00:00-"++nowstr] + step "split multi-day sessions at each midnight" + txndescs [clockin (mktime (addDays (-2) today) "23:00:00") "" ""] @?= ["23:00-23:59","00:00-23:59","00:00-"++nowstr] + step "auto-clock-out if needed" + txndescs [clockin (mktime today "00:00:00") "" ""] @?= ["00:00-"++nowstr] + step "use the clockin time for auto-clockout if it's in the future" + txndescs [clockin future "" ""] @?= [printf "%s-%s" futurestr futurestr] ] diff --git a/hledger-lib/Hledger/Data/Transaction.hs b/hledger-lib/Hledger/Data/Transaction.hs index 5f9bc6ca9..f693add57 100644 --- a/hledger-lib/Hledger/Data/Transaction.hs +++ b/hledger-lib/Hledger/Data/Transaction.hs @@ -596,7 +596,7 @@ tests_Transaction = -- one missing amount, not the last one t3 = nulltransaction {tpostings = ["a" `post` usd 1, "b" `post` missingamt, "c" `post` usd (-1)]} -- unbalanced amounts when precision is limited (#931) - t4 = nulltransaction {tpostings = ["a" `post` usd (-0.01), "b" `post` usd (0.005), "c" `post` usd (0.005)]} + -- t4 = nulltransaction {tpostings = ["a" `post` usd (-0.01), "b" `post` usd (0.005), "c" `post` usd (0.005)]} in tests "postingsAsLines" [ test "null-transaction" $ @@ -635,10 +635,11 @@ tests_Transaction = let t = t3 in postingsAsLines False (tpostings t) `is` [" a $1.00", " b", " c $-1.00"] - , _test "ensure-visibly-balanced" $ - let t = t4 - in postingsAsLines False (tpostings t) `is` - [" a $-0.01", " b $0.005", " c $0.005"] + -- , _test "ensure-visibly-balanced" $ + -- let t = t4 + -- in postingsAsLines False (tpostings t) `is` + -- [" a $-0.01", " b $0.005", " c $0.005"] + ] , tests "inferBalancingAmount" diff --git a/hledger-lib/Hledger/Query.hs b/hledger-lib/Hledger/Query.hs index 1c236cc42..68841e17a 100644 --- a/hledger-lib/Hledger/Query.hs +++ b/hledger-lib/Hledger/Query.hs @@ -723,7 +723,7 @@ tests_Query = tests "Query" [ ,parseAmountQueryTerm "0.23" `is` (AbsEq,0.23) ,parseAmountQueryTerm "<=+0.23" `is` (LtEq,0.23) ,parseAmountQueryTerm "-0.23" `is` (Eq,(-0.23)) - ,_test "number beginning with decimal mark" $ parseAmountQueryTerm "=.23" `is` (AbsEq,0.23) -- XXX + -- ,_test "number beginning with decimal mark" $ parseAmountQueryTerm "=.23" `is` (AbsEq,0.23) -- XXX ] ,tests "matchesAccount" [ diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index 56fee87d2..ef522a62e 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -1363,7 +1363,7 @@ tests_Common = tests "Common" [ ,tests "spaceandamountormissingp" [ test "space and amount" $ expectParseEq spaceandamountormissingp " $47.18" (Mixed [usd 47.18]) ,test "empty string" $ expectParseEq spaceandamountormissingp "" missingmixedamt - ,_test "just space" $ expectParseEq spaceandamountormissingp " " missingmixedamt -- XXX should it ? + -- ,_test "just space" $ expectParseEq spaceandamountormissingp " " missingmixedamt -- XXX should it ? -- ,test "just amount" $ expectParseError spaceandamountormissingp "$47.18" "" -- succeeds, consuming nothing ] diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index 78c5ebf8e..48036d248 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/hledger-lib/Hledger/Read/JournalReader.hs @@ -63,8 +63,8 @@ module Hledger.Read.JournalReader ( ) where --- * imports -import qualified Prelude (fail) -import "base-compat-batteries" Prelude.Compat hiding (fail, readFile) +-- import qualified Prelude (fail) +-- import "base-compat-batteries" Prelude.Compat hiding (fail, readFile) import qualified "base-compat-batteries" Control.Monad.Fail.Compat as Fail (fail) import qualified Control.Exception as C import Control.Monad (forM_, when, void) @@ -668,41 +668,43 @@ tests_JournalReader = tests "JournalReader" [ let p = lift accountnamep :: JournalParser IO AccountName in tests "accountnamep" [ test "basic" $ expectParse p "a:b:c" - ,_test "empty inner component" $ expectParseError p "a::c" "" -- TODO - ,_test "empty leading component" $ expectParseError p ":b:c" "x" - ,_test "empty trailing component" $ expectParseError p "a:b:" "x" + -- ,_test "empty inner component" $ expectParseError p "a::c" "" -- TODO + -- ,_test "empty leading component" $ expectParseError p ":b:c" "x" + -- ,_test "empty trailing component" $ expectParseError p "a:b:" "x" ] -- "Parse a date in YYYY/MM/DD format. -- Hyphen (-) and period (.) are also allowed as separators. -- The year may be omitted if a default year has been set. -- Leading zeroes may be omitted." - ,test "datep" $ do - test "YYYY/MM/DD" $ expectParseEq datep "2018/01/01" (fromGregorian 2018 1 1) - test "YYYY-MM-DD" $ expectParse datep "2018-01-01" - test "YYYY.MM.DD" $ expectParse datep "2018.01.01" - test "yearless date with no default year" $ expectParseError datep "1/1" "current year is unknown" - test "yearless date with default year" $ do + ,tests "datep" [ + test "YYYY/MM/DD" $ expectParseEq datep "2018/01/01" (fromGregorian 2018 1 1) + ,test "YYYY-MM-DD" $ expectParse datep "2018-01-01" + ,test "YYYY.MM.DD" $ expectParse datep "2018.01.01" + ,test "yearless date with no default year" $ expectParseError datep "1/1" "current year is unknown" + ,testCaseSteps "yearless date with default year" $ \_step -> do let s = "1/1" ep <- parseWithState mempty{jparsedefaultyear=Just 2018} datep s - either (Prelude.fail . ("parse error at "++) . customErrorBundlePretty) (const ok) ep - test "no leading zero" $ expectParse datep "2018/1/1" - - ,test "datetimep" $ do - let - good = expectParse datetimep - bad = (\t -> expectParseError datetimep t "") - good "2011/1/1 00:00" - good "2011/1/1 23:59:59" - bad "2011/1/1" - bad "2011/1/1 24:00:00" - bad "2011/1/1 00:60:00" - bad "2011/1/1 00:00:60" - bad "2011/1/1 3:5:7" - test "timezone is parsed but ignored" $ do - let t = LocalTime (fromGregorian 2018 1 1) (TimeOfDay 0 0 (fromIntegral 0)) - expectParseEq datetimep "2018/1/1 00:00-0800" t - expectParseEq datetimep "2018/1/1 00:00+1234" t + either (assertFailure . ("parse error at "++) . customErrorBundlePretty) (const $ return ()) ep + ,test "no leading zero" $ expectParse datep "2018/1/1" + ] + ,let + good = expectParse datetimep + bad = (\t -> expectParseError datetimep t "") + in tests "datetimep" [ + good "2011/1/1 00:00" + ,good "2011/1/1 23:59:59" + ,bad "2011/1/1" + ,bad "2011/1/1 24:00:00" + ,bad "2011/1/1 00:60:00" + ,bad "2011/1/1 00:00:60" + ,bad "2011/1/1 3:5:7" + ,let t = LocalTime (fromGregorian 2018 1 1) (TimeOfDay 0 0 (fromIntegral 0)) + in tests "timezone is parsed but ignored" [ + expectParseEq datetimep "2018/1/1 00:00-0800" t + ,expectParseEq datetimep "2018/1/1 00:00+1234" t + ] + ] ,tests "periodictransactionp" [ @@ -883,41 +885,46 @@ tests_JournalReader = tests "JournalReader" [ -- directives ,tests "directivep" [ - test "supports !" $ do - expectParseE directivep "!account a\n" - expectParseE directivep "!D 1.0\n" + tests "supports !" [ + expectParseE directivep "!account a\n" + ,expectParseE directivep "!D 1.0\n" + ] ] - ,test "accountdirectivep" $ do - test "with-comment" $ expectParse accountdirectivep "account a:b ; a comment\n" - test "does-not-support-!" $ expectParseError accountdirectivep "!account a:b\n" "" - test "account-type-code" $ expectParse accountdirectivep "account a:b A\n" - test "account-type-tag" $ expectParseStateOn accountdirectivep "account a:b ; type:asset\n" - jdeclaredaccounts - [("a:b", AccountDeclarationInfo{adicomment = "type:asset\n" - ,aditags = [("type","asset")] - ,adideclarationorder = 1 - }) + ,tests "accountdirectivep" [ + test "with-comment" $ expectParse accountdirectivep "account a:b ; a comment\n" + ,test "does-not-support-!" $ expectParseError accountdirectivep "!account a:b\n" "" + ,test "account-type-code" $ expectParse accountdirectivep "account a:b A\n" + ,test "account-type-tag" $ expectParseStateOn accountdirectivep "account a:b ; type:asset\n" + jdeclaredaccounts + [("a:b", AccountDeclarationInfo{adicomment = "type:asset\n" + ,aditags = [("type","asset")] + ,adideclarationorder = 1 + }) + ] ] ,test "commodityconversiondirectivep" $ do expectParse commodityconversiondirectivep "C 1h = $50.00\n" - ,test "defaultcommoditydirectivep" $ do - expectParse defaultcommoditydirectivep "D $1,000.0\n" - expectParseError defaultcommoditydirectivep "D $1000\n" "please include a decimal separator" + ,tests "defaultcommoditydirectivep" [ + expectParse defaultcommoditydirectivep "D $1,000.0\n" + ,expectParseError defaultcommoditydirectivep "D $1000\n" "please include a decimal separator" + ] - ,test "defaultyeardirectivep" $ do - test "1000" $ expectParse defaultyeardirectivep "Y 1000" -- XXX no \n like the others - test "999" $ expectParseError defaultyeardirectivep "Y 999" "bad year number" - test "12345" $ expectParse defaultyeardirectivep "Y 12345" + ,tests "defaultyeardirectivep" [ + test "1000" $ expectParse defaultyeardirectivep "Y 1000" -- XXX no \n like the others + ,test "999" $ expectParseError defaultyeardirectivep "Y 999" "bad year number" + ,test "12345" $ expectParse defaultyeardirectivep "Y 12345" + ] ,test "ignoredpricecommoditydirectivep" $ do expectParse ignoredpricecommoditydirectivep "N $\n" - ,test "includedirectivep" $ do - test "include" $ expectParseErrorE includedirectivep "include nosuchfile\n" "No existing files match pattern: nosuchfile" - test "glob" $ expectParseErrorE includedirectivep "include nosuchfile*\n" "No existing files match pattern: nosuchfile*" + ,tests "includedirectivep" [ + test "include" $ expectParseErrorE includedirectivep "include nosuchfile\n" "No existing files match pattern: nosuchfile" + ,test "glob" $ expectParseErrorE includedirectivep "include nosuchfile*\n" "No existing files match pattern: nosuchfile*" + ] ,test "marketpricedirectivep" $ expectParseEq marketpricedirectivep "P 2017/01/30 BTC $922.83\n" @@ -930,10 +937,10 @@ tests_JournalReader = tests "JournalReader" [ ,test "tagdirectivep" $ do expectParse tagdirectivep "tag foo \n" - ,test "endtagdirectivep" $ do - expectParse endtagdirectivep "end tag \n" - expectParse endtagdirectivep "pop \n" - + ,tests "endtagdirectivep" [ + expectParse endtagdirectivep "end tag \n" + ,expectParse endtagdirectivep "pop \n" + ] ,tests "journalp" [ test "empty file" $ expectParseEqE journalp "" nulljournal @@ -941,10 +948,10 @@ tests_JournalReader = tests "JournalReader" [ -- these are defined here rather than in Common so they can use journalp ,tests "parseAndFinaliseJournal" [ - test "basic" $ do - ej <- io $ runExceptT $ parseAndFinaliseJournal journalp definputopts "" "2019-1-1\n" + testCaseSteps "basic" $ \_step -> do + ej <- runExceptT $ parseAndFinaliseJournal journalp definputopts "" "2019-1-1\n" let Right j = ej - expectEqPP [""] $ journalFilePaths j + assertEq [""] $ journalFilePaths j ] ] diff --git a/hledger-lib/Hledger/Reports/BalanceReport.hs b/hledger-lib/Hledger/Reports/BalanceReport.hs index 1afeefe7f..c297957e9 100644 --- a/hledger-lib/Hledger/Reports/BalanceReport.hs +++ b/hledger-lib/Hledger/Reports/BalanceReport.hs @@ -248,16 +248,15 @@ Right samplejournal2 = } tests_BalanceReport = tests "BalanceReport" [ - tests "balanceReport" $ - let - (opts,journal) `gives` r = do - let (eitems, etotal) = r - (aitems, atotal) = balanceReport opts (queryFromOpts nulldate opts) journal - showw (acct,acct',indent,amt) = (acct, acct', indent, showMixedAmountDebug amt) - (map showw eitems) `is` (map showw aitems) - (showMixedAmountDebug etotal) `is` (showMixedAmountDebug atotal) - usd0 = usd 0 - in [ + let + (opts,journal) `gives` r = testCaseSteps "sometest" $ \_step -> do + let (eitems, etotal) = r + (aitems, atotal) = balanceReport opts (queryFromOpts nulldate opts) journal + showw (acct,acct',indent,amt) = (acct, acct', indent, showMixedAmountDebug amt) + (map showw eitems) @?= (map showw aitems) + (showMixedAmountDebug etotal) @?= (showMixedAmountDebug atotal) + usd0 = usd 0 + in tests "balanceReport" [ test "balanceReport with no args on null journal" $ (defreportopts, nulljournal) `gives` ([], Mixed [nullamt]) diff --git a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs index f6dfb9438..5c1c09e43 100644 --- a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs +++ b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs @@ -417,13 +417,13 @@ tableAsText (ReportOpts{pretty_tables_ = pretty}) showcell = tests_MultiBalanceReport = tests "MultiBalanceReport" [ let - (opts,journal) `gives` r = do + (opts,journal) `gives` r = testCaseSteps "sometest" $ \_step -> do let (eitems, etotal) = r (MultiBalanceReport (_, aitems, atotal)) = multiBalanceReport opts (queryFromOpts nulldate opts) journal showw (acct,acct',indent,lAmt,amt,amt') = (acct, acct', indent, map showMixedAmountDebug lAmt, showMixedAmountDebug amt, showMixedAmountDebug amt') - (map showw aitems) `is` (map showw eitems) - ((\(_, b, _) -> showMixedAmountDebug b) atotal) `is` (showMixedAmountDebug etotal) -- we only check the sum of the totals - usd0 = usd 0 + (map showw aitems) @?= (map showw eitems) + ((\(_, b, _) -> showMixedAmountDebug b) atotal) @?= (showMixedAmountDebug etotal) -- we only check the sum of the totals + -- usd0 = usd 0 amount0 = Amount {acommodity="$", aquantity=0, aprice=Nothing, astyle=AmountStyle {ascommodityside = L, ascommodityspaced = False, asprecision = 2, asdecimalpoint = Just '.', asdigitgroups = Nothing}, aismultiplier=False} in tests "multiBalanceReport" [ @@ -439,27 +439,27 @@ tests_MultiBalanceReport = tests "MultiBalanceReport" [ ], Mixed [nullamt]) - ,_test "a valid history on an empty period" $ - (defreportopts{period_= PeriodBetween (fromGregorian 2008 1 2) (fromGregorian 2008 1 3), balancetype_=HistoricalBalance}, samplejournal) `gives` - ( - [ - ("assets:bank:checking","checking",3, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amount0 {aquantity=1}]) - ,("income:salary","salary",2, [mamountp' "$-1.00"], mamountp' "$-1.00",Mixed [amount0 {aquantity=(-1)}]) - ], - Mixed [usd0]) + -- ,_test "a valid history on an empty period" $ + -- (defreportopts{period_= PeriodBetween (fromGregorian 2008 1 2) (fromGregorian 2008 1 3), balancetype_=HistoricalBalance}, samplejournal) `gives` + -- ( + -- [ + -- ("assets:bank:checking","checking",3, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amount0 {aquantity=1}]) + -- ,("income:salary","salary",2, [mamountp' "$-1.00"], mamountp' "$-1.00",Mixed [amount0 {aquantity=(-1)}]) + -- ], + -- Mixed [usd0]) - ,_test "a valid history on an empty period (more complex)" $ - (defreportopts{period_= PeriodBetween (fromGregorian 2009 1 1) (fromGregorian 2009 1 2), balancetype_=HistoricalBalance}, samplejournal) `gives` - ( - [ - ("assets:bank:checking","checking",3, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amount0 {aquantity=1}]) - ,("assets:bank:saving","saving",3, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amount0 {aquantity=1}]) - ,("assets:cash","cash",2, [mamountp' "$-2.00"], mamountp' "$-2.00",Mixed [amount0 {aquantity=(-2)}]) - ,("expenses:food","food",2, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amount0 {aquantity=(1)}]) - ,("expenses:supplies","supplies",2, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amount0 {aquantity=(1)}]) - ,("income:gifts","gifts",2, [mamountp' "$-1.00"], mamountp' "$-1.00",Mixed [amount0 {aquantity=(-1)}]) - ,("income:salary","salary",2, [mamountp' "$-1.00"], mamountp' "$-1.00",Mixed [amount0 {aquantity=(-1)}]) - ], - Mixed [usd0]) + -- ,_test "a valid history on an empty period (more complex)" $ + -- (defreportopts{period_= PeriodBetween (fromGregorian 2009 1 1) (fromGregorian 2009 1 2), balancetype_=HistoricalBalance}, samplejournal) `gives` + -- ( + -- [ + -- ("assets:bank:checking","checking",3, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amount0 {aquantity=1}]) + -- ,("assets:bank:saving","saving",3, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amount0 {aquantity=1}]) + -- ,("assets:cash","cash",2, [mamountp' "$-2.00"], mamountp' "$-2.00",Mixed [amount0 {aquantity=(-2)}]) + -- ,("expenses:food","food",2, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amount0 {aquantity=(1)}]) + -- ,("expenses:supplies","supplies",2, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amount0 {aquantity=(1)}]) + -- ,("income:gifts","gifts",2, [mamountp' "$-1.00"], mamountp' "$-1.00",Mixed [amount0 {aquantity=(-1)}]) + -- ,("income:salary","salary",2, [mamountp' "$-1.00"], mamountp' "$-1.00",Mixed [amount0 {aquantity=(-1)}]) + -- ], + -- Mixed [usd0]) ] ] diff --git a/hledger-lib/Hledger/Utils/Test.hs b/hledger-lib/Hledger/Utils/Test.hs index 5443608ee..9944ba81d 100644 --- a/hledger-lib/Hledger/Utils/Test.hs +++ b/hledger-lib/Hledger/Utils/Test.hs @@ -4,229 +4,225 @@ {-# LANGUAGE ScopedTypeVariables #-} module Hledger.Utils.Test ( - HasCallStack - ,module EasyTest - ,runEasytests + module Test.Tasty + ,module Test.Tasty.HUnit + -- ,module QC + -- ,module SC ,tests - ,_tests ,test - ,_test - ,it - ,_it ,is - ,expectEqPP + ,expect + ,assertEq + ,expectEq + ,assertLeft + ,expectLeft + ,assertRight + ,expectRight ,expectParse - ,expectParseE - ,expectParseError - ,expectParseErrorE ,expectParseEq - ,expectParseEqE ,expectParseEqOn - ,expectParseEqOnE + ,expectParseError + ,expectParseE + ,expectParseEqE + ,expectParseErrorE ,expectParseStateOn ) where -import Control.Exception +import Test.Tasty +import Test.Tasty.HUnit +-- import Test.Tasty.QuickCheck as QC +-- import Test.Tasty.SmallCheck as SC + import Control.Monad.Except (ExceptT, runExceptT) import Control.Monad.State.Strict (StateT, evalStateT, execStateT) -#if !(MIN_VERSION_base(4,11,0)) -import Data.Monoid ((<>)) -#endif -import Data.CallStack -import Data.List +-- #if !(MIN_VERSION_base(4,11,0)) +-- import Data.Monoid ((<>)) +-- #endif +-- import Data.CallStack +import Data.List (isInfixOf) import qualified Data.Text as T -import Safe -import System.Exit import Text.Megaparsec import Text.Megaparsec.Custom -import EasyTest hiding (char, char', tests) -- reexported -import qualified EasyTest as E -- used here - import Hledger.Utils.Debug (pshow) -import Hledger.Utils.UTF8IOCompat (error') +-- import Hledger.Utils.UTF8IOCompat (error') --- * easytest helpers +-- * tasty helpers --- | Name the given test(s). A readability synonym for easytest's "scope". -test :: T.Text -> E.Test a -> E.Test a -test = E.scope +-- | Name and group a list of tests. +tests :: String -> [TestTree] -> TestTree +tests = testGroup + +-- | Name the given test(s). +-- test :: T.Text -> E.Test a -> E.Test a +-- test :: String -> Assertion -> TestTree +test :: String -> TestTree -> TestTree +test _name = id -- | Skip the given test(s), with the same type signature as "test". --- If called in a monadic sequence of tests, also skips following tests. -_test :: T.Text -> E.Test a -> E.Test a -_test _name = (E.skip >>) +-- If called in a monadic sequence of tests, also skips following tests. (?) +-- _test :: T.Text -> E.Test a -> E.Test a +-- _test _name = (E.skip >>) --- | Name the given test(s). A synonym for "test". -it :: T.Text -> E.Test a -> E.Test a -it = test +-- | Short equality test constructor. Actual value on the left, expected on the right. +is :: (Eq a, Show a, HasCallStack) => a -> a -> TestTree +is actual expected = testCase "sometest" $ actual @?= expected --- | Skip the given test(s), and any following tests in a monadic sequence. --- A synonym for "_test". -_it :: T.Text -> E.Test a -> E.Test a -_it = _test +-- | Expect True. +expect :: HasCallStack => Bool -> TestTree +expect val = testCase "sometest" $ assertBool "was false" val --- | Name and group a list of tests. Combines easytest's "scope" and "tests". -tests :: T.Text -> [E.Test ()] -> E.Test () -tests name = E.scope name . E.tests +-- | Assert equality. Expected first, actual second. +assertEq :: (HasCallStack, Eq a, Show a) => a -> a -> Assertion +assertEq expected actual = assertEqual "was not equal" expected actual --- | Skip the given list of tests, and any following tests in a monadic sequence, --- with the same type signature as "group". -_tests :: T.Text -> [E.Test ()] -> E.Test () -_tests _name = (E.skip >>) . E.tests +-- | Test for equality. Expected first, actual second. +expectEq :: (HasCallStack, Eq a, Show a) => a -> a -> TestTree +expectEq a b = testCase "sometest" $ assertEq a b --- | Run some easytest tests, catching easytest's ExitCode exception, --- returning True if there was a problem. --- With arguments, runs only the scope (or single test) named by the first argument --- (exact, case sensitive). --- If there is a second argument, it should be an integer and will be used --- as the seed for randomness. -runEasytests :: [String] -> E.Test () -> IO Bool -runEasytests args tests = (do - case args of - [] -> E.run tests - [a] -> E.runOnly (T.pack a) tests - a:b:_ -> do - case readMay b :: Maybe Int of - Nothing -> error' "the second argument should be an integer (a seed for easytest)" - Just seed -> E.rerunOnly seed (T.pack a) tests - return False - ) - `catch` (\(_::ExitCode) -> return True) +-- | Assert any Left value. +assertLeft :: (HasCallStack, Eq b, Show b) => Either a b -> Assertion +assertLeft (Left _) = return () +assertLeft (Right b) = assertFailure $ "expected Left, got (Right " ++ show b ++ ")" --- | Like easytest's expectEq (asserts the second (actual) value equals the first (expected) value) --- but pretty-prints the values in the failure output. -expectEqPP :: (Eq a, Show a, HasCallStack) => a -> a -> E.Test () -expectEqPP expected actual = if expected == actual then E.ok else E.crash $ - "\nexpected:\n" <> T.pack (pshow expected) <> "\nbut got:\n" <> T.pack (pshow actual) <> "\n" +-- | Test for any Left value. +expectLeft :: (HasCallStack, Eq a, Show a) => Either e a -> TestTree +expectLeft = testCase "sometest" . assertLeft --- | Shorter and flipped version of expectEqPP. The expected value goes last. -is :: (Eq a, Show a, HasCallStack) => a -> a -> Test () -is = flip expectEqPP +-- | Assert any Right value. +assertRight :: (HasCallStack, Eq a, Show a) => Either a b -> Assertion +assertRight (Right _) = return () +assertRight (Left a) = assertFailure $ "expected Right, got (Left " ++ show a ++ ")" + +-- | Test for any Right value. +expectRight :: (HasCallStack, Eq a, Show a) => Either a b -> TestTree +expectRight = testCase "sometest" . assertRight -- | Test that this stateful parser runnable in IO successfully parses -- all of the given input text, showing the parse error if it fails. -- Suitable for hledger's JournalParser parsers. -expectParse :: (Monoid st, Eq a, Show a, HasCallStack) => - StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> E.Test () -expectParse parser input = do - ep <- E.io (runParserT (evalStateT (parser <* eof) mempty) "" input) - either (fail.(++"\n").("\nparse error at "++).customErrorBundlePretty) - (const ok) +-- expectParse :: (Monoid st, Eq a, Show a, HasCallStack) => +-- StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> E.Test () +expectParse :: (HasCallStack, Eq a, Show a, Monoid st) => + StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> TestTree +expectParse parser input = testCaseSteps "sometest" $ \_step -> do + ep <- runParserT (evalStateT (parser <* eof) mempty) "" input + either (assertFailure.(++"\n").("\nparse error at "++).customErrorBundlePretty) + (const $ return ()) ep +-- -- pretty-printing both if it fails. +-- | Like expectParse, but also test the parse result is an expected value. +expectParseEq :: (HasCallStack, Eq a, Show a, Monoid st) => + StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> a -> TestTree +expectParseEq parser input expected = expectParseEqOn parser input id expected + +-- | Like expectParseEq, but transform the parse result with the given function +-- before comparing it. +expectParseEqOn :: (HasCallStack, Eq b, Show b, Monoid st) => + StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> (a -> b) -> b -> TestTree +expectParseEqOn parser input f expected = testCaseSteps "sometest" $ \_step -> do + ep <- runParserT (evalStateT (parser <* eof) mempty) "" input + either (assertFailure . (++"\n") . ("\nparse error at "++) . customErrorBundlePretty) + (assertEq expected . f) + ep + +-- | Test that this stateful parser runnable in IO fails to parse +-- the given input text, with a parse error containing the given string. +expectParseError :: (HasCallStack, Eq a, Show a, Monoid st) => + StateT st (ParsecT CustomErr T.Text IO) a -> String -> String -> TestTree +expectParseError parser input errstr = testCaseSteps "sometest" $ \_step -> do + ep <- runParserT (evalStateT parser mempty) "" (T.pack input) + case ep of + Right v -> assertFailure $ "\nparse succeeded unexpectedly, producing:\n" ++ pshow v ++ "\n" + Left e -> do + let e' = customErrorBundlePretty e + if errstr `isInfixOf` e' + then return () + else assertFailure $ "\nparse error is not as expected:\n" ++ e' ++ "\n" + -- Suitable for hledger's ErroringJournalParser parsers. expectParseE - :: (Monoid st, Eq a, Show a, HasCallStack) + :: (HasCallStack, Eq a, Show a, Monoid st) => StateT st (ParsecT CustomErr T.Text (ExceptT FinalParseError IO)) a -> T.Text - -> E.Test () -expectParseE parser input = do + -> TestTree +expectParseE parser input = testCaseSteps "sometest" $ \_step -> do let filepath = "" - eep <- E.io $ runExceptT $ + eep <- runExceptT $ runParserT (evalStateT (parser <* eof) mempty) filepath input case eep of Left finalErr -> let prettyErr = finalErrorBundlePretty $ attachSource filepath input finalErr - in fail $ "parse error at " <> prettyErr + in assertFailure $ "parse error at " <> prettyErr Right ep -> - either (fail.(++"\n").("\nparse error at "++).customErrorBundlePretty) - (const ok) + either (assertFailure.(++"\n").("\nparse error at "++).customErrorBundlePretty) + (const $ return ()) ep --- | Test that this stateful parser runnable in IO fails to parse --- the given input text, with a parse error containing the given string. -expectParseError :: (Monoid st, Eq a, Show a, HasCallStack) => - StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> String -> E.Test () -expectParseError parser input errstr = do - ep <- E.io (runParserT (evalStateT parser mempty) "" input) - case ep of - Right v -> fail $ "\nparse succeeded unexpectedly, producing:\n" ++ pshow v ++ "\n" - Left e -> do - let e' = customErrorBundlePretty e - if errstr `isInfixOf` e' - then ok - else fail $ "\nparse error is not as expected:\n" ++ e' ++ "\n" - -expectParseErrorE - :: (Monoid st, Eq a, Show a, HasCallStack) - => StateT st (ParsecT CustomErr T.Text (ExceptT FinalParseError IO)) a - -> T.Text - -> String - -> E.Test () -expectParseErrorE parser input errstr = do - let filepath = "" - eep <- E.io $ runExceptT $ runParserT (evalStateT parser mempty) filepath input - case eep of - Left finalErr -> do - let prettyErr = finalErrorBundlePretty $ attachSource filepath input finalErr - if errstr `isInfixOf` prettyErr - then ok - else fail $ "\nparse error is not as expected:\n" ++ prettyErr ++ "\n" - Right ep -> case ep of - Right v -> fail $ "\nparse succeeded unexpectedly, producing:\n" ++ pshow v ++ "\n" - Left e -> do - let e' = customErrorBundlePretty e - if errstr `isInfixOf` e' - then ok - else fail $ "\nparse error is not as expected:\n" ++ e' ++ "\n" - --- | Like expectParse, but also test the parse result is an expected value, --- pretty-printing both if it fails. -expectParseEq :: (Monoid st, Eq a, Show a, HasCallStack) => - StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> a -> E.Test () -expectParseEq parser input expected = expectParseEqOn parser input id expected - expectParseEqE :: (Monoid st, Eq a, Show a, HasCallStack) => StateT st (ParsecT CustomErr T.Text (ExceptT FinalParseError IO)) a -> T.Text -> a - -> E.Test () + -> TestTree expectParseEqE parser input expected = expectParseEqOnE parser input id expected --- | Like expectParseEq, but transform the parse result with the given function --- before comparing it. -expectParseEqOn :: (Monoid st, Eq b, Show b, HasCallStack) => - StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> (a -> b) -> b -> E.Test () -expectParseEqOn parser input f expected = do - ep <- E.io $ runParserT (evalStateT (parser <* eof) mempty) "" input - either (fail . (++"\n") . ("\nparse error at "++) . customErrorBundlePretty) - (expectEqPP expected . f) - ep - expectParseEqOnE - :: (Monoid st, Eq b, Show b, HasCallStack) + :: (HasCallStack, Eq b, Show b, Monoid st) => StateT st (ParsecT CustomErr T.Text (ExceptT FinalParseError IO)) a -> T.Text -> (a -> b) -> b - -> E.Test () -expectParseEqOnE parser input f expected = do + -> TestTree +expectParseEqOnE parser input f expected = testCaseSteps "sometest" $ \_step -> do let filepath = "" - eep <- E.io $ runExceptT $ - runParserT (evalStateT (parser <* eof) mempty) filepath input + eep <- runExceptT $ runParserT (evalStateT (parser <* eof) mempty) filepath input case eep of Left finalErr -> let prettyErr = finalErrorBundlePretty $ attachSource filepath input finalErr - in fail $ "parse error at " <> prettyErr + in assertFailure $ "parse error at " <> prettyErr Right ep -> - either (fail . (++"\n") . ("\nparse error at "++) . customErrorBundlePretty) - (expectEqPP expected . f) + either (assertFailure . (++"\n") . ("\nparse error at "++) . customErrorBundlePretty) + (assertEq expected . f) ep +expectParseErrorE + :: (Monoid st, Eq a, Show a, HasCallStack) + => StateT st (ParsecT CustomErr T.Text (ExceptT FinalParseError IO)) a + -> T.Text + -> String + -> TestTree +expectParseErrorE parser input errstr = testCaseSteps "sometest" $ \_step -> do + let filepath = "" + eep <- runExceptT $ runParserT (evalStateT parser mempty) filepath input + case eep of + Left finalErr -> do + let prettyErr = finalErrorBundlePretty $ attachSource filepath input finalErr + if errstr `isInfixOf` prettyErr + then return () + else assertFailure $ "\nparse error is not as expected:\n" ++ prettyErr ++ "\n" + Right ep -> case ep of + Right v -> assertFailure $ "\nparse succeeded unexpectedly, producing:\n" ++ pshow v ++ "\n" + Left e -> do + let e' = customErrorBundlePretty e + if errstr `isInfixOf` e' + then return () + else assertFailure $ "\nparse error is not as expected:\n" ++ e' ++ "\n" + -- | Run a stateful parser in IO like expectParse, then compare the -- final state (the wrapped state, not megaparsec's internal state), -- transformed by the given function, with the given expected value. -expectParseStateOn :: (HasCallStack, Monoid st, Eq b, Show b) => +expectParseStateOn :: (HasCallStack, Eq b, Show b, Monoid st) => StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> (st -> b) -> b - -> E.Test () -expectParseStateOn parser input f expected = do - es <- E.io $ runParserT (execStateT (parser <* eof) mempty) "" input + -> TestTree +expectParseStateOn parser input f expected = testCaseSteps "sometest" $ \_step -> do + es <- runParserT (execStateT (parser <* eof) mempty) "" input case es of - Left err -> fail $ (++"\n") $ ("\nparse error at "++) $ customErrorBundlePretty err - Right s -> expectEqPP expected $ f s + Left err -> assertFailure $ (++"\n") $ ("\nparse error at "++) $ customErrorBundlePretty err + Right s -> assertEq expected $ f s + diff --git a/hledger-lib/hledger-lib.cabal b/hledger-lib/hledger-lib.cabal index c53b3dd18..5027c2b72 100644 --- a/hledger-lib/hledger-lib.cabal +++ b/hledger-lib/hledger-lib.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 4b32c89e49ba64c66ca8552bb3ac2d54099cff23f9950b7fe294a32297a9b01a +-- hash: f8ee8c9fd0412cc0a8cd5c6286b7ef4f9a33ae2a30989dfc0b99c3f79bd55622 name: hledger-lib version: 1.15.99 @@ -107,7 +107,7 @@ library , Glob >=0.9 , ansi-terminal >=0.6.2.3 , array - , base >=4.9 && <4.13 + , base >=4.9 && <4.14 , base-compat-batteries >=0.10.1 && <0.12 , blaze-markup >=0.5.1 , bytestring @@ -119,7 +119,6 @@ library , data-default >=0.5 , deepseq , directory - , easytest >=0.2.1 && <0.3 , extra >=1.6.3 , fgl >=5.5.4.0 , file-embed >=0.0.10 @@ -136,6 +135,8 @@ library , safe >=0.2 , split >=0.1 , tabular >=0.2 + , tasty >=1.2.3 + , tasty-hunit >=0.10.0.2 , template-haskell , text >=1.2 , time >=1.5 @@ -160,7 +161,7 @@ test-suite doctests , Glob >=0.7 , ansi-terminal >=0.6.2.3 , array - , base >=4.9 && <4.13 + , base >=4.9 && <4.14 , base-compat-batteries >=0.10.1 && <0.12 , blaze-markup >=0.5.1 , bytestring @@ -173,7 +174,6 @@ test-suite doctests , deepseq , directory , doctest >=0.16 - , easytest >=0.2.1 && <0.3 , extra >=1.6.3 , fgl >=5.5.4.0 , file-embed >=0.0.10 @@ -190,6 +190,8 @@ test-suite doctests , safe >=0.2 , split >=0.1 , tabular >=0.2 + , tasty >=1.2.3 + , tasty-hunit >=0.10.0.2 , template-haskell , text >=1.2 , time >=1.5 @@ -204,58 +206,3 @@ test-suite doctests if (impl(ghc < 8.2)) buildable: False default-language: Haskell2010 - -test-suite easytests - type: exitcode-stdio-1.0 - main-is: easytests.hs - hs-source-dirs: - ./. - test - ghc-options: -Wall -fno-warn-unused-do-bind -fno-warn-name-shadowing -fno-warn-missing-signatures -fno-warn-type-defaults -fno-warn-orphans - build-depends: - Decimal - , Glob >=0.9 - , ansi-terminal >=0.6.2.3 - , array - , base >=4.9 && <4.13 - , base-compat-batteries >=0.10.1 && <0.12 - , blaze-markup >=0.5.1 - , bytestring - , call-stack - , cassava - , cassava-megaparsec - , cmdargs >=0.10 - , containers - , data-default >=0.5 - , deepseq - , directory - , easytest >=0.2.1 && <0.3 - , extra >=1.6.3 - , fgl >=5.5.4.0 - , file-embed >=0.0.10 - , filepath - , hashtables >=1.2.3.1 - , hledger-lib - , megaparsec >=7.0.0 && <8 - , mtl - , mtl-compat - , old-time - , parsec >=3 - , parser-combinators >=0.4.0 - , pretty-show >=1.6.4 - , regex-tdfa - , safe >=0.2 - , split >=0.1 - , tabular >=0.2 - , template-haskell - , text >=1.2 - , time >=1.5 - , timeit - , transformers >=0.2 - , uglymemo - , utf8-string >=0.3.5 - buildable: True - if (!impl(ghc >= 8.0)) - build-depends: - semigroups ==0.18.* - default-language: Haskell2010 diff --git a/hledger-lib/package.yaml b/hledger-lib/package.yaml index b36e5762c..5a3385443 100644 --- a/hledger-lib/package.yaml +++ b/hledger-lib/package.yaml @@ -39,7 +39,7 @@ extra-source-files: #data-files: dependencies: -- base >=4.9 && <4.13 +- base >=4.9 && <4.14 - base-compat-batteries >=0.10.1 && <0.12 - ansi-terminal >=0.6.2.3 - array @@ -54,7 +54,6 @@ dependencies: - Decimal - deepseq - directory -- easytest >= 0.2.1 && <0.3 - fgl >=5.5.4.0 - file-embed >=0.0.10 - filepath @@ -70,6 +69,8 @@ dependencies: - safe >=0.2 - split >=0.1 - tabular >=0.2 +- tasty >=1.2.3 +- tasty-hunit >=0.10.0.2 - template-haskell - text >=1.2 - time >=1.5 @@ -186,10 +187,10 @@ tests: buildable: false - easytests: - buildable: true - source-dirs: test - main: easytests.hs - other-modules: [] # prevent double compilation, https://github.com/sol/hpack/issues/188 - dependencies: - - hledger-lib + # easytests: + # buildable: true + # source-dirs: test + # main: easytests.hs + # other-modules: [] # prevent double compilation, https://github.com/sol/hpack/issues/188 + # dependencies: + # - hledger-lib diff --git a/hledger/Hledger/Cli/Commands.hs b/hledger/Hledger/Cli/Commands.hs index cdf3f8513..ec9fa0c48 100644 --- a/hledger/Hledger/Cli/Commands.hs +++ b/hledger/Hledger/Cli/Commands.hs @@ -55,9 +55,8 @@ import Data.Monoid ((<>)) import Data.Text (Text) import qualified Data.Text as T import Data.Time.Calendar -import qualified EasyTest +import System.Environment (withArgs) import System.Console.CmdArgs.Explicit as C -import System.Exit import Hledger import Hledger.Cli.CliOptions @@ -267,19 +266,14 @@ testmode = hledgerCommandMode -- not be used (and would raise an error). testcmd :: CliOpts -> Journal -> IO () testcmd opts _undefined = do - let args = words' $ query_ $ reportopts_ opts - -- workaround for https://github.com/joelburget/easytest/issues/11 --- import System.IO (hSetEncoding, stdout, stderr, utf8) --- hSetEncoding stdout utf8 --- hSetEncoding stderr utf8 - e <- runEasytests args $ EasyTest.tests [ - tests_Hledger - ,tests "Hledger.Cli" [ - tests_Cli_Utils - ,tests_Commands + withArgs (words' $ query_ $ reportopts_ opts) $ + defaultMain $ tests "sometests" [ -- Test.Tasty.defaultMain from Hledger.Util.Tests + tests_Hledger + ,tests "Hledger.Cli" [ + tests_Cli_Utils + ,tests_Commands + ] ] - ] - if e then exitFailure else exitSuccess tests_Commands = tests "Commands" [ @@ -288,60 +282,62 @@ tests_Commands = tests "Commands" [ -- some more tests easiest to define here: - ,test "apply account directive" $ do - let ignoresourcepos j = j{jtxns=map (\t -> t{tsourcepos=nullsourcepos}) (jtxns j)} - let sameParse str1 str2 = do j1 <- io $ readJournal def Nothing str1 >>= either error' (return . ignoresourcepos) - j2 <- io $ readJournal def Nothing str2 >>= either error' (return . ignoresourcepos) - j1 `is` j2{jlastreadtime=jlastreadtime j1, jfiles=jfiles j1} --, jparsestate=jparsestate j1} - sameParse - ("2008/12/07 One\n alpha $-1\n beta $1\n" <> - "apply account outer\n2008/12/07 Two\n aigh $-2\n bee $2\n" <> - "apply account inner\n2008/12/07 Three\n gamma $-3\n delta $3\n" <> - "end apply account\n2008/12/07 Four\n why $-4\n zed $4\n" <> - "end apply account\n2008/12/07 Five\n foo $-5\n bar $5\n" - ) - ("2008/12/07 One\n alpha $-1\n beta $1\n" <> - "2008/12/07 Two\n outer:aigh $-2\n outer:bee $2\n" <> - "2008/12/07 Three\n outer:inner:gamma $-3\n outer:inner:delta $3\n" <> - "2008/12/07 Four\n outer:why $-4\n outer:zed $4\n" <> - "2008/12/07 Five\n foo $-5\n bar $5\n" - ) + ,test "apply account directive" $ let + ignoresourcepos j = j{jtxns=map (\t -> t{tsourcepos=nullsourcepos}) (jtxns j)} + sameParse str1 str2 = testCaseSteps "sometest" $ \_step -> do + j1 <- readJournal def Nothing str1 >>= either error' (return . ignoresourcepos) + j2 <- readJournal def Nothing str2 >>= either error' (return . ignoresourcepos) + j1 @?= j2{jlastreadtime=jlastreadtime j1, jfiles=jfiles j1} --, jparsestate=jparsestate j1} + in sameParse + ("2008/12/07 One\n alpha $-1\n beta $1\n" <> + "apply account outer\n2008/12/07 Two\n aigh $-2\n bee $2\n" <> + "apply account inner\n2008/12/07 Three\n gamma $-3\n delta $3\n" <> + "end apply account\n2008/12/07 Four\n why $-4\n zed $4\n" <> + "end apply account\n2008/12/07 Five\n foo $-5\n bar $5\n" + ) + ("2008/12/07 One\n alpha $-1\n beta $1\n" <> + "2008/12/07 Two\n outer:aigh $-2\n outer:bee $2\n" <> + "2008/12/07 Three\n outer:inner:gamma $-3\n outer:inner:delta $3\n" <> + "2008/12/07 Four\n outer:why $-4\n outer:zed $4\n" <> + "2008/12/07 Five\n foo $-5\n bar $5\n" + ) - ,test "apply account directive should preserve \"virtual\" posting type" $ do - j <- io $ readJournal def Nothing "apply account test\n2008/12/07 One\n (from) $-1\n (to) $1\n" >>= either error' return + ,testCaseSteps "apply account directive should preserve \"virtual\" posting type" $ \_step -> do + j <- readJournal def Nothing "apply account test\n2008/12/07 One\n (from) $-1\n (to) $1\n" >>= either error' return let p = head $ tpostings $ head $ jtxns j - paccount p `is` "test:from" - ptype p `is` VirtualPosting + paccount p @?= "test:from" + ptype p @?= VirtualPosting - ,test "account aliases" $ do - j <- io $ readJournal def Nothing "!alias expenses = equity:draw:personal\n1/1\n (expenses:food) 1\n" >>= either error' return + ,testCaseSteps "account aliases" $ \_step -> do + j <- readJournal def Nothing "!alias expenses = equity:draw:personal\n1/1\n (expenses:food) 1\n" >>= either error' return let p = head $ tpostings $ head $ jtxns j - paccount p `is` "equity:draw:personal:food" + paccount p @?= "equity:draw:personal:food" - ,test "ledgerAccountNames" $ - ledgerAccountNames ledger7 `is` - ["assets","assets:cash","assets:checking","assets:saving","equity","equity:opening balances", - "expenses","expenses:food","expenses:food:dining","expenses:phone","expenses:vacation", - "liabilities","liabilities:credit cards","liabilities:credit cards:discover"] + ,testCase "ledgerAccountNames" $ + (ledgerAccountNames ledger7) + @?= + ["assets","assets:cash","assets:checking","assets:saving","equity","equity:opening balances", + "expenses","expenses:food","expenses:food:dining","expenses:phone","expenses:vacation", + "liabilities","liabilities:credit cards","liabilities:credit cards:discover"] -- ,test "journalCanonicaliseAmounts" ~: -- "use the greatest precision" ~: - -- (map asprecision $ journalAmountAndPriceCommodities $ journalCanonicaliseAmounts $ journalWithAmounts ["1","2.00"]) `is` [2,2] + -- (map asprecision $ journalAmountAndPriceCommodities $ journalCanonicaliseAmounts $ journalWithAmounts ["1","2.00"]) @?= [2,2] -- don't know what this should do -- ,test "elideAccountName" ~: do -- (elideAccountName 50 "aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa" - -- `is` "aa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa") + -- @?= "aa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa") -- (elideAccountName 20 "aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa" - -- `is` "aa:aa:aaaaaaaaaaaaaa") + -- @?= "aa:aa:aaaaaaaaaaaaaa") - ,test "default year" $ do - j <- io $ readJournal def Nothing defaultyear_journal_txt >>= either error' return - tdate (head $ jtxns j) `is` fromGregorian 2009 1 1 + ,testCaseSteps "default year" $ \_step -> do + j <- readJournal def Nothing defaultyear_journal_txt >>= either error' return + tdate (head $ jtxns j) @?= fromGregorian 2009 1 1 - ,test "show dollars" $ showAmount (usd 1) `is` "$1.00" + ,testCase "show dollars" $ showAmount (usd 1) @?= "$1.00" - ,test "show hours" $ showAmount (hrs 1) `is` "1.00h" + ,testCase "show hours" $ showAmount (hrs 1) @?= "1.00h" ] diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs index 51209d3fe..c4089c8f8 100644 --- a/hledger/Hledger/Cli/Commands/Balance.hs +++ b/hledger/Hledger/Cli/Commands/Balance.hs @@ -640,10 +640,10 @@ balanceReportTableAsText ropts = tableAsText ropts showamt tests_Balance = tests "Balance" [ tests "balanceReportAsText" [ - test "unicode in balance layout" $ do - j <- io $ readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n" + testCaseSteps "unicode in balance layout" $ \_step -> do + j <- readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n" let opts = defreportopts - balanceReportAsText opts (balanceReport opts (queryFromOpts (parsedate "2008/11/26") opts) j) `is` + balanceReportAsText opts (balanceReport opts (queryFromOpts (parsedate "2008/11/26") opts) j) @?= unlines [" -100 актив:наличные" ," 100 расходы:покупки" diff --git a/hledger/Hledger/Cli/Commands/Register.hs b/hledger/Hledger/Cli/Commands/Register.hs index 944b79748..713d6cead 100644 --- a/hledger/Hledger/Cli/Commands/Register.hs +++ b/hledger/Hledger/Cli/Commands/Register.hs @@ -194,10 +194,10 @@ postingsReportItemAsText opts preferredamtwidth preferredbalwidth (mdate, mendda tests_Register = tests "Register" [ tests "postingsReportAsText" [ - test "unicode in register layout" $ do - j <- io $ readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n" + testCaseSteps "unicode in register layout" $ \_step -> do + j <- readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n" let opts = defreportopts - (postingsReportAsText defcliopts $ postingsReport opts (queryFromOpts (parsedate "2008/11/26") opts) j) `is` unlines + (postingsReportAsText defcliopts $ postingsReport opts (queryFromOpts (parsedate "2008/11/26") opts) j) @?= unlines ["2009/01/01 медвежья шкура расходы:покупки 100 100" ," актив:наличные -100 0"] ] diff --git a/hledger/hledger.cabal b/hledger/hledger.cabal index 8e8a1ccef..e24065b58 100644 --- a/hledger/hledger.cabal +++ b/hledger/hledger.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 6bdd5e55ef3db9761bde530f23cd7fe97dc63e707e18129732a4d827505c6aa4 +-- hash: a8cb399c2c97d23c9fc48e12709494216df3069cce7ec448277be8fde91f72d0 name: hledger version: 1.15.99 @@ -156,7 +156,6 @@ library , containers , data-default >=0.5 , directory - , easytest >=0.2.1 && <0.3 , extra >=1.6.3 , filepath , hashable >=1.2.4 @@ -208,7 +207,6 @@ executable hledger , containers , data-default >=0.5 , directory - , easytest >=0.2.1 && <0.3 , extra >=1.6.3 , filepath , haskeline >=0.6 @@ -260,7 +258,6 @@ test-suite test , containers , data-default >=0.5 , directory - , easytest >=0.2.1 && <0.3 , extra >=1.6.3 , filepath , haskeline >=0.6 @@ -312,7 +309,6 @@ benchmark bench , criterion , data-default >=0.5 , directory - , easytest >=0.2.1 && <0.3 , extra >=1.6.3 , filepath , haskeline >=0.6 diff --git a/hledger/package.yaml b/hledger/package.yaml index 4de56b92f..9b5e30a5c 100644 --- a/hledger/package.yaml +++ b/hledger/package.yaml @@ -115,7 +115,6 @@ dependencies: - data-default >=0.5 - Decimal - directory -- easytest >= 0.2.1 && <0.3 - extra >=1.6.3 - filepath - haskeline >=0.6