tests: Cli -> easytest

2018-09-04 12:42:37 -07:00 · 2018-09-04 12:42:37 -07:00 · 807e6dc4af
commit 807e6dc4af
parent 7370f2a553
4 changed files with 91 additions and 75 deletions
--- 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
+easytests_Cli = tests "Cli" [
+   easytests_Hledger
+  ,easytests_Commands
+ ]
--- 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,27 +246,30 @@ 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
+    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" <>
@ -279,42 +283,45 @@ tests_Hledger_Cli_Commands = TestList [
      "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 [

 ]

--- 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"
+        ]
+  ]
+
+ ]
--- 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"]
+   ]
+
+ ]