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