lib: drop HUnit helpers, rename expectEqPP
This commit is contained in:
		
							parent
							
								
									54db19e857
								
							
						
					
					
						commit
						4003264129
					
				| @ -50,7 +50,7 @@ import Data.Tree | ||||
| import Text.Printf | ||||
| 
 | ||||
| import Hledger.Data.Types | ||||
| import Hledger.Utils hiding (is) | ||||
| import Hledger.Utils  | ||||
| 
 | ||||
| -- $setup | ||||
| -- >>> :set -XOverloadedStrings | ||||
| @ -226,9 +226,6 @@ accountRegexToAccountName = T.pack . regexReplace "^\\^(.*?)\\(:\\|\\$\\)$" "\\1 | ||||
| --isAccountRegex  :: String -> Bool | ||||
| --isAccountRegex s = take 1 s == "^" && take 5 (reverse s) == ")$|:(" | ||||
| 
 | ||||
| is :: (Eq a, Show a, HasCallStack) => a -> a -> Test () | ||||
| is = flip expectEq' | ||||
| 
 | ||||
| easytests_AccountName = tests "AccountName" [ | ||||
|   tests "accountNameTreeFrom" [ | ||||
|      accountNameTreeFrom ["a"]       `is` Node "root" [Node "a" []] | ||||
|  | ||||
| @ -133,7 +133,7 @@ import qualified Data.Map as M | ||||
| 
 | ||||
| import Hledger.Data.Types | ||||
| import Hledger.Data.Commodity | ||||
| import Hledger.Utils hiding (is) | ||||
| import Hledger.Utils  | ||||
| 
 | ||||
| 
 | ||||
| deriving instance Show MarketPrice | ||||
| @ -671,9 +671,6 @@ mixedAmountValue j d (Mixed as) = Mixed $ map (amountValue j d) as | ||||
| ------------------------------------------------------------------------------- | ||||
| -- tests | ||||
| 
 | ||||
| is :: (Eq a, Show a, HasCallStack) => a -> a -> Test () | ||||
| is = flip expectEq' | ||||
| 
 | ||||
| easytests_Amount = tests "Amount" [ | ||||
|    tests "Amount" [ | ||||
| 
 | ||||
|  | ||||
| @ -97,7 +97,7 @@ import System.Time (ClockTime(TOD)) | ||||
| import Text.Printf | ||||
| import qualified Data.Map as M | ||||
| 
 | ||||
| import Hledger.Utils hiding (is) | ||||
| import Hledger.Utils  | ||||
| import Hledger.Data.Types | ||||
| import Hledger.Data.AccountName | ||||
| import Hledger.Data.Amount | ||||
| @ -1060,9 +1060,6 @@ Right samplejournal = journalBalanceTransactions False $ | ||||
|           ] | ||||
|          } | ||||
| 
 | ||||
| is :: (Eq a, Show a, HasCallStack) => a -> a -> Test () | ||||
| is = flip expectEq' | ||||
| 
 | ||||
| easytests_Journal = tests "Journal" [ | ||||
| 
 | ||||
|    test "journalDateSpan" $ | ||||
|  | ||||
| @ -31,7 +31,7 @@ import qualified Data.Text as T | ||||
| import Safe (headDef) | ||||
| import Text.Printf | ||||
| 
 | ||||
| import Hledger.Utils.Test hiding (is) | ||||
| import Hledger.Utils.Test  | ||||
| import Hledger.Data.Types | ||||
| import Hledger.Data.Account | ||||
| import Hledger.Data.Journal | ||||
| @ -107,9 +107,6 @@ ledgerCommodities = M.keys . jinferredcommodities . ljournal | ||||
| 
 | ||||
| -- tests | ||||
| 
 | ||||
| is :: (Eq a, Show a, HasCallStack) => a -> a -> Test () | ||||
| is = flip expectEq' | ||||
| 
 | ||||
| easytests_Ledger = tests "Ledger" [ | ||||
| 
 | ||||
|   tests "ledgerFromJournal" [ | ||||
|  | ||||
| @ -69,7 +69,7 @@ import qualified Data.Text as T | ||||
| import Data.Time.Calendar | ||||
| import Safe | ||||
| 
 | ||||
| import Hledger.Utils hiding (is) | ||||
| import Hledger.Utils  | ||||
| import Hledger.Data.Types | ||||
| import Hledger.Data.Amount | ||||
| import Hledger.Data.AccountName | ||||
| @ -293,9 +293,6 @@ aliasReplace (RegexAlias re repl) a = T.pack $ regexReplaceCIMemo re repl $ T.un | ||||
| 
 | ||||
| -- tests | ||||
| 
 | ||||
| is :: (Eq a, Show a, HasCallStack) => a -> a -> Test () | ||||
| is = flip expectEq' | ||||
| 
 | ||||
| easytests_Posting = tests "Posting" [ | ||||
| 
 | ||||
|   tests "accountNamePostingType" [ | ||||
|  | ||||
| @ -26,7 +26,7 @@ import System.Locale (defaultTimeLocale) | ||||
| #endif | ||||
| import Text.Printf | ||||
| 
 | ||||
| import Hledger.Utils hiding (is) | ||||
| import Hledger.Utils  | ||||
| import Hledger.Data.Types | ||||
| import Hledger.Data.Dates | ||||
| import Hledger.Data.Amount | ||||
| @ -113,9 +113,6 @@ entryFromTimeclockInOut i o | ||||
| 
 | ||||
| -- tests | ||||
| 
 | ||||
| is :: (Eq a, Show a, HasCallStack) => a -> a -> Test () | ||||
| is = flip expectEq' | ||||
| 
 | ||||
| easytests_Timeclock = tests "Timeclock" [ | ||||
|   do | ||||
|    today <- io getCurrentDay | ||||
|  | ||||
| @ -56,7 +56,7 @@ import Data.Time.Calendar | ||||
| import Text.Printf | ||||
| import qualified Data.Map as Map | ||||
| 
 | ||||
| import Hledger.Utils hiding (is) | ||||
| import Hledger.Utils  | ||||
| import Hledger.Data.Types | ||||
| import Hledger.Data.Dates | ||||
| import Hledger.Data.Posting | ||||
| @ -442,9 +442,6 @@ postingSetTransaction t p = p{ptransaction=Just t} | ||||
| 
 | ||||
| -- tests | ||||
| 
 | ||||
| is :: (Eq a, Show a, HasCallStack) => a -> a -> Test () | ||||
| is = flip expectEq' | ||||
| 
 | ||||
| easytests_Transaction = tests "Transaction" [ | ||||
| 
 | ||||
|   tests "showTransactionUnelided" [ | ||||
|  | ||||
| @ -63,7 +63,7 @@ import Safe (readDef, headDef) | ||||
| import Text.Megaparsec | ||||
| import Text.Megaparsec.Char | ||||
| 
 | ||||
| import Hledger.Utils hiding (words', is) | ||||
| import Hledger.Utils hiding (words') | ||||
| import Hledger.Data.Types | ||||
| import Hledger.Data.AccountName | ||||
| import Hledger.Data.Amount (nullamt, usd) | ||||
| @ -652,9 +652,6 @@ matchesMarketPrice _ _           = True | ||||
| 
 | ||||
| -- tests | ||||
| 
 | ||||
| is :: (Eq a, Show a, HasCallStack) => a -> a -> Test () | ||||
| is = flip expectEq' | ||||
| 
 | ||||
| easytests_Query = tests "Query" [ | ||||
|    tests "simplifyQuery" [ | ||||
|      | ||||
|  | ||||
| @ -32,7 +32,7 @@ import Data.Time.Calendar | ||||
| import Hledger.Data | ||||
| import Hledger.Read (mamountp') | ||||
| import Hledger.Query | ||||
| import Hledger.Utils hiding (is) | ||||
| import Hledger.Utils  | ||||
| import Hledger.Reports.ReportOptions | ||||
| 
 | ||||
| 
 | ||||
| @ -180,9 +180,6 @@ Right samplejournal2 = | ||||
| 
 | ||||
| -- tests | ||||
| 
 | ||||
| is :: (Eq a, Show a, HasCallStack) => a -> a -> Test () | ||||
| is = flip expectEq' | ||||
| 
 | ||||
| easytests_BalanceReport = tests "BalanceReport" [ | ||||
|   tests "balanceReport" $ | ||||
|     let | ||||
|  | ||||
| @ -20,7 +20,7 @@ import Data.Ord | ||||
| import Hledger.Data | ||||
| import Hledger.Query | ||||
| import Hledger.Reports.ReportOptions | ||||
| import Hledger.Utils hiding (is) | ||||
| import Hledger.Utils  | ||||
| 
 | ||||
| 
 | ||||
| -- | A journal entries report is a list of whole transactions as | ||||
| @ -37,9 +37,6 @@ entriesReport opts q j = | ||||
|       date = transactionDateFn opts | ||||
|       ts = jtxns $ journalSelectingAmountFromOpts opts j | ||||
| 
 | ||||
| is :: (Eq a, Show a, HasCallStack) => a -> a -> Test () | ||||
| is = flip expectEq' | ||||
| 
 | ||||
| easytests_EntriesReport = tests "EntriesReport" [ | ||||
|   tests "entriesReport" [ | ||||
|      test "not acct" $ (length $ entriesReport defreportopts (Not $ Acct "bank") samplejournal) `is` 1 | ||||
|  | ||||
| @ -30,7 +30,7 @@ import Text.Tabular.AsciiWide | ||||
| 
 | ||||
| import Hledger.Data | ||||
| import Hledger.Query | ||||
| import Hledger.Utils hiding (is) | ||||
| import Hledger.Utils  | ||||
| import Hledger.Read (mamountp') | ||||
| import Hledger.Reports.ReportOptions | ||||
| import Hledger.Reports.BalanceReport | ||||
| @ -302,9 +302,6 @@ tableAsText (ReportOpts{pretty_tables_ = pretty}) showcell = | ||||
| 
 | ||||
| -- tests | ||||
| 
 | ||||
| is :: (Eq a, Show a, HasCallStack) => a -> a -> Test () | ||||
| is = flip expectEq' | ||||
| 
 | ||||
| easytests_MultiBalanceReports = tests "MultiBalanceReports" [ | ||||
|   let | ||||
|     (opts,journal) `gives` r = do | ||||
|  | ||||
| @ -26,7 +26,7 @@ import Safe (headMay, lastMay) | ||||
| 
 | ||||
| import Hledger.Data | ||||
| import Hledger.Query | ||||
| import Hledger.Utils hiding (is) | ||||
| import Hledger.Utils  | ||||
| import Hledger.Reports.ReportOptions | ||||
| 
 | ||||
| 
 | ||||
| @ -217,9 +217,6 @@ summarisePostingsInDateSpan (DateSpan b e) wd depth showempty ps | ||||
| 
 | ||||
| -- tests | ||||
| 
 | ||||
| is :: (Eq a, Show a, HasCallStack) => a -> a -> Test () | ||||
| is = flip expectEq' | ||||
| 
 | ||||
| easytests_PostingsReport = tests "PostingsReport" [ | ||||
| 
 | ||||
|    tests "postingsReport" $ | ||||
|  | ||||
| @ -52,7 +52,7 @@ import Text.Megaparsec.Error | ||||
| 
 | ||||
| import Hledger.Data | ||||
| import Hledger.Query | ||||
| import Hledger.Utils hiding (is) | ||||
| import Hledger.Utils | ||||
| 
 | ||||
| 
 | ||||
| type FormatStr = String | ||||
| @ -420,9 +420,6 @@ specifiedEndDate ropts = snd <$> specifiedStartEndDates ropts | ||||
| 
 | ||||
| -- tests | ||||
| 
 | ||||
| is :: (Eq a, Show a, HasCallStack) => a -> a -> Test () | ||||
| is = flip expectEq' | ||||
| 
 | ||||
| easytests_ReportOptions = tests "ReportOptions" [ | ||||
|    tests "queryFromOpts" [ | ||||
|       (queryFromOpts nulldate defreportopts) `is` Any | ||||
|  | ||||
| @ -3,7 +3,6 @@ | ||||
| {-# LANGUAGE ScopedTypeVariables #-} | ||||
| 
 | ||||
| module Hledger.Utils.Test ( | ||||
|   -- * easytest | ||||
|    HasCallStack | ||||
|   ,module EasyTest | ||||
|   ,runEasyTests | ||||
| @ -13,42 +12,30 @@ module Hledger.Utils.Test ( | ||||
|   ,_test | ||||
|   ,it | ||||
|   ,_it | ||||
|   ,expectEq' | ||||
|   ,is | ||||
|   ,expectEqPP | ||||
|   ,expectParse | ||||
|   ,expectParseError | ||||
|   ,expectParseEq | ||||
|   ,expectParseEqOn | ||||
|   -- * HUnit | ||||
|   ,module Test.HUnit | ||||
|   ,runHunitTests | ||||
|   ,assertParse | ||||
|   ,assertParseFailure | ||||
|   ,assertParseEqual | ||||
|   ,assertParseEqual' | ||||
|   ,is | ||||
| 
 | ||||
| ) where | ||||
| )  | ||||
| where | ||||
| 
 | ||||
| import Control.Exception | ||||
| import Control.Monad | ||||
| import Control.Monad.State.Strict (StateT, evalStateT) | ||||
| #if !(MIN_VERSION_base(4,11,0)) | ||||
| import Data.Monoid ((<>)) | ||||
| #endif | ||||
| import Data.CallStack | ||||
| import Data.Functor.Identity | ||||
| import Data.List | ||||
| import qualified Data.Text as T | ||||
| import Safe  | ||||
| import System.Exit | ||||
| import System.IO | ||||
| import Text.Megaparsec | ||||
| import Text.Megaparsec.Custom | ||||
| 
 | ||||
| import EasyTest hiding (char, char', tests)  -- reexported | ||||
| import qualified EasyTest as E               -- used here | ||||
| import Test.HUnit hiding (Test, test)        -- reexported | ||||
| import qualified Test.HUnit as U             -- used here | ||||
| 
 | ||||
| import Hledger.Utils.Debug (pshow) | ||||
| import Hledger.Utils.UTF8IOCompat (error') | ||||
| @ -102,10 +89,14 @@ runEasyTests args easytests = (do | ||||
| 
 | ||||
| -- | Like easytest's expectEq (asserts the second (actual) value equals the first (expected) value) | ||||
| -- but pretty-prints the values in the failure output.  | ||||
| expectEq' :: (Eq a, Show a, HasCallStack) => a -> a -> E.Test () | ||||
| expectEq' expected actual = if expected == actual then E.ok else E.crash $ | ||||
| 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" | ||||
| 
 | ||||
| -- | Shorter and flipped version of expectEqPP. The expected value goes last. | ||||
| is :: (Eq a, Show a, HasCallStack) => a -> a -> Test () | ||||
| is = flip expectEqPP | ||||
| 
 | ||||
| -- | 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. | ||||
| @ -141,67 +132,5 @@ 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 "++) . parseErrorPretty) (expectEq' expected . f) ep | ||||
|   either (fail . (++"\n") . ("\nparse error at "++) . parseErrorPretty) (expectEqPP expected . f) ep | ||||
| 
 | ||||
| -- * HUnit helpers | ||||
| 
 | ||||
| -- | Get a Test's label, or the empty string. | ||||
| testName :: U.Test -> String | ||||
| testName (TestLabel n _) = n | ||||
| testName _ = "" | ||||
| 
 | ||||
| -- | Flatten a Test containing TestLists into a list of single tests. | ||||
| flattenTests :: U.Test -> [U.Test] | ||||
| flattenTests (TestLabel _ t@(TestList _)) = flattenTests t | ||||
| flattenTests (TestList ts) = concatMap flattenTests ts | ||||
| flattenTests t = [t] | ||||
| 
 | ||||
| -- | Filter TestLists in a Test, recursively, preserving the structure. | ||||
| filterTests :: (U.Test -> Bool) -> U.Test -> U.Test | ||||
| filterTests p (TestLabel l ts) = TestLabel l (filterTests p ts) | ||||
| filterTests p (TestList ts) = TestList $ filter (any p . flattenTests) $ map (filterTests p) ts | ||||
| filterTests _ t = t | ||||
| 
 | ||||
| -- | Simple way to assert something is some expected value, with no label. | ||||
| is :: (Eq a, Show a) => a -> a -> Assertion | ||||
| a `is` e = assertEqual "" e a  -- XXX should it have a message ? | ||||
| 
 | ||||
| -- | Assert a parse result is successful, printing the parse error on failure. | ||||
| assertParse :: (Show t, Show e) => (Either (ParseError t e) a) -> Assertion | ||||
| assertParse parse = either (assertFailure.show) (const (return ())) parse | ||||
| 
 | ||||
| 
 | ||||
| -- | Assert a parse result is successful, printing the parse error on failure. | ||||
| assertParseFailure :: (Either (ParseError t e) a) -> Assertion | ||||
| assertParseFailure parse = either (const $ return ()) (const $ assertFailure "parse should not have succeeded") parse | ||||
| 
 | ||||
| -- | Assert a parse result is some expected value, printing the parse error on failure. | ||||
| assertParseEqual :: (Show a, Eq a, Show t, Show e) => (Either (ParseError t e) a) -> a -> Assertion | ||||
| assertParseEqual parse expected = either (assertFailure.show) (`is` expected) parse | ||||
| 
 | ||||
| -- | Assert that the parse result returned from an identity monad is some expected value, | ||||
| -- on failure printing the parse error or differing values. | ||||
| assertParseEqual' :: (Show a, Eq a, Show t, Show e) => Identity (Either (ParseError t e) a) -> a -> Assertion | ||||
| assertParseEqual' parse expected =  | ||||
|   either  | ||||
|     (assertFailure . ("parse error: "++) . pshow)  | ||||
|     (\actual -> assertEqual (unlines ["expected: " ++ show expected, " but got: " ++ show actual]) expected actual)  | ||||
|     $ runIdentity parse | ||||
| 
 | ||||
| -- | Run some hunit tests, returning True if there was a problem. | ||||
| -- With arguments, runs only tests whose names contain the first argument | ||||
| -- (case sensitive).  | ||||
| runHunitTests :: [String] -> U.Test -> IO Bool | ||||
| runHunitTests args hunittests = do | ||||
|   let ts =  | ||||
|         (case args of | ||||
|           a:_ -> filterTests ((a `isInfixOf`) . testName) | ||||
|           _   -> id | ||||
|         ) hunittests | ||||
|   results <- liftM (fst . flip (,) 0) $ runTestTTStdout ts | ||||
|   return $ errors results > 0 || failures results > 0 | ||||
|   where | ||||
|     -- | Like runTestTT but prints to stdout. | ||||
|     runTestTTStdout t = do | ||||
|       (counts, 0) <- U.runTestText (putTextToHandle stdout True) t | ||||
|       return counts | ||||
|  | ||||
| @ -51,7 +51,7 @@ import qualified EasyTest | ||||
| import System.Console.CmdArgs.Explicit as C | ||||
| import System.Exit | ||||
| 
 | ||||
| import Hledger hiding (is) | ||||
| import Hledger  | ||||
| import Hledger.Cli.CliOptions | ||||
| import Hledger.Cli.Version | ||||
| import Hledger.Cli.Commands.Accounts | ||||
| @ -245,9 +245,6 @@ testcmd opts _undefined = do | ||||
| 
 | ||||
| -- unit tests of hledger command-line executable | ||||
| 
 | ||||
| is :: (Eq a, Show a, HasCallStack) => a -> a -> Test () | ||||
| is = flip expectEq' | ||||
| 
 | ||||
| easytests_Commands = tests "Commands" [ | ||||
|    easytests_Balance | ||||
|   ,easytests_Register | ||||
|  | ||||
| @ -263,7 +263,7 @@ import Text.Printf (printf) | ||||
| import Text.Tabular as T | ||||
| --import Text.Tabular.AsciiWide | ||||
| 
 | ||||
| import Hledger hiding (is) | ||||
| import Hledger  | ||||
| import Hledger.Cli.CliOptions | ||||
| import Hledger.Cli.Utils | ||||
| 
 | ||||
| @ -630,9 +630,6 @@ balanceReportTableAsText ropts = tableAsText ropts showamt | ||||
|             | otherwise    =  showMixedAmountOneLineWithoutPrice | ||||
| 
 | ||||
| 
 | ||||
| is :: (Eq a, Show a, HasCallStack) => a -> a -> Test () | ||||
| is = flip expectEq' | ||||
| 
 | ||||
| easytests_Balance = tests "Balance" [ | ||||
| 
 | ||||
|    tests "balanceReportAsText" [ | ||||
|  | ||||
| @ -22,7 +22,7 @@ import qualified Data.Text as T | ||||
| import System.Console.CmdArgs.Explicit | ||||
| import Text.CSV | ||||
| 
 | ||||
| import Hledger hiding (is) | ||||
| import Hledger  | ||||
| import Hledger.Cli.CliOptions | ||||
| import Hledger.Cli.Utils | ||||
| 
 | ||||
| @ -191,9 +191,6 @@ postingsReportItemAsText opts preferredamtwidth preferredbalwidth (mdate, mendda | ||||
| 
 | ||||
| -- tests | ||||
| 
 | ||||
| is :: (Eq a, Show a, HasCallStack) => a -> a -> Test () | ||||
| is = flip expectEq' | ||||
| 
 | ||||
| easytests_Register = tests "Register" [ | ||||
| 
 | ||||
|    tests "postingsReportAsText" [ | ||||
|  | ||||
		Loading…
	
		Reference in New Issue
	
	Block a user