From 807e6dc4afd640190e39fcd952db0d0d57b721e3 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Tue, 4 Sep 2018 12:42:37 -0700 Subject: [PATCH] tests: Cli -> easytest --- hledger/Hledger/Cli.hs | 7 +- hledger/Hledger/Cli/Commands.hs | 85 +++++++++++++----------- hledger/Hledger/Cli/Commands/Balance.hs | 40 +++++------ hledger/Hledger/Cli/Commands/Register.hs | 34 +++++----- 4 files changed, 91 insertions(+), 75 deletions(-) diff --git a/hledger/Hledger/Cli.hs b/hledger/Hledger/Cli.hs index ee38dfe69..26a00411f 100644 --- a/hledger/Hledger/Cli.hs +++ b/hledger/Hledger/Cli.hs @@ -15,8 +15,8 @@ module Hledger.Cli ( module Hledger.Cli.DocFiles, module Hledger.Cli.Utils, module Hledger.Cli.Version, - tests_Hledger_Cli, module Hledger, + easytests_Cli, module System.Console.CmdArgs.Explicit ) where @@ -29,4 +29,7 @@ import Hledger.Cli.DocFiles import Hledger.Cli.Utils import Hledger.Cli.Version -tests_Hledger_Cli = tests_Hledger_Cli_Commands \ No newline at end of file +easytests_Cli = tests "Cli" [ + easytests_Hledger + ,easytests_Commands + ] diff --git a/hledger/Hledger/Cli/Commands.hs b/hledger/Hledger/Cli/Commands.hs index ed08c73e5..89cae60ba 100644 --- a/hledger/Hledger/Cli/Commands.hs +++ b/hledger/Hledger/Cli/Commands.hs @@ -12,7 +12,7 @@ module Hledger.Cli.Commands ( ,builtinCommands ,builtinCommandNames ,printCommandsList - ,tests_Hledger_Cli_Commands + ,easytests_Commands ,module Hledger.Cli.Commands.Accounts ,module Hledger.Cli.Commands.Activity ,module Hledger.Cli.Commands.Add @@ -49,10 +49,11 @@ import Data.String.Here import Data.Text (Text) import qualified Data.Text as T import Data.Time.Calendar +import qualified EasyTest import System.Console.CmdArgs.Explicit as C import System.Exit -import Hledger +import Hledger hiding (is) import Hledger.Cli.CliOptions import Hledger.Cli.Version import Hledger.Cli.Commands.Accounts @@ -245,76 +246,82 @@ testcmd :: CliOpts -> Journal -> IO () testcmd opts _undefined = do let args = words' $ query_ $ reportopts_ opts putStrLn "\n=== easytest tests: ===\n" - e1 <- runEasyTests args easytests_Hledger + e1 <- runEasyTests args $ EasyTest.tests [easytests_Hledger, easytests_Commands] when (not e1) $ putStr "\n" putStrLn "=== hunit tests: ===\n" e2 <- runHunitTests args tests_Hledger_Cli_Commands putStrLn "" if or [e1, e2] then exitFailure else exitSuccess --- collected hledger-lib + hledger hunit tests +-- unit tests of hledger command-line executable -tests_Hledger_Cli_Commands = TestList [ - tests_Hledger_Cli_Commands_Balance - ,tests_Hledger_Cli_Commands_Register +is :: (Eq a, Show a, HasCallStack) => a -> a -> Test () +is = flip expectEq' + +easytests_Commands = tests "Commands" [ + easytests_Balance + ,easytests_Register -- some more tests easiest to define here: - ,"apply account directive" ~: - let ignoresourcepos j = j{jtxns=map (\t -> t{tsourcepos=nullsourcepos}) (jtxns j)} in - let sameParse str1 str2 = do j1 <- readJournal def Nothing str1 >>= either error' (return . ignoresourcepos) - j2 <- readJournal def Nothing str2 >>= either error' (return . ignoresourcepos) + ,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} - 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" - ) + 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" + ) - ,"apply account directive should preserve \"virtual\" posting type" ~: do - j <- readJournal def Nothing "apply account test\n2008/12/07 One\n (from) $-1\n (to) $1\n" >>= either error' return + ,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 let p = head $ tpostings $ head $ jtxns j - assertBool "" $ paccount p == "test:from" - assertBool "" $ ptype p == VirtualPosting + paccount p `is` "test:from" + ptype p `is` VirtualPosting - ,"account aliases" ~: do - j <- readJournal def Nothing "!alias expenses = equity:draw:personal\n1/1\n (expenses:food) 1\n" >>= either error' return + ,test "account aliases" $ do + j <- io $ 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 - assertBool "" $ paccount p == "equity:draw:personal:food" + paccount p `is` "equity:draw:personal:food" - ,"ledgerAccountNames" ~: + ,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"] - -- ,"journalCanonicaliseAmounts" ~: + -- ,test "journalCanonicaliseAmounts" ~: -- "use the greatest precision" ~: -- (map asprecision $ journalAmountAndPriceCommodities $ journalCanonicaliseAmounts $ journalWithAmounts ["1","2.00"]) `is` [2,2] -- don't know what this should do - -- ,"elideAccountName" ~: do + -- ,test "elideAccountName" ~: do -- (elideAccountName 50 "aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa" -- `is` "aa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa") -- (elideAccountName 20 "aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa" -- `is` "aa:aa:aaaaaaaaaaaaaa") - ,"default year" ~: do - j <- readJournal def Nothing defaultyear_journal_txt >>= either error' return + ,test "default year" $ do + j <- io $ readJournal def Nothing defaultyear_journal_txt >>= either error' return tdate (head $ jtxns j) `is` fromGregorian 2009 1 1 - return () - ,"show dollars" ~: showAmount (usd 1) ~?= "$1.00" + ,test "show dollars" $ showAmount (usd 1) `is` "$1.00" - ,"show hours" ~: showAmount (hrs 1) ~?= "1.00h" + ,test "show hours" $ showAmount (hrs 1) `is` "1.00h" + + ] + +tests_Hledger_Cli_Commands = TestList [ ] diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs index f875ea196..e9d7175e4 100644 --- a/hledger/Hledger/Cli/Commands/Balance.hs +++ b/hledger/Hledger/Cli/Commands/Balance.hs @@ -247,7 +247,7 @@ module Hledger.Cli.Commands.Balance ( ,multiBalanceReportHtmlRows ,balanceReportAsTable ,balanceReportTableAsText - ,tests_Hledger_Cli_Commands_Balance + ,easytests_Balance ) where import Control.Monad (when) @@ -263,7 +263,7 @@ import Text.Printf (printf) import Text.Tabular as T --import Text.Tabular.AsciiWide -import Hledger +import Hledger hiding (is) import Hledger.Cli.CliOptions import Hledger.Cli.Utils @@ -394,21 +394,6 @@ balanceReportAsText opts ((items, total)) = unlines $ concat lines ++ t in overline : totallines Left _ -> [] -tests_balanceReportAsText = [ - "balanceReportAsText" ~: do - -- "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) `is` - unlines - [" -100 актив:наличные" - ," 100 расходы:покупки" - ,"--------------------" - ," 0" - ] - ] - {- :r This implementation turned out to be a bit convoluted but implements the following algorithm for formatting: @@ -645,5 +630,22 @@ balanceReportTableAsText ropts = tableAsText ropts showamt | otherwise = showMixedAmountOneLineWithoutPrice -tests_Hledger_Cli_Commands_Balance = TestList - tests_balanceReportAsText +is :: (Eq a, Show a, HasCallStack) => a -> a -> Test () +is = flip expectEq' + +easytests_Balance = tests "Balance" [ + + tests "balanceReportAsText" [ + test "unicode in balance layout" $ do + j <- io $ readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n" + let opts = defreportopts + balanceReportAsText opts (balanceReport opts (queryFromOpts (parsedate "2008/11/26") opts) j) `is` + unlines + [" -100 актив:наличные" + ," 100 расходы:покупки" + ,"--------------------" + ," 0" + ] + ] + + ] diff --git a/hledger/Hledger/Cli/Commands/Register.hs b/hledger/Hledger/Cli/Commands/Register.hs index 8e9d7ae84..d6a92af26 100644 --- a/hledger/Hledger/Cli/Commands/Register.hs +++ b/hledger/Hledger/Cli/Commands/Register.hs @@ -12,7 +12,7 @@ module Hledger.Cli.Commands.Register ( ,postingsReportAsText ,postingsReportItemAsText -- ,showPostingWithBalanceForVty - ,tests_Hledger_Cli_Commands_Register + ,easytests_Register ) where import Data.List @@ -22,7 +22,7 @@ import qualified Data.Text as T import System.Console.CmdArgs.Explicit import Text.CSV -import Hledger +import Hledger hiding (is) import Hledger.Cli.CliOptions import Hledger.Cli.Utils @@ -96,17 +96,6 @@ postingsReportAsText opts (_,items) = unlines $ map (postingsReportItemAsText op itemamt (_,_,_,Posting{pamount=a},_) = a itembal (_,_,_,_,a) = a -tests_postingsReportAsText = [ - "postingsReportAsText" ~: do - -- "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) `is` unlines - ["2009/01/01 медвежья шкура расходы:покупки 100 100" - ," актив:наличные -100 0"] - ] - -- | Render one register report line item as plain text. Layout is like so: -- @ -- <---------------- width (specified, terminal width, or 80) --------------------> @@ -200,5 +189,20 @@ postingsReportItemAsText opts preferredamtwidth preferredbalwidth (mdate, mendda (balfirstline:balrest) = take numlines $ replicate (numlines - ballen) "" ++ ballines -- balance amount is bottom-aligned spacer = replicate (totalwidth - (amtwidth + 2 + balwidth)) ' ' -tests_Hledger_Cli_Commands_Register = TestList - tests_postingsReportAsText +-- tests + +is :: (Eq a, Show a, HasCallStack) => a -> a -> Test () +is = flip expectEq' + +easytests_Register = tests "Register" [ + + tests "postingsReportAsText" [ + test "unicode in register layout" $ do + j <- io $ readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n" + let opts = defreportopts + (postingsReportAsText defcliopts $ postingsReport opts (queryFromOpts (parsedate "2008/11/26") opts) j) `is` unlines + ["2009/01/01 медвежья шкура расходы:покупки 100 100" + ," актив:наличные -100 0"] + ] + + ]