tests: Cli -> easytest
This commit is contained in:
Simon Michael
parent
7370f2a553
commit
807e6dc4af
@ -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
|
||||
]
|
||||
|
||||
@ -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 [
|
||||
|
||||
]
|
||||
|
||||
|
||||
@ -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"
|
||||
]
|
||||
]
|
||||
|
||||
]
|
||||
|
||||
@ -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"]
|
||||
]
|
||||
|
||||
]
|
||||
|
||||
Loading…
Reference in New Issue
Block a user