mirror of
https://github.com/simonmichael/hledger.git
synced 2024-12-26 03:42:25 +03:00
tests: port all unit tests to tasty, first cut (#1090)
easytest is not actively maintained and requires an old version of hedgehog which does not support base-compat 0.11 & ghc 8.8. This is still using the old easytest helpers, and not displaying test names properly.
This commit is contained in:
parent
8952dc9a93
commit
13a3542464
@ -1324,16 +1324,16 @@ tests_Journal = tests "Journal" [
|
||||
|
||||
,tests "journalBalanceTransactions" [
|
||||
|
||||
test "balance-assignment" $ do
|
||||
test "balance-assignment" $ testCaseSteps "sometests" $ \_step -> do
|
||||
let ej = journalBalanceTransactions True $
|
||||
--2019/01/01
|
||||
-- (a) = 1
|
||||
nulljournal{ jtxns = [
|
||||
transaction "2019/01/01" [ vpost' "a" missingamt (balassert (num 1)) ]
|
||||
]}
|
||||
expectRight ej
|
||||
assertRight ej
|
||||
let Right j = ej
|
||||
(jtxns j & head & tpostings & head & pamount) `is` Mixed [num 1]
|
||||
(jtxns j & head & tpostings & head & pamount) @?= Mixed [num 1]
|
||||
|
||||
,test "same-day-1" $ do
|
||||
expectRight $ journalBalanceTransactions True $
|
||||
|
@ -18,7 +18,7 @@ import "base-compat-batteries" Prelude.Compat
|
||||
import Numeric
|
||||
import Data.Char (isPrint)
|
||||
import Data.Maybe
|
||||
import qualified Data.Text as T
|
||||
-- import qualified Data.Text as T
|
||||
import Text.Megaparsec
|
||||
import Text.Megaparsec.Char
|
||||
|
||||
@ -157,7 +157,7 @@ tests_StringFormat = tests "StringFormat" [
|
||||
]
|
||||
|
||||
,tests "parseStringFormat" $
|
||||
let s `gives` expected = test (T.pack s) $ parseStringFormat s `is` Right expected
|
||||
let s `gives` expected = test s $ parseStringFormat s `is` Right expected
|
||||
in [
|
||||
"" `gives` (defaultStringFormatStyle [])
|
||||
, "D" `gives` (defaultStringFormatStyle [FormatLiteral "D"])
|
||||
|
@ -115,32 +115,31 @@ entryFromTimeclockInOut i o
|
||||
-- tests
|
||||
|
||||
tests_Timeclock = tests "Timeclock" [
|
||||
do
|
||||
today <- io getCurrentDay
|
||||
now' <- io getCurrentTime
|
||||
tz <- io getCurrentTimeZone
|
||||
let now = utcToLocalTime tz now'
|
||||
nowstr = showtime now
|
||||
yesterday = prevday today
|
||||
clockin = TimeclockEntry nullsourcepos In
|
||||
mktime d = LocalTime d . fromMaybe midnight .
|
||||
testCaseSteps "timeclockEntriesToTransactions tests" $ \step -> do
|
||||
step "gathering data"
|
||||
today <- getCurrentDay
|
||||
now' <- getCurrentTime
|
||||
tz <- getCurrentTimeZone
|
||||
let now = utcToLocalTime tz now'
|
||||
nowstr = showtime now
|
||||
yesterday = prevday today
|
||||
clockin = TimeclockEntry nullsourcepos In
|
||||
mktime d = LocalTime d . fromMaybe midnight .
|
||||
#if MIN_VERSION_time(1,5,0)
|
||||
parseTimeM True defaultTimeLocale "%H:%M:%S"
|
||||
parseTimeM True defaultTimeLocale "%H:%M:%S"
|
||||
#else
|
||||
parseTime defaultTimeLocale "%H:%M:%S"
|
||||
parseTime defaultTimeLocale "%H:%M:%S"
|
||||
#endif
|
||||
showtime = formatTime defaultTimeLocale "%H:%M"
|
||||
txndescs = map (T.unpack . tdescription) . timeclockEntriesToTransactions now
|
||||
future = utcToLocalTime tz $ addUTCTime 100 now'
|
||||
futurestr = showtime future
|
||||
tests "timeclockEntriesToTransactions" [
|
||||
test "started yesterday, split session at midnight" $
|
||||
txndescs [clockin (mktime yesterday "23:00:00") "" ""] `is` ["23:00-23:59","00:00-"++nowstr]
|
||||
,test "split multi-day sessions at each midnight" $
|
||||
txndescs [clockin (mktime (addDays (-2) today) "23:00:00") "" ""] `is `["23:00-23:59","00:00-23:59","00:00-"++nowstr]
|
||||
,test "auto-clock-out if needed" $
|
||||
txndescs [clockin (mktime today "00:00:00") "" ""] `is` ["00:00-"++nowstr]
|
||||
,test "use the clockin time for auto-clockout if it's in the future" $
|
||||
txndescs [clockin future "" ""] `is` [printf "%s-%s" futurestr futurestr]
|
||||
]
|
||||
showtime = formatTime defaultTimeLocale "%H:%M"
|
||||
txndescs = map (T.unpack . tdescription) . timeclockEntriesToTransactions now
|
||||
future = utcToLocalTime tz $ addUTCTime 100 now'
|
||||
futurestr = showtime future
|
||||
step "started yesterday, split session at midnight"
|
||||
txndescs [clockin (mktime yesterday "23:00:00") "" ""] @?= ["23:00-23:59","00:00-"++nowstr]
|
||||
step "split multi-day sessions at each midnight"
|
||||
txndescs [clockin (mktime (addDays (-2) today) "23:00:00") "" ""] @?= ["23:00-23:59","00:00-23:59","00:00-"++nowstr]
|
||||
step "auto-clock-out if needed"
|
||||
txndescs [clockin (mktime today "00:00:00") "" ""] @?= ["00:00-"++nowstr]
|
||||
step "use the clockin time for auto-clockout if it's in the future"
|
||||
txndescs [clockin future "" ""] @?= [printf "%s-%s" futurestr futurestr]
|
||||
]
|
||||
|
@ -596,7 +596,7 @@ tests_Transaction =
|
||||
-- one missing amount, not the last one
|
||||
t3 = nulltransaction {tpostings = ["a" `post` usd 1, "b" `post` missingamt, "c" `post` usd (-1)]}
|
||||
-- unbalanced amounts when precision is limited (#931)
|
||||
t4 = nulltransaction {tpostings = ["a" `post` usd (-0.01), "b" `post` usd (0.005), "c" `post` usd (0.005)]}
|
||||
-- t4 = nulltransaction {tpostings = ["a" `post` usd (-0.01), "b" `post` usd (0.005), "c" `post` usd (0.005)]}
|
||||
in tests
|
||||
"postingsAsLines"
|
||||
[ test "null-transaction" $
|
||||
@ -635,10 +635,11 @@ tests_Transaction =
|
||||
let t = t3
|
||||
in postingsAsLines False (tpostings t) `is`
|
||||
[" a $1.00", " b", " c $-1.00"]
|
||||
, _test "ensure-visibly-balanced" $
|
||||
let t = t4
|
||||
in postingsAsLines False (tpostings t) `is`
|
||||
[" a $-0.01", " b $0.005", " c $0.005"]
|
||||
-- , _test "ensure-visibly-balanced" $
|
||||
-- let t = t4
|
||||
-- in postingsAsLines False (tpostings t) `is`
|
||||
-- [" a $-0.01", " b $0.005", " c $0.005"]
|
||||
|
||||
]
|
||||
, tests
|
||||
"inferBalancingAmount"
|
||||
|
@ -723,7 +723,7 @@ tests_Query = tests "Query" [
|
||||
,parseAmountQueryTerm "0.23" `is` (AbsEq,0.23)
|
||||
,parseAmountQueryTerm "<=+0.23" `is` (LtEq,0.23)
|
||||
,parseAmountQueryTerm "-0.23" `is` (Eq,(-0.23))
|
||||
,_test "number beginning with decimal mark" $ parseAmountQueryTerm "=.23" `is` (AbsEq,0.23) -- XXX
|
||||
-- ,_test "number beginning with decimal mark" $ parseAmountQueryTerm "=.23" `is` (AbsEq,0.23) -- XXX
|
||||
]
|
||||
|
||||
,tests "matchesAccount" [
|
||||
|
@ -1363,7 +1363,7 @@ tests_Common = tests "Common" [
|
||||
,tests "spaceandamountormissingp" [
|
||||
test "space and amount" $ expectParseEq spaceandamountormissingp " $47.18" (Mixed [usd 47.18])
|
||||
,test "empty string" $ expectParseEq spaceandamountormissingp "" missingmixedamt
|
||||
,_test "just space" $ expectParseEq spaceandamountormissingp " " missingmixedamt -- XXX should it ?
|
||||
-- ,_test "just space" $ expectParseEq spaceandamountormissingp " " missingmixedamt -- XXX should it ?
|
||||
-- ,test "just amount" $ expectParseError spaceandamountormissingp "$47.18" "" -- succeeds, consuming nothing
|
||||
]
|
||||
|
||||
|
@ -63,8 +63,8 @@ module Hledger.Read.JournalReader (
|
||||
)
|
||||
where
|
||||
--- * imports
|
||||
import qualified Prelude (fail)
|
||||
import "base-compat-batteries" Prelude.Compat hiding (fail, readFile)
|
||||
-- import qualified Prelude (fail)
|
||||
-- import "base-compat-batteries" Prelude.Compat hiding (fail, readFile)
|
||||
import qualified "base-compat-batteries" Control.Monad.Fail.Compat as Fail (fail)
|
||||
import qualified Control.Exception as C
|
||||
import Control.Monad (forM_, when, void)
|
||||
@ -668,41 +668,43 @@ tests_JournalReader = tests "JournalReader" [
|
||||
let p = lift accountnamep :: JournalParser IO AccountName in
|
||||
tests "accountnamep" [
|
||||
test "basic" $ expectParse p "a:b:c"
|
||||
,_test "empty inner component" $ expectParseError p "a::c" "" -- TODO
|
||||
,_test "empty leading component" $ expectParseError p ":b:c" "x"
|
||||
,_test "empty trailing component" $ expectParseError p "a:b:" "x"
|
||||
-- ,_test "empty inner component" $ expectParseError p "a::c" "" -- TODO
|
||||
-- ,_test "empty leading component" $ expectParseError p ":b:c" "x"
|
||||
-- ,_test "empty trailing component" $ expectParseError p "a:b:" "x"
|
||||
]
|
||||
|
||||
-- "Parse a date in YYYY/MM/DD format.
|
||||
-- Hyphen (-) and period (.) are also allowed as separators.
|
||||
-- The year may be omitted if a default year has been set.
|
||||
-- Leading zeroes may be omitted."
|
||||
,test "datep" $ do
|
||||
test "YYYY/MM/DD" $ expectParseEq datep "2018/01/01" (fromGregorian 2018 1 1)
|
||||
test "YYYY-MM-DD" $ expectParse datep "2018-01-01"
|
||||
test "YYYY.MM.DD" $ expectParse datep "2018.01.01"
|
||||
test "yearless date with no default year" $ expectParseError datep "1/1" "current year is unknown"
|
||||
test "yearless date with default year" $ do
|
||||
,tests "datep" [
|
||||
test "YYYY/MM/DD" $ expectParseEq datep "2018/01/01" (fromGregorian 2018 1 1)
|
||||
,test "YYYY-MM-DD" $ expectParse datep "2018-01-01"
|
||||
,test "YYYY.MM.DD" $ expectParse datep "2018.01.01"
|
||||
,test "yearless date with no default year" $ expectParseError datep "1/1" "current year is unknown"
|
||||
,testCaseSteps "yearless date with default year" $ \_step -> do
|
||||
let s = "1/1"
|
||||
ep <- parseWithState mempty{jparsedefaultyear=Just 2018} datep s
|
||||
either (Prelude.fail . ("parse error at "++) . customErrorBundlePretty) (const ok) ep
|
||||
test "no leading zero" $ expectParse datep "2018/1/1"
|
||||
|
||||
,test "datetimep" $ do
|
||||
let
|
||||
good = expectParse datetimep
|
||||
bad = (\t -> expectParseError datetimep t "")
|
||||
good "2011/1/1 00:00"
|
||||
good "2011/1/1 23:59:59"
|
||||
bad "2011/1/1"
|
||||
bad "2011/1/1 24:00:00"
|
||||
bad "2011/1/1 00:60:00"
|
||||
bad "2011/1/1 00:00:60"
|
||||
bad "2011/1/1 3:5:7"
|
||||
test "timezone is parsed but ignored" $ do
|
||||
let t = LocalTime (fromGregorian 2018 1 1) (TimeOfDay 0 0 (fromIntegral 0))
|
||||
expectParseEq datetimep "2018/1/1 00:00-0800" t
|
||||
expectParseEq datetimep "2018/1/1 00:00+1234" t
|
||||
either (assertFailure . ("parse error at "++) . customErrorBundlePretty) (const $ return ()) ep
|
||||
,test "no leading zero" $ expectParse datep "2018/1/1"
|
||||
]
|
||||
,let
|
||||
good = expectParse datetimep
|
||||
bad = (\t -> expectParseError datetimep t "")
|
||||
in tests "datetimep" [
|
||||
good "2011/1/1 00:00"
|
||||
,good "2011/1/1 23:59:59"
|
||||
,bad "2011/1/1"
|
||||
,bad "2011/1/1 24:00:00"
|
||||
,bad "2011/1/1 00:60:00"
|
||||
,bad "2011/1/1 00:00:60"
|
||||
,bad "2011/1/1 3:5:7"
|
||||
,let t = LocalTime (fromGregorian 2018 1 1) (TimeOfDay 0 0 (fromIntegral 0))
|
||||
in tests "timezone is parsed but ignored" [
|
||||
expectParseEq datetimep "2018/1/1 00:00-0800" t
|
||||
,expectParseEq datetimep "2018/1/1 00:00+1234" t
|
||||
]
|
||||
]
|
||||
|
||||
,tests "periodictransactionp" [
|
||||
|
||||
@ -883,41 +885,46 @@ tests_JournalReader = tests "JournalReader" [
|
||||
-- directives
|
||||
|
||||
,tests "directivep" [
|
||||
test "supports !" $ do
|
||||
expectParseE directivep "!account a\n"
|
||||
expectParseE directivep "!D 1.0\n"
|
||||
tests "supports !" [
|
||||
expectParseE directivep "!account a\n"
|
||||
,expectParseE directivep "!D 1.0\n"
|
||||
]
|
||||
]
|
||||
|
||||
,test "accountdirectivep" $ do
|
||||
test "with-comment" $ expectParse accountdirectivep "account a:b ; a comment\n"
|
||||
test "does-not-support-!" $ expectParseError accountdirectivep "!account a:b\n" ""
|
||||
test "account-type-code" $ expectParse accountdirectivep "account a:b A\n"
|
||||
test "account-type-tag" $ expectParseStateOn accountdirectivep "account a:b ; type:asset\n"
|
||||
jdeclaredaccounts
|
||||
[("a:b", AccountDeclarationInfo{adicomment = "type:asset\n"
|
||||
,aditags = [("type","asset")]
|
||||
,adideclarationorder = 1
|
||||
})
|
||||
,tests "accountdirectivep" [
|
||||
test "with-comment" $ expectParse accountdirectivep "account a:b ; a comment\n"
|
||||
,test "does-not-support-!" $ expectParseError accountdirectivep "!account a:b\n" ""
|
||||
,test "account-type-code" $ expectParse accountdirectivep "account a:b A\n"
|
||||
,test "account-type-tag" $ expectParseStateOn accountdirectivep "account a:b ; type:asset\n"
|
||||
jdeclaredaccounts
|
||||
[("a:b", AccountDeclarationInfo{adicomment = "type:asset\n"
|
||||
,aditags = [("type","asset")]
|
||||
,adideclarationorder = 1
|
||||
})
|
||||
]
|
||||
]
|
||||
|
||||
,test "commodityconversiondirectivep" $ do
|
||||
expectParse commodityconversiondirectivep "C 1h = $50.00\n"
|
||||
|
||||
,test "defaultcommoditydirectivep" $ do
|
||||
expectParse defaultcommoditydirectivep "D $1,000.0\n"
|
||||
expectParseError defaultcommoditydirectivep "D $1000\n" "please include a decimal separator"
|
||||
,tests "defaultcommoditydirectivep" [
|
||||
expectParse defaultcommoditydirectivep "D $1,000.0\n"
|
||||
,expectParseError defaultcommoditydirectivep "D $1000\n" "please include a decimal separator"
|
||||
]
|
||||
|
||||
,test "defaultyeardirectivep" $ do
|
||||
test "1000" $ expectParse defaultyeardirectivep "Y 1000" -- XXX no \n like the others
|
||||
test "999" $ expectParseError defaultyeardirectivep "Y 999" "bad year number"
|
||||
test "12345" $ expectParse defaultyeardirectivep "Y 12345"
|
||||
,tests "defaultyeardirectivep" [
|
||||
test "1000" $ expectParse defaultyeardirectivep "Y 1000" -- XXX no \n like the others
|
||||
,test "999" $ expectParseError defaultyeardirectivep "Y 999" "bad year number"
|
||||
,test "12345" $ expectParse defaultyeardirectivep "Y 12345"
|
||||
]
|
||||
|
||||
,test "ignoredpricecommoditydirectivep" $ do
|
||||
expectParse ignoredpricecommoditydirectivep "N $\n"
|
||||
|
||||
,test "includedirectivep" $ do
|
||||
test "include" $ expectParseErrorE includedirectivep "include nosuchfile\n" "No existing files match pattern: nosuchfile"
|
||||
test "glob" $ expectParseErrorE includedirectivep "include nosuchfile*\n" "No existing files match pattern: nosuchfile*"
|
||||
,tests "includedirectivep" [
|
||||
test "include" $ expectParseErrorE includedirectivep "include nosuchfile\n" "No existing files match pattern: nosuchfile"
|
||||
,test "glob" $ expectParseErrorE includedirectivep "include nosuchfile*\n" "No existing files match pattern: nosuchfile*"
|
||||
]
|
||||
|
||||
,test "marketpricedirectivep" $ expectParseEq marketpricedirectivep
|
||||
"P 2017/01/30 BTC $922.83\n"
|
||||
@ -930,10 +937,10 @@ tests_JournalReader = tests "JournalReader" [
|
||||
,test "tagdirectivep" $ do
|
||||
expectParse tagdirectivep "tag foo \n"
|
||||
|
||||
,test "endtagdirectivep" $ do
|
||||
expectParse endtagdirectivep "end tag \n"
|
||||
expectParse endtagdirectivep "pop \n"
|
||||
|
||||
,tests "endtagdirectivep" [
|
||||
expectParse endtagdirectivep "end tag \n"
|
||||
,expectParse endtagdirectivep "pop \n"
|
||||
]
|
||||
|
||||
,tests "journalp" [
|
||||
test "empty file" $ expectParseEqE journalp "" nulljournal
|
||||
@ -941,10 +948,10 @@ tests_JournalReader = tests "JournalReader" [
|
||||
|
||||
-- these are defined here rather than in Common so they can use journalp
|
||||
,tests "parseAndFinaliseJournal" [
|
||||
test "basic" $ do
|
||||
ej <- io $ runExceptT $ parseAndFinaliseJournal journalp definputopts "" "2019-1-1\n"
|
||||
testCaseSteps "basic" $ \_step -> do
|
||||
ej <- runExceptT $ parseAndFinaliseJournal journalp definputopts "" "2019-1-1\n"
|
||||
let Right j = ej
|
||||
expectEqPP [""] $ journalFilePaths j
|
||||
assertEq [""] $ journalFilePaths j
|
||||
]
|
||||
|
||||
]
|
||||
|
@ -248,16 +248,15 @@ Right samplejournal2 =
|
||||
}
|
||||
|
||||
tests_BalanceReport = tests "BalanceReport" [
|
||||
tests "balanceReport" $
|
||||
let
|
||||
(opts,journal) `gives` r = do
|
||||
let (eitems, etotal) = r
|
||||
(aitems, atotal) = balanceReport opts (queryFromOpts nulldate opts) journal
|
||||
showw (acct,acct',indent,amt) = (acct, acct', indent, showMixedAmountDebug amt)
|
||||
(map showw eitems) `is` (map showw aitems)
|
||||
(showMixedAmountDebug etotal) `is` (showMixedAmountDebug atotal)
|
||||
usd0 = usd 0
|
||||
in [
|
||||
let
|
||||
(opts,journal) `gives` r = testCaseSteps "sometest" $ \_step -> do
|
||||
let (eitems, etotal) = r
|
||||
(aitems, atotal) = balanceReport opts (queryFromOpts nulldate opts) journal
|
||||
showw (acct,acct',indent,amt) = (acct, acct', indent, showMixedAmountDebug amt)
|
||||
(map showw eitems) @?= (map showw aitems)
|
||||
(showMixedAmountDebug etotal) @?= (showMixedAmountDebug atotal)
|
||||
usd0 = usd 0
|
||||
in tests "balanceReport" [
|
||||
|
||||
test "balanceReport with no args on null journal" $
|
||||
(defreportopts, nulljournal) `gives` ([], Mixed [nullamt])
|
||||
|
@ -417,13 +417,13 @@ tableAsText (ReportOpts{pretty_tables_ = pretty}) showcell =
|
||||
|
||||
tests_MultiBalanceReport = tests "MultiBalanceReport" [
|
||||
let
|
||||
(opts,journal) `gives` r = do
|
||||
(opts,journal) `gives` r = testCaseSteps "sometest" $ \_step -> do
|
||||
let (eitems, etotal) = r
|
||||
(MultiBalanceReport (_, aitems, atotal)) = multiBalanceReport opts (queryFromOpts nulldate opts) journal
|
||||
showw (acct,acct',indent,lAmt,amt,amt') = (acct, acct', indent, map showMixedAmountDebug lAmt, showMixedAmountDebug amt, showMixedAmountDebug amt')
|
||||
(map showw aitems) `is` (map showw eitems)
|
||||
((\(_, b, _) -> showMixedAmountDebug b) atotal) `is` (showMixedAmountDebug etotal) -- we only check the sum of the totals
|
||||
usd0 = usd 0
|
||||
(map showw aitems) @?= (map showw eitems)
|
||||
((\(_, b, _) -> showMixedAmountDebug b) atotal) @?= (showMixedAmountDebug etotal) -- we only check the sum of the totals
|
||||
-- usd0 = usd 0
|
||||
amount0 = Amount {acommodity="$", aquantity=0, aprice=Nothing, astyle=AmountStyle {ascommodityside = L, ascommodityspaced = False, asprecision = 2, asdecimalpoint = Just '.', asdigitgroups = Nothing}, aismultiplier=False}
|
||||
in
|
||||
tests "multiBalanceReport" [
|
||||
@ -439,27 +439,27 @@ tests_MultiBalanceReport = tests "MultiBalanceReport" [
|
||||
],
|
||||
Mixed [nullamt])
|
||||
|
||||
,_test "a valid history on an empty period" $
|
||||
(defreportopts{period_= PeriodBetween (fromGregorian 2008 1 2) (fromGregorian 2008 1 3), balancetype_=HistoricalBalance}, samplejournal) `gives`
|
||||
(
|
||||
[
|
||||
("assets:bank:checking","checking",3, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amount0 {aquantity=1}])
|
||||
,("income:salary","salary",2, [mamountp' "$-1.00"], mamountp' "$-1.00",Mixed [amount0 {aquantity=(-1)}])
|
||||
],
|
||||
Mixed [usd0])
|
||||
-- ,_test "a valid history on an empty period" $
|
||||
-- (defreportopts{period_= PeriodBetween (fromGregorian 2008 1 2) (fromGregorian 2008 1 3), balancetype_=HistoricalBalance}, samplejournal) `gives`
|
||||
-- (
|
||||
-- [
|
||||
-- ("assets:bank:checking","checking",3, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amount0 {aquantity=1}])
|
||||
-- ,("income:salary","salary",2, [mamountp' "$-1.00"], mamountp' "$-1.00",Mixed [amount0 {aquantity=(-1)}])
|
||||
-- ],
|
||||
-- Mixed [usd0])
|
||||
|
||||
,_test "a valid history on an empty period (more complex)" $
|
||||
(defreportopts{period_= PeriodBetween (fromGregorian 2009 1 1) (fromGregorian 2009 1 2), balancetype_=HistoricalBalance}, samplejournal) `gives`
|
||||
(
|
||||
[
|
||||
("assets:bank:checking","checking",3, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amount0 {aquantity=1}])
|
||||
,("assets:bank:saving","saving",3, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amount0 {aquantity=1}])
|
||||
,("assets:cash","cash",2, [mamountp' "$-2.00"], mamountp' "$-2.00",Mixed [amount0 {aquantity=(-2)}])
|
||||
,("expenses:food","food",2, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amount0 {aquantity=(1)}])
|
||||
,("expenses:supplies","supplies",2, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amount0 {aquantity=(1)}])
|
||||
,("income:gifts","gifts",2, [mamountp' "$-1.00"], mamountp' "$-1.00",Mixed [amount0 {aquantity=(-1)}])
|
||||
,("income:salary","salary",2, [mamountp' "$-1.00"], mamountp' "$-1.00",Mixed [amount0 {aquantity=(-1)}])
|
||||
],
|
||||
Mixed [usd0])
|
||||
-- ,_test "a valid history on an empty period (more complex)" $
|
||||
-- (defreportopts{period_= PeriodBetween (fromGregorian 2009 1 1) (fromGregorian 2009 1 2), balancetype_=HistoricalBalance}, samplejournal) `gives`
|
||||
-- (
|
||||
-- [
|
||||
-- ("assets:bank:checking","checking",3, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amount0 {aquantity=1}])
|
||||
-- ,("assets:bank:saving","saving",3, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amount0 {aquantity=1}])
|
||||
-- ,("assets:cash","cash",2, [mamountp' "$-2.00"], mamountp' "$-2.00",Mixed [amount0 {aquantity=(-2)}])
|
||||
-- ,("expenses:food","food",2, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amount0 {aquantity=(1)}])
|
||||
-- ,("expenses:supplies","supplies",2, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amount0 {aquantity=(1)}])
|
||||
-- ,("income:gifts","gifts",2, [mamountp' "$-1.00"], mamountp' "$-1.00",Mixed [amount0 {aquantity=(-1)}])
|
||||
-- ,("income:salary","salary",2, [mamountp' "$-1.00"], mamountp' "$-1.00",Mixed [amount0 {aquantity=(-1)}])
|
||||
-- ],
|
||||
-- Mixed [usd0])
|
||||
]
|
||||
]
|
||||
|
@ -4,229 +4,225 @@
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
|
||||
module Hledger.Utils.Test (
|
||||
HasCallStack
|
||||
,module EasyTest
|
||||
,runEasytests
|
||||
module Test.Tasty
|
||||
,module Test.Tasty.HUnit
|
||||
-- ,module QC
|
||||
-- ,module SC
|
||||
,tests
|
||||
,_tests
|
||||
,test
|
||||
,_test
|
||||
,it
|
||||
,_it
|
||||
,is
|
||||
,expectEqPP
|
||||
,expect
|
||||
,assertEq
|
||||
,expectEq
|
||||
,assertLeft
|
||||
,expectLeft
|
||||
,assertRight
|
||||
,expectRight
|
||||
,expectParse
|
||||
,expectParseE
|
||||
,expectParseError
|
||||
,expectParseErrorE
|
||||
,expectParseEq
|
||||
,expectParseEqE
|
||||
,expectParseEqOn
|
||||
,expectParseEqOnE
|
||||
,expectParseError
|
||||
,expectParseE
|
||||
,expectParseEqE
|
||||
,expectParseErrorE
|
||||
,expectParseStateOn
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Exception
|
||||
import Test.Tasty
|
||||
import Test.Tasty.HUnit
|
||||
-- import Test.Tasty.QuickCheck as QC
|
||||
-- import Test.Tasty.SmallCheck as SC
|
||||
|
||||
import Control.Monad.Except (ExceptT, runExceptT)
|
||||
import Control.Monad.State.Strict (StateT, evalStateT, execStateT)
|
||||
#if !(MIN_VERSION_base(4,11,0))
|
||||
import Data.Monoid ((<>))
|
||||
#endif
|
||||
import Data.CallStack
|
||||
import Data.List
|
||||
-- #if !(MIN_VERSION_base(4,11,0))
|
||||
-- import Data.Monoid ((<>))
|
||||
-- #endif
|
||||
-- import Data.CallStack
|
||||
import Data.List (isInfixOf)
|
||||
import qualified Data.Text as T
|
||||
import Safe
|
||||
import System.Exit
|
||||
import Text.Megaparsec
|
||||
import Text.Megaparsec.Custom
|
||||
|
||||
import EasyTest hiding (char, char', tests) -- reexported
|
||||
import qualified EasyTest as E -- used here
|
||||
|
||||
import Hledger.Utils.Debug (pshow)
|
||||
import Hledger.Utils.UTF8IOCompat (error')
|
||||
-- import Hledger.Utils.UTF8IOCompat (error')
|
||||
|
||||
-- * easytest helpers
|
||||
-- * tasty helpers
|
||||
|
||||
-- | Name the given test(s). A readability synonym for easytest's "scope".
|
||||
test :: T.Text -> E.Test a -> E.Test a
|
||||
test = E.scope
|
||||
-- | Name and group a list of tests.
|
||||
tests :: String -> [TestTree] -> TestTree
|
||||
tests = testGroup
|
||||
|
||||
-- | Name the given test(s).
|
||||
-- test :: T.Text -> E.Test a -> E.Test a
|
||||
-- test :: String -> Assertion -> TestTree
|
||||
test :: String -> TestTree -> TestTree
|
||||
test _name = id
|
||||
|
||||
-- | Skip the given test(s), with the same type signature as "test".
|
||||
-- If called in a monadic sequence of tests, also skips following tests.
|
||||
_test :: T.Text -> E.Test a -> E.Test a
|
||||
_test _name = (E.skip >>)
|
||||
-- If called in a monadic sequence of tests, also skips following tests. (?)
|
||||
-- _test :: T.Text -> E.Test a -> E.Test a
|
||||
-- _test _name = (E.skip >>)
|
||||
|
||||
-- | Name the given test(s). A synonym for "test".
|
||||
it :: T.Text -> E.Test a -> E.Test a
|
||||
it = test
|
||||
-- | Short equality test constructor. Actual value on the left, expected on the right.
|
||||
is :: (Eq a, Show a, HasCallStack) => a -> a -> TestTree
|
||||
is actual expected = testCase "sometest" $ actual @?= expected
|
||||
|
||||
-- | Skip the given test(s), and any following tests in a monadic sequence.
|
||||
-- A synonym for "_test".
|
||||
_it :: T.Text -> E.Test a -> E.Test a
|
||||
_it = _test
|
||||
-- | Expect True.
|
||||
expect :: HasCallStack => Bool -> TestTree
|
||||
expect val = testCase "sometest" $ assertBool "was false" val
|
||||
|
||||
-- | Name and group a list of tests. Combines easytest's "scope" and "tests".
|
||||
tests :: T.Text -> [E.Test ()] -> E.Test ()
|
||||
tests name = E.scope name . E.tests
|
||||
-- | Assert equality. Expected first, actual second.
|
||||
assertEq :: (HasCallStack, Eq a, Show a) => a -> a -> Assertion
|
||||
assertEq expected actual = assertEqual "was not equal" expected actual
|
||||
|
||||
-- | Skip the given list of tests, and any following tests in a monadic sequence,
|
||||
-- with the same type signature as "group".
|
||||
_tests :: T.Text -> [E.Test ()] -> E.Test ()
|
||||
_tests _name = (E.skip >>) . E.tests
|
||||
-- | Test for equality. Expected first, actual second.
|
||||
expectEq :: (HasCallStack, Eq a, Show a) => a -> a -> TestTree
|
||||
expectEq a b = testCase "sometest" $ assertEq a b
|
||||
|
||||
-- | Run some easytest tests, catching easytest's ExitCode exception,
|
||||
-- returning True if there was a problem.
|
||||
-- With arguments, runs only the scope (or single test) named by the first argument
|
||||
-- (exact, case sensitive).
|
||||
-- If there is a second argument, it should be an integer and will be used
|
||||
-- as the seed for randomness.
|
||||
runEasytests :: [String] -> E.Test () -> IO Bool
|
||||
runEasytests args tests = (do
|
||||
case args of
|
||||
[] -> E.run tests
|
||||
[a] -> E.runOnly (T.pack a) tests
|
||||
a:b:_ -> do
|
||||
case readMay b :: Maybe Int of
|
||||
Nothing -> error' "the second argument should be an integer (a seed for easytest)"
|
||||
Just seed -> E.rerunOnly seed (T.pack a) tests
|
||||
return False
|
||||
)
|
||||
`catch` (\(_::ExitCode) -> return True)
|
||||
-- | Assert any Left value.
|
||||
assertLeft :: (HasCallStack, Eq b, Show b) => Either a b -> Assertion
|
||||
assertLeft (Left _) = return ()
|
||||
assertLeft (Right b) = assertFailure $ "expected Left, got (Right " ++ show b ++ ")"
|
||||
|
||||
-- | Like easytest's expectEq (asserts the second (actual) value equals the first (expected) value)
|
||||
-- but pretty-prints the values in the failure output.
|
||||
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"
|
||||
-- | Test for any Left value.
|
||||
expectLeft :: (HasCallStack, Eq a, Show a) => Either e a -> TestTree
|
||||
expectLeft = testCase "sometest" . assertLeft
|
||||
|
||||
-- | Shorter and flipped version of expectEqPP. The expected value goes last.
|
||||
is :: (Eq a, Show a, HasCallStack) => a -> a -> Test ()
|
||||
is = flip expectEqPP
|
||||
-- | Assert any Right value.
|
||||
assertRight :: (HasCallStack, Eq a, Show a) => Either a b -> Assertion
|
||||
assertRight (Right _) = return ()
|
||||
assertRight (Left a) = assertFailure $ "expected Right, got (Left " ++ show a ++ ")"
|
||||
|
||||
-- | Test for any Right value.
|
||||
expectRight :: (HasCallStack, Eq a, Show a) => Either a b -> TestTree
|
||||
expectRight = testCase "sometest" . assertRight
|
||||
|
||||
-- | 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.
|
||||
expectParse :: (Monoid st, Eq a, Show a, HasCallStack) =>
|
||||
StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> E.Test ()
|
||||
expectParse parser input = do
|
||||
ep <- E.io (runParserT (evalStateT (parser <* eof) mempty) "" input)
|
||||
either (fail.(++"\n").("\nparse error at "++).customErrorBundlePretty)
|
||||
(const ok)
|
||||
-- expectParse :: (Monoid st, Eq a, Show a, HasCallStack) =>
|
||||
-- StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> E.Test ()
|
||||
expectParse :: (HasCallStack, Eq a, Show a, Monoid st) =>
|
||||
StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> TestTree
|
||||
expectParse parser input = testCaseSteps "sometest" $ \_step -> do
|
||||
ep <- runParserT (evalStateT (parser <* eof) mempty) "" input
|
||||
either (assertFailure.(++"\n").("\nparse error at "++).customErrorBundlePretty)
|
||||
(const $ return ())
|
||||
ep
|
||||
|
||||
-- -- pretty-printing both if it fails.
|
||||
-- | Like expectParse, but also test the parse result is an expected value.
|
||||
expectParseEq :: (HasCallStack, Eq a, Show a, Monoid st) =>
|
||||
StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> a -> TestTree
|
||||
expectParseEq parser input expected = expectParseEqOn parser input id expected
|
||||
|
||||
-- | Like expectParseEq, but transform the parse result with the given function
|
||||
-- before comparing it.
|
||||
expectParseEqOn :: (HasCallStack, Eq b, Show b, Monoid st) =>
|
||||
StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> (a -> b) -> b -> TestTree
|
||||
expectParseEqOn parser input f expected = testCaseSteps "sometest" $ \_step -> do
|
||||
ep <- runParserT (evalStateT (parser <* eof) mempty) "" input
|
||||
either (assertFailure . (++"\n") . ("\nparse error at "++) . customErrorBundlePretty)
|
||||
(assertEq expected . f)
|
||||
ep
|
||||
|
||||
-- | Test that this stateful parser runnable in IO fails to parse
|
||||
-- the given input text, with a parse error containing the given string.
|
||||
expectParseError :: (HasCallStack, Eq a, Show a, Monoid st) =>
|
||||
StateT st (ParsecT CustomErr T.Text IO) a -> String -> String -> TestTree
|
||||
expectParseError parser input errstr = testCaseSteps "sometest" $ \_step -> do
|
||||
ep <- runParserT (evalStateT parser mempty) "" (T.pack input)
|
||||
case ep of
|
||||
Right v -> assertFailure $ "\nparse succeeded unexpectedly, producing:\n" ++ pshow v ++ "\n"
|
||||
Left e -> do
|
||||
let e' = customErrorBundlePretty e
|
||||
if errstr `isInfixOf` e'
|
||||
then return ()
|
||||
else assertFailure $ "\nparse error is not as expected:\n" ++ e' ++ "\n"
|
||||
|
||||
-- Suitable for hledger's ErroringJournalParser parsers.
|
||||
expectParseE
|
||||
:: (Monoid st, Eq a, Show a, HasCallStack)
|
||||
:: (HasCallStack, Eq a, Show a, Monoid st)
|
||||
=> StateT st (ParsecT CustomErr T.Text (ExceptT FinalParseError IO)) a
|
||||
-> T.Text
|
||||
-> E.Test ()
|
||||
expectParseE parser input = do
|
||||
-> TestTree
|
||||
expectParseE parser input = testCaseSteps "sometest" $ \_step -> do
|
||||
let filepath = ""
|
||||
eep <- E.io $ runExceptT $
|
||||
eep <- runExceptT $
|
||||
runParserT (evalStateT (parser <* eof) mempty) filepath input
|
||||
case eep of
|
||||
Left finalErr ->
|
||||
let prettyErr = finalErrorBundlePretty $ attachSource filepath input finalErr
|
||||
in fail $ "parse error at " <> prettyErr
|
||||
in assertFailure $ "parse error at " <> prettyErr
|
||||
Right ep ->
|
||||
either (fail.(++"\n").("\nparse error at "++).customErrorBundlePretty)
|
||||
(const ok)
|
||||
either (assertFailure.(++"\n").("\nparse error at "++).customErrorBundlePretty)
|
||||
(const $ return ())
|
||||
ep
|
||||
|
||||
-- | Test that this stateful parser runnable in IO fails to parse
|
||||
-- the given input text, with a parse error containing the given string.
|
||||
expectParseError :: (Monoid st, Eq a, Show a, HasCallStack) =>
|
||||
StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> String -> E.Test ()
|
||||
expectParseError parser input errstr = do
|
||||
ep <- E.io (runParserT (evalStateT parser mempty) "" input)
|
||||
case ep of
|
||||
Right v -> fail $ "\nparse succeeded unexpectedly, producing:\n" ++ pshow v ++ "\n"
|
||||
Left e -> do
|
||||
let e' = customErrorBundlePretty e
|
||||
if errstr `isInfixOf` e'
|
||||
then ok
|
||||
else fail $ "\nparse error is not as expected:\n" ++ e' ++ "\n"
|
||||
|
||||
expectParseErrorE
|
||||
:: (Monoid st, Eq a, Show a, HasCallStack)
|
||||
=> StateT st (ParsecT CustomErr T.Text (ExceptT FinalParseError IO)) a
|
||||
-> T.Text
|
||||
-> String
|
||||
-> E.Test ()
|
||||
expectParseErrorE parser input errstr = do
|
||||
let filepath = ""
|
||||
eep <- E.io $ runExceptT $ runParserT (evalStateT parser mempty) filepath input
|
||||
case eep of
|
||||
Left finalErr -> do
|
||||
let prettyErr = finalErrorBundlePretty $ attachSource filepath input finalErr
|
||||
if errstr `isInfixOf` prettyErr
|
||||
then ok
|
||||
else fail $ "\nparse error is not as expected:\n" ++ prettyErr ++ "\n"
|
||||
Right ep -> case ep of
|
||||
Right v -> fail $ "\nparse succeeded unexpectedly, producing:\n" ++ pshow v ++ "\n"
|
||||
Left e -> do
|
||||
let e' = customErrorBundlePretty e
|
||||
if errstr `isInfixOf` e'
|
||||
then ok
|
||||
else fail $ "\nparse error is not as expected:\n" ++ e' ++ "\n"
|
||||
|
||||
-- | Like expectParse, but also test the parse result is an expected value,
|
||||
-- pretty-printing both if it fails.
|
||||
expectParseEq :: (Monoid st, Eq a, Show a, HasCallStack) =>
|
||||
StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> a -> E.Test ()
|
||||
expectParseEq parser input expected = expectParseEqOn parser input id expected
|
||||
|
||||
expectParseEqE
|
||||
:: (Monoid st, Eq a, Show a, HasCallStack)
|
||||
=> StateT st (ParsecT CustomErr T.Text (ExceptT FinalParseError IO)) a
|
||||
-> T.Text
|
||||
-> a
|
||||
-> E.Test ()
|
||||
-> TestTree
|
||||
expectParseEqE parser input expected = expectParseEqOnE parser input id expected
|
||||
|
||||
-- | Like expectParseEq, but transform the parse result with the given function
|
||||
-- before comparing it.
|
||||
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 "++) . customErrorBundlePretty)
|
||||
(expectEqPP expected . f)
|
||||
ep
|
||||
|
||||
expectParseEqOnE
|
||||
:: (Monoid st, Eq b, Show b, HasCallStack)
|
||||
:: (HasCallStack, Eq b, Show b, Monoid st)
|
||||
=> StateT st (ParsecT CustomErr T.Text (ExceptT FinalParseError IO)) a
|
||||
-> T.Text
|
||||
-> (a -> b)
|
||||
-> b
|
||||
-> E.Test ()
|
||||
expectParseEqOnE parser input f expected = do
|
||||
-> TestTree
|
||||
expectParseEqOnE parser input f expected = testCaseSteps "sometest" $ \_step -> do
|
||||
let filepath = ""
|
||||
eep <- E.io $ runExceptT $
|
||||
runParserT (evalStateT (parser <* eof) mempty) filepath input
|
||||
eep <- runExceptT $ runParserT (evalStateT (parser <* eof) mempty) filepath input
|
||||
case eep of
|
||||
Left finalErr ->
|
||||
let prettyErr = finalErrorBundlePretty $ attachSource filepath input finalErr
|
||||
in fail $ "parse error at " <> prettyErr
|
||||
in assertFailure $ "parse error at " <> prettyErr
|
||||
Right ep ->
|
||||
either (fail . (++"\n") . ("\nparse error at "++) . customErrorBundlePretty)
|
||||
(expectEqPP expected . f)
|
||||
either (assertFailure . (++"\n") . ("\nparse error at "++) . customErrorBundlePretty)
|
||||
(assertEq expected . f)
|
||||
ep
|
||||
|
||||
expectParseErrorE
|
||||
:: (Monoid st, Eq a, Show a, HasCallStack)
|
||||
=> StateT st (ParsecT CustomErr T.Text (ExceptT FinalParseError IO)) a
|
||||
-> T.Text
|
||||
-> String
|
||||
-> TestTree
|
||||
expectParseErrorE parser input errstr = testCaseSteps "sometest" $ \_step -> do
|
||||
let filepath = ""
|
||||
eep <- runExceptT $ runParserT (evalStateT parser mempty) filepath input
|
||||
case eep of
|
||||
Left finalErr -> do
|
||||
let prettyErr = finalErrorBundlePretty $ attachSource filepath input finalErr
|
||||
if errstr `isInfixOf` prettyErr
|
||||
then return ()
|
||||
else assertFailure $ "\nparse error is not as expected:\n" ++ prettyErr ++ "\n"
|
||||
Right ep -> case ep of
|
||||
Right v -> assertFailure $ "\nparse succeeded unexpectedly, producing:\n" ++ pshow v ++ "\n"
|
||||
Left e -> do
|
||||
let e' = customErrorBundlePretty e
|
||||
if errstr `isInfixOf` e'
|
||||
then return ()
|
||||
else assertFailure $ "\nparse error is not as expected:\n" ++ e' ++ "\n"
|
||||
|
||||
-- | Run a stateful parser in IO like expectParse, then compare the
|
||||
-- final state (the wrapped state, not megaparsec's internal state),
|
||||
-- transformed by the given function, with the given expected value.
|
||||
expectParseStateOn :: (HasCallStack, Monoid st, Eq b, Show b) =>
|
||||
expectParseStateOn :: (HasCallStack, Eq b, Show b, Monoid st) =>
|
||||
StateT st (ParsecT CustomErr T.Text IO) a
|
||||
-> T.Text
|
||||
-> (st -> b)
|
||||
-> b
|
||||
-> E.Test ()
|
||||
expectParseStateOn parser input f expected = do
|
||||
es <- E.io $ runParserT (execStateT (parser <* eof) mempty) "" input
|
||||
-> TestTree
|
||||
expectParseStateOn parser input f expected = testCaseSteps "sometest" $ \_step -> do
|
||||
es <- runParserT (execStateT (parser <* eof) mempty) "" input
|
||||
case es of
|
||||
Left err -> fail $ (++"\n") $ ("\nparse error at "++) $ customErrorBundlePretty err
|
||||
Right s -> expectEqPP expected $ f s
|
||||
Left err -> assertFailure $ (++"\n") $ ("\nparse error at "++) $ customErrorBundlePretty err
|
||||
Right s -> assertEq expected $ f s
|
||||
|
||||
|
@ -4,7 +4,7 @@ cabal-version: 1.12
|
||||
--
|
||||
-- see: https://github.com/sol/hpack
|
||||
--
|
||||
-- hash: 4b32c89e49ba64c66ca8552bb3ac2d54099cff23f9950b7fe294a32297a9b01a
|
||||
-- hash: f8ee8c9fd0412cc0a8cd5c6286b7ef4f9a33ae2a30989dfc0b99c3f79bd55622
|
||||
|
||||
name: hledger-lib
|
||||
version: 1.15.99
|
||||
@ -107,7 +107,7 @@ library
|
||||
, Glob >=0.9
|
||||
, ansi-terminal >=0.6.2.3
|
||||
, array
|
||||
, base >=4.9 && <4.13
|
||||
, base >=4.9 && <4.14
|
||||
, base-compat-batteries >=0.10.1 && <0.12
|
||||
, blaze-markup >=0.5.1
|
||||
, bytestring
|
||||
@ -119,7 +119,6 @@ library
|
||||
, data-default >=0.5
|
||||
, deepseq
|
||||
, directory
|
||||
, easytest >=0.2.1 && <0.3
|
||||
, extra >=1.6.3
|
||||
, fgl >=5.5.4.0
|
||||
, file-embed >=0.0.10
|
||||
@ -136,6 +135,8 @@ library
|
||||
, safe >=0.2
|
||||
, split >=0.1
|
||||
, tabular >=0.2
|
||||
, tasty >=1.2.3
|
||||
, tasty-hunit >=0.10.0.2
|
||||
, template-haskell
|
||||
, text >=1.2
|
||||
, time >=1.5
|
||||
@ -160,7 +161,7 @@ test-suite doctests
|
||||
, Glob >=0.7
|
||||
, ansi-terminal >=0.6.2.3
|
||||
, array
|
||||
, base >=4.9 && <4.13
|
||||
, base >=4.9 && <4.14
|
||||
, base-compat-batteries >=0.10.1 && <0.12
|
||||
, blaze-markup >=0.5.1
|
||||
, bytestring
|
||||
@ -173,7 +174,6 @@ test-suite doctests
|
||||
, deepseq
|
||||
, directory
|
||||
, doctest >=0.16
|
||||
, easytest >=0.2.1 && <0.3
|
||||
, extra >=1.6.3
|
||||
, fgl >=5.5.4.0
|
||||
, file-embed >=0.0.10
|
||||
@ -190,6 +190,8 @@ test-suite doctests
|
||||
, safe >=0.2
|
||||
, split >=0.1
|
||||
, tabular >=0.2
|
||||
, tasty >=1.2.3
|
||||
, tasty-hunit >=0.10.0.2
|
||||
, template-haskell
|
||||
, text >=1.2
|
||||
, time >=1.5
|
||||
@ -204,58 +206,3 @@ test-suite doctests
|
||||
if (impl(ghc < 8.2))
|
||||
buildable: False
|
||||
default-language: Haskell2010
|
||||
|
||||
test-suite easytests
|
||||
type: exitcode-stdio-1.0
|
||||
main-is: easytests.hs
|
||||
hs-source-dirs:
|
||||
./.
|
||||
test
|
||||
ghc-options: -Wall -fno-warn-unused-do-bind -fno-warn-name-shadowing -fno-warn-missing-signatures -fno-warn-type-defaults -fno-warn-orphans
|
||||
build-depends:
|
||||
Decimal
|
||||
, Glob >=0.9
|
||||
, ansi-terminal >=0.6.2.3
|
||||
, array
|
||||
, base >=4.9 && <4.13
|
||||
, base-compat-batteries >=0.10.1 && <0.12
|
||||
, blaze-markup >=0.5.1
|
||||
, bytestring
|
||||
, call-stack
|
||||
, cassava
|
||||
, cassava-megaparsec
|
||||
, cmdargs >=0.10
|
||||
, containers
|
||||
, data-default >=0.5
|
||||
, deepseq
|
||||
, directory
|
||||
, easytest >=0.2.1 && <0.3
|
||||
, extra >=1.6.3
|
||||
, fgl >=5.5.4.0
|
||||
, file-embed >=0.0.10
|
||||
, filepath
|
||||
, hashtables >=1.2.3.1
|
||||
, hledger-lib
|
||||
, megaparsec >=7.0.0 && <8
|
||||
, mtl
|
||||
, mtl-compat
|
||||
, old-time
|
||||
, parsec >=3
|
||||
, parser-combinators >=0.4.0
|
||||
, pretty-show >=1.6.4
|
||||
, regex-tdfa
|
||||
, safe >=0.2
|
||||
, split >=0.1
|
||||
, tabular >=0.2
|
||||
, template-haskell
|
||||
, text >=1.2
|
||||
, time >=1.5
|
||||
, timeit
|
||||
, transformers >=0.2
|
||||
, uglymemo
|
||||
, utf8-string >=0.3.5
|
||||
buildable: True
|
||||
if (!impl(ghc >= 8.0))
|
||||
build-depends:
|
||||
semigroups ==0.18.*
|
||||
default-language: Haskell2010
|
||||
|
@ -39,7 +39,7 @@ extra-source-files:
|
||||
#data-files:
|
||||
|
||||
dependencies:
|
||||
- base >=4.9 && <4.13
|
||||
- base >=4.9 && <4.14
|
||||
- base-compat-batteries >=0.10.1 && <0.12
|
||||
- ansi-terminal >=0.6.2.3
|
||||
- array
|
||||
@ -54,7 +54,6 @@ dependencies:
|
||||
- Decimal
|
||||
- deepseq
|
||||
- directory
|
||||
- easytest >= 0.2.1 && <0.3
|
||||
- fgl >=5.5.4.0
|
||||
- file-embed >=0.0.10
|
||||
- filepath
|
||||
@ -70,6 +69,8 @@ dependencies:
|
||||
- safe >=0.2
|
||||
- split >=0.1
|
||||
- tabular >=0.2
|
||||
- tasty >=1.2.3
|
||||
- tasty-hunit >=0.10.0.2
|
||||
- template-haskell
|
||||
- text >=1.2
|
||||
- time >=1.5
|
||||
@ -186,10 +187,10 @@ tests:
|
||||
buildable: false
|
||||
|
||||
|
||||
easytests:
|
||||
buildable: true
|
||||
source-dirs: test
|
||||
main: easytests.hs
|
||||
other-modules: [] # prevent double compilation, https://github.com/sol/hpack/issues/188
|
||||
dependencies:
|
||||
- hledger-lib
|
||||
# easytests:
|
||||
# buildable: true
|
||||
# source-dirs: test
|
||||
# main: easytests.hs
|
||||
# other-modules: [] # prevent double compilation, https://github.com/sol/hpack/issues/188
|
||||
# dependencies:
|
||||
# - hledger-lib
|
||||
|
@ -55,9 +55,8 @@ import Data.Monoid ((<>))
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Data.Time.Calendar
|
||||
import qualified EasyTest
|
||||
import System.Environment (withArgs)
|
||||
import System.Console.CmdArgs.Explicit as C
|
||||
import System.Exit
|
||||
|
||||
import Hledger
|
||||
import Hledger.Cli.CliOptions
|
||||
@ -267,19 +266,14 @@ testmode = hledgerCommandMode
|
||||
-- not be used (and would raise an error).
|
||||
testcmd :: CliOpts -> Journal -> IO ()
|
||||
testcmd opts _undefined = do
|
||||
let args = words' $ query_ $ reportopts_ opts
|
||||
-- workaround for https://github.com/joelburget/easytest/issues/11
|
||||
-- import System.IO (hSetEncoding, stdout, stderr, utf8)
|
||||
-- hSetEncoding stdout utf8
|
||||
-- hSetEncoding stderr utf8
|
||||
e <- runEasytests args $ EasyTest.tests [
|
||||
tests_Hledger
|
||||
,tests "Hledger.Cli" [
|
||||
tests_Cli_Utils
|
||||
,tests_Commands
|
||||
withArgs (words' $ query_ $ reportopts_ opts) $
|
||||
defaultMain $ tests "sometests" [ -- Test.Tasty.defaultMain from Hledger.Util.Tests
|
||||
tests_Hledger
|
||||
,tests "Hledger.Cli" [
|
||||
tests_Cli_Utils
|
||||
,tests_Commands
|
||||
]
|
||||
]
|
||||
]
|
||||
if e then exitFailure else exitSuccess
|
||||
|
||||
|
||||
tests_Commands = tests "Commands" [
|
||||
@ -288,60 +282,62 @@ tests_Commands = tests "Commands" [
|
||||
|
||||
-- some more tests easiest to define here:
|
||||
|
||||
,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}
|
||||
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"
|
||||
)
|
||||
,test "apply account directive" $ let
|
||||
ignoresourcepos j = j{jtxns=map (\t -> t{tsourcepos=nullsourcepos}) (jtxns j)}
|
||||
sameParse str1 str2 = testCaseSteps "sometest" $ \_step -> do
|
||||
j1 <- readJournal def Nothing str1 >>= either error' (return . ignoresourcepos)
|
||||
j2 <- readJournal def Nothing str2 >>= either error' (return . ignoresourcepos)
|
||||
j1 @?= 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"
|
||||
)
|
||||
|
||||
,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
|
||||
,testCaseSteps "apply account directive should preserve \"virtual\" posting type" $ \_step -> do
|
||||
j <- 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
|
||||
paccount p `is` "test:from"
|
||||
ptype p `is` VirtualPosting
|
||||
paccount p @?= "test:from"
|
||||
ptype p @?= VirtualPosting
|
||||
|
||||
,test "account aliases" $ do
|
||||
j <- io $ readJournal def Nothing "!alias expenses = equity:draw:personal\n1/1\n (expenses:food) 1\n" >>= either error' return
|
||||
,testCaseSteps "account aliases" $ \_step -> do
|
||||
j <- 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
|
||||
paccount p `is` "equity:draw:personal:food"
|
||||
paccount p @?= "equity:draw:personal:food"
|
||||
|
||||
,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"]
|
||||
,testCase "ledgerAccountNames" $
|
||||
(ledgerAccountNames ledger7)
|
||||
@?=
|
||||
["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"]
|
||||
|
||||
-- ,test "journalCanonicaliseAmounts" ~:
|
||||
-- "use the greatest precision" ~:
|
||||
-- (map asprecision $ journalAmountAndPriceCommodities $ journalCanonicaliseAmounts $ journalWithAmounts ["1","2.00"]) `is` [2,2]
|
||||
-- (map asprecision $ journalAmountAndPriceCommodities $ journalCanonicaliseAmounts $ journalWithAmounts ["1","2.00"]) @?= [2,2]
|
||||
|
||||
-- don't know what this should do
|
||||
-- ,test "elideAccountName" ~: do
|
||||
-- (elideAccountName 50 "aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa"
|
||||
-- `is` "aa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa")
|
||||
-- @?= "aa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa")
|
||||
-- (elideAccountName 20 "aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa"
|
||||
-- `is` "aa:aa:aaaaaaaaaaaaaa")
|
||||
-- @?= "aa:aa:aaaaaaaaaaaaaa")
|
||||
|
||||
,test "default year" $ do
|
||||
j <- io $ readJournal def Nothing defaultyear_journal_txt >>= either error' return
|
||||
tdate (head $ jtxns j) `is` fromGregorian 2009 1 1
|
||||
,testCaseSteps "default year" $ \_step -> do
|
||||
j <- readJournal def Nothing defaultyear_journal_txt >>= either error' return
|
||||
tdate (head $ jtxns j) @?= fromGregorian 2009 1 1
|
||||
|
||||
,test "show dollars" $ showAmount (usd 1) `is` "$1.00"
|
||||
,testCase "show dollars" $ showAmount (usd 1) @?= "$1.00"
|
||||
|
||||
,test "show hours" $ showAmount (hrs 1) `is` "1.00h"
|
||||
,testCase "show hours" $ showAmount (hrs 1) @?= "1.00h"
|
||||
|
||||
]
|
||||
|
||||
|
@ -640,10 +640,10 @@ balanceReportTableAsText ropts = tableAsText ropts showamt
|
||||
tests_Balance = tests "Balance" [
|
||||
|
||||
tests "balanceReportAsText" [
|
||||
test "unicode in balance layout" $ do
|
||||
j <- io $ readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n"
|
||||
testCaseSteps "unicode in balance layout" $ \_step -> 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`
|
||||
balanceReportAsText opts (balanceReport opts (queryFromOpts (parsedate "2008/11/26") opts) j) @?=
|
||||
unlines
|
||||
[" -100 актив:наличные"
|
||||
," 100 расходы:покупки"
|
||||
|
@ -194,10 +194,10 @@ postingsReportItemAsText opts preferredamtwidth preferredbalwidth (mdate, mendda
|
||||
tests_Register = tests "Register" [
|
||||
|
||||
tests "postingsReportAsText" [
|
||||
test "unicode in register layout" $ do
|
||||
j <- io $ readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n"
|
||||
testCaseSteps "unicode in register layout" $ \_step -> 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
|
||||
(postingsReportAsText defcliopts $ postingsReport opts (queryFromOpts (parsedate "2008/11/26") opts) j) @?= unlines
|
||||
["2009/01/01 медвежья шкура расходы:покупки 100 100"
|
||||
," актив:наличные -100 0"]
|
||||
]
|
||||
|
@ -4,7 +4,7 @@ cabal-version: 1.12
|
||||
--
|
||||
-- see: https://github.com/sol/hpack
|
||||
--
|
||||
-- hash: 6bdd5e55ef3db9761bde530f23cd7fe97dc63e707e18129732a4d827505c6aa4
|
||||
-- hash: a8cb399c2c97d23c9fc48e12709494216df3069cce7ec448277be8fde91f72d0
|
||||
|
||||
name: hledger
|
||||
version: 1.15.99
|
||||
@ -156,7 +156,6 @@ library
|
||||
, containers
|
||||
, data-default >=0.5
|
||||
, directory
|
||||
, easytest >=0.2.1 && <0.3
|
||||
, extra >=1.6.3
|
||||
, filepath
|
||||
, hashable >=1.2.4
|
||||
@ -208,7 +207,6 @@ executable hledger
|
||||
, containers
|
||||
, data-default >=0.5
|
||||
, directory
|
||||
, easytest >=0.2.1 && <0.3
|
||||
, extra >=1.6.3
|
||||
, filepath
|
||||
, haskeline >=0.6
|
||||
@ -260,7 +258,6 @@ test-suite test
|
||||
, containers
|
||||
, data-default >=0.5
|
||||
, directory
|
||||
, easytest >=0.2.1 && <0.3
|
||||
, extra >=1.6.3
|
||||
, filepath
|
||||
, haskeline >=0.6
|
||||
@ -312,7 +309,6 @@ benchmark bench
|
||||
, criterion
|
||||
, data-default >=0.5
|
||||
, directory
|
||||
, easytest >=0.2.1 && <0.3
|
||||
, extra >=1.6.3
|
||||
, filepath
|
||||
, haskeline >=0.6
|
||||
|
@ -115,7 +115,6 @@ dependencies:
|
||||
- data-default >=0.5
|
||||
- Decimal
|
||||
- directory
|
||||
- easytest >= 0.2.1 && <0.3
|
||||
- extra >=1.6.3
|
||||
- filepath
|
||||
- haskeline >=0.6
|
||||
|
Loading…
Reference in New Issue
Block a user