slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

tests: port all unit tests to tasty, first cut (#1090)

Browse Source 
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:
Simon Michael 2019-11-26 13:56:14 -08:00
parent 8952dc9a93
commit 13a3542464
17 changed files with 358 additions and 417 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
hledger-lib/Hledger/Data/Journal.hs
View File

@ -1324,16 +1324,16 @@ tests_Journal = tests "Journal" [
,tests "journalBalanceTransactions" [ ,tests "journalBalanceTransactions" [
test "balance-assignment" $ do test "balance-assignment" $ testCaseSteps "sometests" $ \_step -> do
let ej = journalBalanceTransactions True $ let ej = journalBalanceTransactions True $
--2019/01/01 --2019/01/01
-- (a) = 1 -- (a) = 1
nulljournal{ jtxns = [ nulljournal{ jtxns = [
transaction "2019/01/01" [ vpost' "a" missingamt (balassert (num 1)) ] transaction "2019/01/01" [ vpost' "a" missingamt (balassert (num 1)) ]
]} ]}
expectRight ej assertRight ej
let Right j = 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 ,test "same-day-1" $ do
expectRight $ journalBalanceTransactions True $ expectRight $ journalBalanceTransactions True $

4
hledger-lib/Hledger/Data/StringFormat.hs
View File

@ -18,7 +18,7 @@ import "base-compat-batteries" Prelude.Compat
import Numeric import Numeric
import Data.Char (isPrint) import Data.Char (isPrint)
import Data.Maybe import Data.Maybe
import qualified Data.Text as T -- import qualified Data.Text as T
import Text.Megaparsec import Text.Megaparsec
import Text.Megaparsec.Char import Text.Megaparsec.Char
@ -157,7 +157,7 @@ tests_StringFormat = tests "StringFormat" [
] ]
,tests "parseStringFormat" $ ,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 [ in [
"" `gives` (defaultStringFormatStyle []) "" `gives` (defaultStringFormatStyle [])
, "D" `gives` (defaultStringFormatStyle [FormatLiteral "D"]) , "D" `gives` (defaultStringFormatStyle [FormatLiteral "D"])

49
hledger-lib/Hledger/Data/Timeclock.hs
View File

@ -115,32 +115,31 @@ entryFromTimeclockInOut i o
-- tests -- tests
tests_Timeclock = tests "Timeclock" [ tests_Timeclock = tests "Timeclock" [
do testCaseSteps "timeclockEntriesToTransactions tests" $ \step -> do
today <- io getCurrentDay step "gathering data"
now' <- io getCurrentTime today <- getCurrentDay
tz <- io getCurrentTimeZone now' <- getCurrentTime
let now = utcToLocalTime tz now' tz <- getCurrentTimeZone
nowstr = showtime now let now = utcToLocalTime tz now'
yesterday = prevday today nowstr = showtime now
clockin = TimeclockEntry nullsourcepos In yesterday = prevday today
mktime d = LocalTime d . fromMaybe midnight . clockin = TimeclockEntry nullsourcepos In
mktime d = LocalTime d . fromMaybe midnight .
#if MIN_VERSION_time(1,5,0) #if MIN_VERSION_time(1,5,0)
parseTimeM True defaultTimeLocale "%H:%M:%S" parseTimeM True defaultTimeLocale "%H:%M:%S"
#else #else
parseTime defaultTimeLocale "%H:%M:%S" parseTime defaultTimeLocale "%H:%M:%S"
#endif #endif
showtime = formatTime defaultTimeLocale "%H:%M" showtime = formatTime defaultTimeLocale "%H:%M"
txndescs = map (T.unpack . tdescription) . timeclockEntriesToTransactions now txndescs = map (T.unpack . tdescription) . timeclockEntriesToTransactions now
future = utcToLocalTime tz $ addUTCTime 100 now' future = utcToLocalTime tz $ addUTCTime 100 now'
futurestr = showtime future futurestr = showtime future
tests "timeclockEntriesToTransactions" [ step "started yesterday, split session at midnight"
test "started yesterday, split session at midnight" $ txndescs [clockin (mktime yesterday "23:00:00") "" ""] @?= ["23:00-23:59","00:00-"++nowstr]
txndescs [clockin (mktime yesterday "23:00:00") "" ""] `is` ["23:00-23:59","00:00-"++nowstr] step "split multi-day sessions at each midnight"
,test "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]
txndescs [clockin (mktime (addDays (-2) today) "23:00:00") "" ""] `is `["23:00-23:59","00:00-23:59","00:00-"++nowstr] step "auto-clock-out if needed"
,test "auto-clock-out if needed" $ txndescs [clockin (mktime today "00:00:00") "" ""] @?= ["00:00-"++nowstr]
txndescs [clockin (mktime today "00:00:00") "" ""] `is` ["00:00-"++nowstr] step "use the clockin time for auto-clockout if it's in the future"
,test "use the clockin time for auto-clockout if it's in the future" $ txndescs [clockin future "" ""] @?= [printf "%s-%s" futurestr futurestr]
txndescs [clockin future "" ""] `is` [printf "%s-%s" futurestr futurestr]
]
] ]

11
hledger-lib/Hledger/Data/Transaction.hs
View File

@ -596,7 +596,7 @@ tests_Transaction =
-- one missing amount, not the last one -- one missing amount, not the last one
t3 = nulltransaction {tpostings = ["a" `post` usd 1, "b" `post` missingamt, "c" `post` usd (-1)]} t3 = nulltransaction {tpostings = ["a" `post` usd 1, "b" `post` missingamt, "c" `post` usd (-1)]}
-- unbalanced amounts when precision is limited (#931) -- 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 in tests
"postingsAsLines" "postingsAsLines"
[ test "null-transaction" $ [ test "null-transaction" $
@ -635,10 +635,11 @@ tests_Transaction =
let t = t3 let t = t3
in postingsAsLines False (tpostings t) `is` in postingsAsLines False (tpostings t) `is`
[" a $1.00", " b", " c $-1.00"] [" a $1.00", " b", " c $-1.00"]
, _test "ensure-visibly-balanced" $ -- , _test "ensure-visibly-balanced" $
let t = t4 -- let t = t4
in postingsAsLines False (tpostings t) `is` -- in postingsAsLines False (tpostings t) `is`
[" a $-0.01", " b $0.005", " c $0.005"] -- [" a $-0.01", " b $0.005", " c $0.005"]
] ]
, tests , tests
"inferBalancingAmount" "inferBalancingAmount"

2
hledger-lib/Hledger/Query.hs
View File

@ -723,7 +723,7 @@ tests_Query = tests "Query" [
,parseAmountQueryTerm "0.23" `is` (AbsEq,0.23) ,parseAmountQueryTerm "0.23" `is` (AbsEq,0.23)
,parseAmountQueryTerm "<=+0.23" `is` (LtEq,0.23) ,parseAmountQueryTerm "<=+0.23" `is` (LtEq,0.23)
,parseAmountQueryTerm "-0.23" `is` (Eq,(-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" [ ,tests "matchesAccount" [

2
hledger-lib/Hledger/Read/Common.hs
View File

@ -1363,7 +1363,7 @@ tests_Common = tests "Common" [
,tests "spaceandamountormissingp" [ ,tests "spaceandamountormissingp" [
test "space and amount" $ expectParseEq spaceandamountormissingp " $47.18" (Mixed [usd 47.18]) test "space and amount" $ expectParseEq spaceandamountormissingp " $47.18" (Mixed [usd 47.18])
,test "empty string" $ expectParseEq spaceandamountormissingp "" missingmixedamt ,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 -- ,test "just amount" $ expectParseError spaceandamountormissingp "$47.18" "" -- succeeds, consuming nothing
] ]

125
hledger-lib/Hledger/Read/JournalReader.hs
View File

@ -63,8 +63,8 @@ module Hledger.Read.JournalReader (
) )
where where
--- * imports --- * imports
import qualified Prelude (fail) -- import qualified Prelude (fail)
import "base-compat-batteries" Prelude.Compat hiding (fail, readFile) -- import "base-compat-batteries" Prelude.Compat hiding (fail, readFile)
import qualified "base-compat-batteries" Control.Monad.Fail.Compat as Fail (fail) import qualified "base-compat-batteries" Control.Monad.Fail.Compat as Fail (fail)
import qualified Control.Exception as C import qualified Control.Exception as C
import Control.Monad (forM_, when, void) import Control.Monad (forM_, when, void)
@ -668,41 +668,43 @@ tests_JournalReader = tests "JournalReader" [
let p = lift accountnamep :: JournalParser IO AccountName in let p = lift accountnamep :: JournalParser IO AccountName in
tests "accountnamep" [ tests "accountnamep" [
test "basic" $ expectParse p "a:b:c" test "basic" $ expectParse p "a:b:c"
,_test "empty inner component" $ expectParseError p "a::c" "" -- TODO -- ,_test "empty inner component" $ expectParseError p "a::c" "" -- TODO
,_test "empty leading component" $ expectParseError p ":b:c" "x" -- ,_test "empty leading component" $ expectParseError p ":b:c" "x"
,_test "empty trailing component" $ expectParseError p "a:b:" "x" -- ,_test "empty trailing component" $ expectParseError p "a:b:" "x"
] ]
-- "Parse a date in YYYY/MM/DD format. -- "Parse a date in YYYY/MM/DD format.
-- Hyphen (-) and period (.) are also allowed as separators. -- Hyphen (-) and period (.) are also allowed as separators.
-- The year may be omitted if a default year has been set. -- The year may be omitted if a default year has been set.
-- Leading zeroes may be omitted." -- Leading zeroes may be omitted."
,test "datep" $ do ,tests "datep" [
test "YYYY/MM/DD" $ expectParseEq datep "2018/01/01" (fromGregorian 2018 1 1) 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 "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 no default year" $ expectParseError datep "1/1" "current year is unknown"
test "yearless date with default year" $ do ,testCaseSteps "yearless date with default year" $ \_step -> do
let s = "1/1" let s = "1/1"
ep <- parseWithState mempty{jparsedefaultyear=Just 2018} datep s ep <- parseWithState mempty{jparsedefaultyear=Just 2018} datep s
either (Prelude.fail . ("parse error at "++) . customErrorBundlePretty) (const ok) ep either (assertFailure . ("parse error at "++) . customErrorBundlePretty) (const $ return ()) ep
test "no leading zero" $ expectParse datep "2018/1/1" ,test "no leading zero" $ expectParse datep "2018/1/1"
]
,test "datetimep" $ do ,let
let good = expectParse datetimep
good = expectParse datetimep bad = (\t -> expectParseError datetimep t "")
bad = (\t -> expectParseError datetimep t "") in tests "datetimep" [
good "2011/1/1 00:00" good "2011/1/1 00:00"
good "2011/1/1 23:59:59" ,good "2011/1/1 23:59:59"
bad "2011/1/1" ,bad "2011/1/1"
bad "2011/1/1 24:00:00" ,bad "2011/1/1 24:00:00"
bad "2011/1/1 00:60:00" ,bad "2011/1/1 00:60:00"
bad "2011/1/1 00:00:60" ,bad "2011/1/1 00:00:60"
bad "2011/1/1 3:5:7" ,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))
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-0800" t
expectParseEq datetimep "2018/1/1 00:00+1234" t ,expectParseEq datetimep "2018/1/1 00:00+1234" t
]
]
,tests "periodictransactionp" [ ,tests "periodictransactionp" [
@ -883,41 +885,46 @@ tests_JournalReader = tests "JournalReader" [
-- directives -- directives
,tests "directivep" [ ,tests "directivep" [
test "supports !" $ do tests "supports !" [
expectParseE directivep "!account a\n" expectParseE directivep "!account a\n"
expectParseE directivep "!D 1.0\n" ,expectParseE directivep "!D 1.0\n"
]
] ]
,test "accountdirectivep" $ do ,tests "accountdirectivep" [
test "with-comment" $ expectParse accountdirectivep "account a:b ; a comment\n" test "with-comment" $ expectParse accountdirectivep "account a:b ; a comment\n"
test "does-not-support-!" $ expectParseError accountdirectivep "!account a:b\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-code" $ expectParse accountdirectivep "account a:b A\n"
test "account-type-tag" $ expectParseStateOn accountdirectivep "account a:b ; type:asset\n" ,test "account-type-tag" $ expectParseStateOn accountdirectivep "account a:b ; type:asset\n"
jdeclaredaccounts jdeclaredaccounts
[("a:b", AccountDeclarationInfo{adicomment = "type:asset\n" [("a:b", AccountDeclarationInfo{adicomment = "type:asset\n"
,aditags = [("type","asset")] ,aditags = [("type","asset")]
,adideclarationorder = 1 ,adideclarationorder = 1
}) })
]
] ]
,test "commodityconversiondirectivep" $ do ,test "commodityconversiondirectivep" $ do
expectParse commodityconversiondirectivep "C 1h = $50.00\n" expectParse commodityconversiondirectivep "C 1h = $50.00\n"
,test "defaultcommoditydirectivep" $ do ,tests "defaultcommoditydirectivep" [
expectParse defaultcommoditydirectivep "D $1,000.0\n" expectParse defaultcommoditydirectivep "D $1,000.0\n"
expectParseError defaultcommoditydirectivep "D $1000\n" "please include a decimal separator" ,expectParseError defaultcommoditydirectivep "D $1000\n" "please include a decimal separator"
]
,test "defaultyeardirectivep" $ do ,tests "defaultyeardirectivep" [
test "1000" $ expectParse defaultyeardirectivep "Y 1000" -- XXX no \n like the others test "1000" $ expectParse defaultyeardirectivep "Y 1000" -- XXX no \n like the others
test "999" $ expectParseError defaultyeardirectivep "Y 999" "bad year number" ,test "999" $ expectParseError defaultyeardirectivep "Y 999" "bad year number"
test "12345" $ expectParse defaultyeardirectivep "Y 12345" ,test "12345" $ expectParse defaultyeardirectivep "Y 12345"
]
,test "ignoredpricecommoditydirectivep" $ do ,test "ignoredpricecommoditydirectivep" $ do
expectParse ignoredpricecommoditydirectivep "N $\n" expectParse ignoredpricecommoditydirectivep "N $\n"
,test "includedirectivep" $ do ,tests "includedirectivep" [
test "include" $ expectParseErrorE includedirectivep "include nosuchfile\n" "No existing files match pattern: nosuchfile" 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 "glob" $ expectParseErrorE includedirectivep "include nosuchfile*\n" "No existing files match pattern: nosuchfile*"
]
,test "marketpricedirectivep" $ expectParseEq marketpricedirectivep ,test "marketpricedirectivep" $ expectParseEq marketpricedirectivep
"P 2017/01/30 BTC $922.83\n" "P 2017/01/30 BTC $922.83\n"
@ -930,10 +937,10 @@ tests_JournalReader = tests "JournalReader" [
,test "tagdirectivep" $ do ,test "tagdirectivep" $ do
expectParse tagdirectivep "tag foo \n" expectParse tagdirectivep "tag foo \n"
,test "endtagdirectivep" $ do ,tests "endtagdirectivep" [
expectParse endtagdirectivep "end tag \n" expectParse endtagdirectivep "end tag \n"
expectParse endtagdirectivep "pop \n" ,expectParse endtagdirectivep "pop \n"
]
,tests "journalp" [ ,tests "journalp" [
test "empty file" $ expectParseEqE journalp "" nulljournal 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 -- these are defined here rather than in Common so they can use journalp
,tests "parseAndFinaliseJournal" [ ,tests "parseAndFinaliseJournal" [
test "basic" $ do testCaseSteps "basic" $ \_step -> do
ej <- io $ runExceptT $ parseAndFinaliseJournal journalp definputopts "" "2019-1-1\n" ej <- runExceptT $ parseAndFinaliseJournal journalp definputopts "" "2019-1-1\n"
let Right j = ej let Right j = ej
expectEqPP [""] $ journalFilePaths j assertEq [""] $ journalFilePaths j
] ]
] ]

19
hledger-lib/Hledger/Reports/BalanceReport.hs
View File

@ -248,16 +248,15 @@ Right samplejournal2 =
} }
tests_BalanceReport = tests "BalanceReport" [ tests_BalanceReport = tests "BalanceReport" [
tests "balanceReport" $ let
let (opts,journal) `gives` r = testCaseSteps "sometest" $ \_step -> do
(opts,journal) `gives` r = do let (eitems, etotal) = r
let (eitems, etotal) = r (aitems, atotal) = balanceReport opts (queryFromOpts nulldate opts) journal
(aitems, atotal) = balanceReport opts (queryFromOpts nulldate opts) journal showw (acct,acct',indent,amt) = (acct, acct', indent, showMixedAmountDebug amt)
showw (acct,acct',indent,amt) = (acct, acct', indent, showMixedAmountDebug amt) (map showw eitems) @?= (map showw aitems)
(map showw eitems) `is` (map showw aitems) (showMixedAmountDebug etotal) @?= (showMixedAmountDebug atotal)
(showMixedAmountDebug etotal) `is` (showMixedAmountDebug atotal) usd0 = usd 0
usd0 = usd 0 in tests "balanceReport" [
in [
test "balanceReport with no args on null journal" $ test "balanceReport with no args on null journal" $
(defreportopts, nulljournal) `gives` ([], Mixed [nullamt]) (defreportopts, nulljournal) `gives` ([], Mixed [nullamt])

50
hledger-lib/Hledger/Reports/MultiBalanceReport.hs
View File

@ -417,13 +417,13 @@ tableAsText (ReportOpts{pretty_tables_ = pretty}) showcell =
tests_MultiBalanceReport = tests "MultiBalanceReport" [ tests_MultiBalanceReport = tests "MultiBalanceReport" [
let let
(opts,journal) `gives` r = do (opts,journal) `gives` r = testCaseSteps "sometest" $ \_step -> do
let (eitems, etotal) = r let (eitems, etotal) = r
(MultiBalanceReport (_, aitems, atotal)) = multiBalanceReport opts (queryFromOpts nulldate opts) journal (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') showw (acct,acct',indent,lAmt,amt,amt') = (acct, acct', indent, map showMixedAmountDebug lAmt, showMixedAmountDebug amt, showMixedAmountDebug amt')
(map showw aitems) `is` (map showw eitems) (map showw aitems) @?= (map showw eitems)
((\(_, b, _) -> showMixedAmountDebug b) atotal) `is` (showMixedAmountDebug etotal) -- we only check the sum of the totals ((\(_, b, _) -> showMixedAmountDebug b) atotal) @?= (showMixedAmountDebug etotal) -- we only check the sum of the totals
usd0 = usd 0 -- usd0 = usd 0
amount0 = Amount {acommodity="$", aquantity=0, aprice=Nothing, astyle=AmountStyle {ascommodityside = L, ascommodityspaced = False, asprecision = 2, asdecimalpoint = Just '.', asdigitgroups = Nothing}, aismultiplier=False} amount0 = Amount {acommodity="$", aquantity=0, aprice=Nothing, astyle=AmountStyle {ascommodityside = L, ascommodityspaced = False, asprecision = 2, asdecimalpoint = Just '.', asdigitgroups = Nothing}, aismultiplier=False}
in in
tests "multiBalanceReport" [ tests "multiBalanceReport" [
@ -439,27 +439,27 @@ tests_MultiBalanceReport = tests "MultiBalanceReport" [
], ],
Mixed [nullamt]) Mixed [nullamt])
,_test "a valid history on an empty period" $ -- ,_test "a valid history on an empty period" $
(defreportopts{period_= PeriodBetween (fromGregorian 2008 1 2) (fromGregorian 2008 1 3), balancetype_=HistoricalBalance}, samplejournal) `gives` -- (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}]) -- ("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)}]) -- ,("income:salary","salary",2, [mamountp' "$-1.00"], mamountp' "$-1.00",Mixed [amount0 {aquantity=(-1)}])
], -- ],
Mixed [usd0]) -- Mixed [usd0])
,_test "a valid history on an empty period (more complex)" $ -- ,_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` -- (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: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: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)}]) -- ,("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: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)}]) -- ,("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: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)}]) -- ,("income:salary","salary",2, [mamountp' "$-1.00"], mamountp' "$-1.00",Mixed [amount0 {aquantity=(-1)}])
], -- ],
Mixed [usd0]) -- Mixed [usd0])
] ]
] ]

302
hledger-lib/Hledger/Utils/Test.hs
View File

@ -4,229 +4,225 @@
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
module Hledger.Utils.Test ( module Hledger.Utils.Test (
HasCallStack module Test.Tasty
,module EasyTest ,module Test.Tasty.HUnit
,runEasytests -- ,module QC
-- ,module SC
,tests ,tests
,_tests
,test ,test
,_test
,it
,_it
,is ,is
,expectEqPP ,expect
,assertEq
,expectEq
,assertLeft
,expectLeft
,assertRight
,expectRight
,expectParse ,expectParse
,expectParseE
,expectParseError
,expectParseErrorE
,expectParseEq ,expectParseEq
,expectParseEqE
,expectParseEqOn ,expectParseEqOn
,expectParseEqOnE ,expectParseError
,expectParseE
,expectParseEqE
,expectParseErrorE
,expectParseStateOn ,expectParseStateOn
) )
where 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.Except (ExceptT, runExceptT)
import Control.Monad.State.Strict (StateT, evalStateT, execStateT) import Control.Monad.State.Strict (StateT, evalStateT, execStateT)
#if !(MIN_VERSION_base(4,11,0)) -- #if !(MIN_VERSION_base(4,11,0))
import Data.Monoid ((<>)) -- import Data.Monoid ((<>))
#endif -- #endif
import Data.CallStack -- import Data.CallStack
import Data.List import Data.List (isInfixOf)
import qualified Data.Text as T import qualified Data.Text as T
import Safe
import System.Exit
import Text.Megaparsec import Text.Megaparsec
import Text.Megaparsec.Custom 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.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". -- | Name and group a list of tests.
test :: T.Text -> E.Test a -> E.Test a tests :: String -> [TestTree] -> TestTree
test = E.scope 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". -- | Skip the given test(s), with the same type signature as "test".
-- If called in a monadic sequence of tests, also skips following tests. -- If called in a monadic sequence of tests, also skips following tests. (?)
_test :: T.Text -> E.Test a -> E.Test a -- _test :: T.Text -> E.Test a -> E.Test a
_test _name = (E.skip >>) -- _test _name = (E.skip >>)
-- | Name the given test(s). A synonym for "test". -- | Short equality test constructor. Actual value on the left, expected on the right.
it :: T.Text -> E.Test a -> E.Test a is :: (Eq a, Show a, HasCallStack) => a -> a -> TestTree
it = test is actual expected = testCase "sometest" $ actual @?= expected
-- | Skip the given test(s), and any following tests in a monadic sequence. -- | Expect True.
-- A synonym for "_test". expect :: HasCallStack => Bool -> TestTree
_it :: T.Text -> E.Test a -> E.Test a expect val = testCase "sometest" $ assertBool "was false" val
_it = _test
-- | Name and group a list of tests. Combines easytest's "scope" and "tests". -- | Assert equality. Expected first, actual second.
tests :: T.Text -> [E.Test ()] -> E.Test () assertEq :: (HasCallStack, Eq a, Show a) => a -> a -> Assertion
tests name = E.scope name . E.tests assertEq expected actual = assertEqual "was not equal" expected actual
-- | Skip the given list of tests, and any following tests in a monadic sequence, -- | Test for equality. Expected first, actual second.
-- with the same type signature as "group". expectEq :: (HasCallStack, Eq a, Show a) => a -> a -> TestTree
_tests :: T.Text -> [E.Test ()] -> E.Test () expectEq a b = testCase "sometest" $ assertEq a b
_tests _name = (E.skip >>) . E.tests
-- | Run some easytest tests, catching easytest's ExitCode exception, -- | Assert any Left value.
-- returning True if there was a problem. assertLeft :: (HasCallStack, Eq b, Show b) => Either a b -> Assertion
-- With arguments, runs only the scope (or single test) named by the first argument assertLeft (Left _) = return ()
-- (exact, case sensitive). assertLeft (Right b) = assertFailure $ "expected Left, got (Right " ++ show b ++ ")"
-- 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)
-- | Like easytest's expectEq (asserts the second (actual) value equals the first (expected) value) -- | Test for any Left value.
-- but pretty-prints the values in the failure output. expectLeft :: (HasCallStack, Eq a, Show a) => Either e a -> TestTree
expectEqPP :: (Eq a, Show a, HasCallStack) => a -> a -> E.Test () expectLeft = testCase "sometest" . assertLeft
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. -- | Assert any Right value.
is :: (Eq a, Show a, HasCallStack) => a -> a -> Test () assertRight :: (HasCallStack, Eq a, Show a) => Either a b -> Assertion
is = flip expectEqPP 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 -- | Test that this stateful parser runnable in IO successfully parses
-- all of the given input text, showing the parse error if it fails. -- all of the given input text, showing the parse error if it fails.
-- Suitable for hledger's JournalParser parsers. -- Suitable for hledger's JournalParser parsers.
expectParse :: (Monoid st, Eq a, Show a, HasCallStack) => -- expectParse :: (Monoid st, Eq a, Show a, HasCallStack) =>
StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> E.Test () -- StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> E.Test ()
expectParse parser input = do expectParse :: (HasCallStack, Eq a, Show a, Monoid st) =>
ep <- E.io (runParserT (evalStateT (parser <* eof) mempty) "" input) StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> TestTree
either (fail.(++"\n").("\nparse error at "++).customErrorBundlePretty) expectParse parser input = testCaseSteps "sometest" $ \_step -> do
(const ok) ep <- runParserT (evalStateT (parser <* eof) mempty) "" input
either (assertFailure.(++"\n").("\nparse error at "++).customErrorBundlePretty)
(const $ return ())
ep 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. -- Suitable for hledger's ErroringJournalParser parsers.
expectParseE 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 => StateT st (ParsecT CustomErr T.Text (ExceptT FinalParseError IO)) a
-> T.Text -> T.Text
-> E.Test () -> TestTree
expectParseE parser input = do expectParseE parser input = testCaseSteps "sometest" $ \_step -> do
let filepath = "" let filepath = ""
eep <- E.io $ runExceptT $ eep <- runExceptT $
runParserT (evalStateT (parser <* eof) mempty) filepath input runParserT (evalStateT (parser <* eof) mempty) filepath input
case eep of case eep of
Left finalErr -> Left finalErr ->
let prettyErr = finalErrorBundlePretty $ attachSource filepath input finalErr let prettyErr = finalErrorBundlePretty $ attachSource filepath input finalErr
in fail $ "parse error at " <> prettyErr in assertFailure $ "parse error at " <> prettyErr
Right ep -> Right ep ->
either (fail.(++"\n").("\nparse error at "++).customErrorBundlePretty) either (assertFailure.(++"\n").("\nparse error at "++).customErrorBundlePretty)
(const ok) (const $ return ())
ep 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 expectParseEqE
:: (Monoid st, Eq a, Show a, HasCallStack) :: (Monoid st, Eq a, Show a, HasCallStack)
=> StateT st (ParsecT CustomErr T.Text (ExceptT FinalParseError IO)) a => StateT st (ParsecT CustomErr T.Text (ExceptT FinalParseError IO)) a
-> T.Text -> T.Text
-> a -> a
-> E.Test () -> TestTree
expectParseEqE parser input expected = expectParseEqOnE parser input id expected 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 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 => StateT st (ParsecT CustomErr T.Text (ExceptT FinalParseError IO)) a
-> T.Text -> T.Text
-> (a -> b) -> (a -> b)
-> b -> b
-> E.Test () -> TestTree
expectParseEqOnE parser input f expected = do expectParseEqOnE parser input f expected = testCaseSteps "sometest" $ \_step -> do
let filepath = "" let filepath = ""
eep <- E.io $ runExceptT $ eep <- runExceptT $ runParserT (evalStateT (parser <* eof) mempty) filepath input
runParserT (evalStateT (parser <* eof) mempty) filepath input
case eep of case eep of
Left finalErr -> Left finalErr ->
let prettyErr = finalErrorBundlePretty $ attachSource filepath input finalErr let prettyErr = finalErrorBundlePretty $ attachSource filepath input finalErr
in fail $ "parse error at " <> prettyErr in assertFailure $ "parse error at " <> prettyErr
Right ep -> Right ep ->
either (fail . (++"\n") . ("\nparse error at "++) . customErrorBundlePretty) either (assertFailure . (++"\n") . ("\nparse error at "++) . customErrorBundlePretty)
(expectEqPP expected . f) (assertEq expected . f)
ep 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 -- | Run a stateful parser in IO like expectParse, then compare the
-- final state (the wrapped state, not megaparsec's internal state), -- final state (the wrapped state, not megaparsec's internal state),
-- transformed by the given function, with the given expected value. -- 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 StateT st (ParsecT CustomErr T.Text IO) a
-> T.Text -> T.Text
-> (st -> b) -> (st -> b)
-> b -> b
-> E.Test () -> TestTree
expectParseStateOn parser input f expected = do expectParseStateOn parser input f expected = testCaseSteps "sometest" $ \_step -> do
es <- E.io $ runParserT (execStateT (parser <* eof) mempty) "" input es <- runParserT (execStateT (parser <* eof) mempty) "" input
case es of case es of
Left err -> fail $ (++"\n") $ ("\nparse error at "++) $ customErrorBundlePretty err Left err -> assertFailure $ (++"\n") $ ("\nparse error at "++) $ customErrorBundlePretty err
Right s -> expectEqPP expected $ f s Right s -> assertEq expected $ f s

67
hledger-lib/hledger-lib.cabal
View File

@ -4,7 +4,7 @@ cabal-version: 1.12
-- --
-- see: https://github.com/sol/hpack -- see: https://github.com/sol/hpack
-- --
-- hash: 4b32c89e49ba64c66ca8552bb3ac2d54099cff23f9950b7fe294a32297a9b01a -- hash: f8ee8c9fd0412cc0a8cd5c6286b7ef4f9a33ae2a30989dfc0b99c3f79bd55622
name: hledger-lib name: hledger-lib
version: 1.15.99 version: 1.15.99
@ -107,7 +107,7 @@ library
, Glob >=0.9 , Glob >=0.9
, ansi-terminal >=0.6.2.3 , ansi-terminal >=0.6.2.3
, array , array
, base >=4.9 && <4.13 , base >=4.9 && <4.14
, base-compat-batteries >=0.10.1 && <0.12 , base-compat-batteries >=0.10.1 && <0.12
, blaze-markup >=0.5.1 , blaze-markup >=0.5.1
, bytestring , bytestring
@ -119,7 +119,6 @@ library
, data-default >=0.5 , data-default >=0.5
, deepseq , deepseq
, directory , directory
, easytest >=0.2.1 && <0.3
, extra >=1.6.3 , extra >=1.6.3
, fgl >=5.5.4.0 , fgl >=5.5.4.0
, file-embed >=0.0.10 , file-embed >=0.0.10
@ -136,6 +135,8 @@ library
, safe >=0.2 , safe >=0.2
, split >=0.1 , split >=0.1
, tabular >=0.2 , tabular >=0.2
, tasty >=1.2.3
, tasty-hunit >=0.10.0.2
, template-haskell , template-haskell
, text >=1.2 , text >=1.2
, time >=1.5 , time >=1.5
@ -160,7 +161,7 @@ test-suite doctests
, Glob >=0.7 , Glob >=0.7
, ansi-terminal >=0.6.2.3 , ansi-terminal >=0.6.2.3
, array , array
, base >=4.9 && <4.13 , base >=4.9 && <4.14
, base-compat-batteries >=0.10.1 && <0.12 , base-compat-batteries >=0.10.1 && <0.12
, blaze-markup >=0.5.1 , blaze-markup >=0.5.1
, bytestring , bytestring
@ -173,7 +174,6 @@ test-suite doctests
, deepseq , deepseq
, directory , directory
, doctest >=0.16 , doctest >=0.16
, easytest >=0.2.1 && <0.3
, extra >=1.6.3 , extra >=1.6.3
, fgl >=5.5.4.0 , fgl >=5.5.4.0
, file-embed >=0.0.10 , file-embed >=0.0.10
@ -190,6 +190,8 @@ test-suite doctests
, safe >=0.2 , safe >=0.2
, split >=0.1 , split >=0.1
, tabular >=0.2 , tabular >=0.2
, tasty >=1.2.3
, tasty-hunit >=0.10.0.2
, template-haskell , template-haskell
, text >=1.2 , text >=1.2
, time >=1.5 , time >=1.5
@ -204,58 +206,3 @@ test-suite doctests
if (impl(ghc < 8.2)) if (impl(ghc < 8.2))
buildable: False buildable: False
default-language: Haskell2010 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

19
hledger-lib/package.yaml
View File

@ -39,7 +39,7 @@ extra-source-files:
#data-files: #data-files:
dependencies: dependencies:
- base >=4.9 && <4.13 - base >=4.9 && <4.14
- base-compat-batteries >=0.10.1 && <0.12 - base-compat-batteries >=0.10.1 && <0.12
- ansi-terminal >=0.6.2.3 - ansi-terminal >=0.6.2.3
- array - array
@ -54,7 +54,6 @@ dependencies:
- Decimal - Decimal
- deepseq - deepseq
- directory - directory
- easytest >= 0.2.1 && <0.3
- fgl >=5.5.4.0 - fgl >=5.5.4.0
- file-embed >=0.0.10 - file-embed >=0.0.10
- filepath - filepath
@ -70,6 +69,8 @@ dependencies:
- safe >=0.2 - safe >=0.2
- split >=0.1 - split >=0.1
- tabular >=0.2 - tabular >=0.2
- tasty >=1.2.3
- tasty-hunit >=0.10.0.2
- template-haskell - template-haskell
- text >=1.2 - text >=1.2
- time >=1.5 - time >=1.5
@ -186,10 +187,10 @@ tests:
buildable: false buildable: false
easytests: # easytests:
buildable: true # buildable: true
source-dirs: test # source-dirs: test
main: easytests.hs # main: easytests.hs
other-modules: [] # prevent double compilation, https://github.com/sol/hpack/issues/188 # other-modules: [] # prevent double compilation, https://github.com/sol/hpack/issues/188
dependencies: # dependencies:
- hledger-lib # - hledger-lib

100
hledger/Hledger/Cli/Commands.hs
View File

@ -55,9 +55,8 @@ import Data.Monoid ((<>))
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
import Data.Time.Calendar import Data.Time.Calendar
import qualified EasyTest import System.Environment (withArgs)
import System.Console.CmdArgs.Explicit as C import System.Console.CmdArgs.Explicit as C
import System.Exit
import Hledger import Hledger
import Hledger.Cli.CliOptions import Hledger.Cli.CliOptions
@ -267,19 +266,14 @@ testmode = hledgerCommandMode
-- not be used (and would raise an error). -- not be used (and would raise an error).
testcmd :: CliOpts -> Journal -> IO () testcmd :: CliOpts -> Journal -> IO ()
testcmd opts _undefined = do testcmd opts _undefined = do
let args = words' $ query_ $ reportopts_ opts withArgs (words' $ query_ $ reportopts_ opts) $
-- workaround for https://github.com/joelburget/easytest/issues/11 defaultMain $ tests "sometests" [ -- Test.Tasty.defaultMain from Hledger.Util.Tests
-- import System.IO (hSetEncoding, stdout, stderr, utf8) tests_Hledger
-- hSetEncoding stdout utf8 ,tests "Hledger.Cli" [
-- hSetEncoding stderr utf8 tests_Cli_Utils
e <- runEasytests args $ EasyTest.tests [ ,tests_Commands
tests_Hledger ]
,tests "Hledger.Cli" [
tests_Cli_Utils
,tests_Commands
] ]
]
if e then exitFailure else exitSuccess
tests_Commands = tests "Commands" [ tests_Commands = tests "Commands" [
@ -288,60 +282,62 @@ tests_Commands = tests "Commands" [
-- some more tests easiest to define here: -- some more tests easiest to define here:
,test "apply account directive" $ do ,test "apply account directive" $ let
let ignoresourcepos j = j{jtxns=map (\t -> t{tsourcepos=nullsourcepos}) (jtxns j)} 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) sameParse str1 str2 = testCaseSteps "sometest" $ \_step -> do
j2 <- io $ readJournal def Nothing str2 >>= either error' (return . ignoresourcepos) j1 <- readJournal def Nothing str1 >>= either error' (return . ignoresourcepos)
j1 `is` j2{jlastreadtime=jlastreadtime j1, jfiles=jfiles j1} --, jparsestate=jparsestate j1} j2 <- readJournal def Nothing str2 >>= either error' (return . ignoresourcepos)
sameParse j1 @?= j2{jlastreadtime=jlastreadtime j1, jfiles=jfiles j1} --, jparsestate=jparsestate j1}
("2008/12/07 One\n alpha $-1\n beta $1\n" <> in sameParse
"apply account outer\n2008/12/07 Two\n aigh $-2\n bee $2\n" <> ("2008/12/07 One\n alpha $-1\n beta $1\n" <>
"apply account inner\n2008/12/07 Three\n gamma $-3\n delta $3\n" <> "apply account outer\n2008/12/07 Two\n aigh $-2\n bee $2\n" <>
"end apply account\n2008/12/07 Four\n why $-4\n zed $4\n" <> "apply account inner\n2008/12/07 Three\n gamma $-3\n delta $3\n" <>
"end apply account\n2008/12/07 Five\n foo $-5\n bar $5\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 One\n alpha $-1\n beta $1\n" <>
"2008/12/07 Three\n outer:inner:gamma $-3\n outer:inner:delta $3\n" <> "2008/12/07 Two\n outer:aigh $-2\n outer:bee $2\n" <>
"2008/12/07 Four\n outer:why $-4\n outer:zed $4\n" <> "2008/12/07 Three\n outer:inner:gamma $-3\n outer:inner:delta $3\n" <>
"2008/12/07 Five\n foo $-5\n bar $5\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 ,testCaseSteps "apply account directive should preserve \"virtual\" posting type" $ \_step -> do
j <- io $ readJournal def Nothing "apply account test\n2008/12/07 One\n (from) $-1\n (to) $1\n" >>= either error' return 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 let p = head $ tpostings $ head $ jtxns j
paccount p `is` "test:from" paccount p @?= "test:from"
ptype p `is` VirtualPosting ptype p @?= VirtualPosting
,test "account aliases" $ do ,testCaseSteps "account aliases" $ \_step -> do
j <- io $ readJournal def Nothing "!alias expenses = equity:draw:personal\n1/1\n (expenses:food) 1\n" >>= either error' return 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 let p = head $ tpostings $ head $ jtxns j
paccount p `is` "equity:draw:personal:food" paccount p @?= "equity:draw:personal:food"
,test "ledgerAccountNames" $ ,testCase "ledgerAccountNames" $
ledgerAccountNames ledger7 `is` (ledgerAccountNames ledger7)
["assets","assets:cash","assets:checking","assets:saving","equity","equity:opening balances", @?=
"expenses","expenses:food","expenses:food:dining","expenses:phone","expenses:vacation", ["assets","assets:cash","assets:checking","assets:saving","equity","equity:opening balances",
"liabilities","liabilities:credit cards","liabilities:credit cards:discover"] "expenses","expenses:food","expenses:food:dining","expenses:phone","expenses:vacation",
"liabilities","liabilities:credit cards","liabilities:credit cards:discover"]
-- ,test "journalCanonicaliseAmounts" ~: -- ,test "journalCanonicaliseAmounts" ~:
-- "use the greatest precision" ~: -- "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 -- don't know what this should do
-- ,test "elideAccountName" ~: do -- ,test "elideAccountName" ~: do
-- (elideAccountName 50 "aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa" -- (elideAccountName 50 "aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa"
-- `is` "aa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa") -- @?= "aa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa")
-- (elideAccountName 20 "aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa" -- (elideAccountName 20 "aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa"
-- `is` "aa:aa:aaaaaaaaaaaaaa") -- @?= "aa:aa:aaaaaaaaaaaaaa")
,test "default year" $ do ,testCaseSteps "default year" $ \_step -> do
j <- io $ readJournal def Nothing defaultyear_journal_txt >>= either error' return j <- readJournal def Nothing defaultyear_journal_txt >>= either error' return
tdate (head $ jtxns j) `is` fromGregorian 2009 1 1 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"
] ]

6
hledger/Hledger/Cli/Commands/Balance.hs
View File

@ -640,10 +640,10 @@ balanceReportTableAsText ropts = tableAsText ropts showamt
tests_Balance = tests "Balance" [ tests_Balance = tests "Balance" [
tests "balanceReportAsText" [ tests "balanceReportAsText" [
test "unicode in balance layout" $ do testCaseSteps "unicode in balance layout" $ \_step -> do
j <- io $ readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n" j <- readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n"
let opts = defreportopts 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 unlines
[" -100 актив:наличные" [" -100 актив:наличные"
," 100 расходы:покупки" ," 100 расходы:покупки"

6
hledger/Hledger/Cli/Commands/Register.hs
View File

@ -194,10 +194,10 @@ postingsReportItemAsText opts preferredamtwidth preferredbalwidth (mdate, mendda
tests_Register = tests "Register" [ tests_Register = tests "Register" [
tests "postingsReportAsText" [ tests "postingsReportAsText" [
test "unicode in register layout" $ do testCaseSteps "unicode in register layout" $ \_step -> do
j <- io $ readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n" j <- readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n"
let opts = defreportopts 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" ["2009/01/01 медвежья шкура расходы:покупки 100 100"
," актив:наличные -100 0"] ," актив:наличные -100 0"]
] ]

6
hledger/hledger.cabal
View File

@ -4,7 +4,7 @@ cabal-version: 1.12
-- --
-- see: https://github.com/sol/hpack -- see: https://github.com/sol/hpack
-- --
-- hash: 6bdd5e55ef3db9761bde530f23cd7fe97dc63e707e18129732a4d827505c6aa4 -- hash: a8cb399c2c97d23c9fc48e12709494216df3069cce7ec448277be8fde91f72d0
name: hledger name: hledger
version: 1.15.99 version: 1.15.99
@ -156,7 +156,6 @@ library
, containers , containers
, data-default >=0.5 , data-default >=0.5
, directory , directory
, easytest >=0.2.1 && <0.3
, extra >=1.6.3 , extra >=1.6.3
, filepath , filepath
, hashable >=1.2.4 , hashable >=1.2.4
@ -208,7 +207,6 @@ executable hledger
, containers , containers
, data-default >=0.5 , data-default >=0.5
, directory , directory
, easytest >=0.2.1 && <0.3
, extra >=1.6.3 , extra >=1.6.3
, filepath , filepath
, haskeline >=0.6 , haskeline >=0.6
@ -260,7 +258,6 @@ test-suite test
, containers , containers
, data-default >=0.5 , data-default >=0.5
, directory , directory
, easytest >=0.2.1 && <0.3
, extra >=1.6.3 , extra >=1.6.3
, filepath , filepath
, haskeline >=0.6 , haskeline >=0.6
@ -312,7 +309,6 @@ benchmark bench
, criterion , criterion
, data-default >=0.5 , data-default >=0.5
, directory , directory
, easytest >=0.2.1 && <0.3
, extra >=1.6.3 , extra >=1.6.3
, filepath , filepath
, haskeline >=0.6 , haskeline >=0.6

1
hledger/package.yaml
View File

@ -115,7 +115,6 @@ dependencies:
- data-default >=0.5 - data-default >=0.5
- Decimal - Decimal
- directory - directory
- easytest >= 0.2.1 && <0.3
- extra >=1.6.3 - extra >=1.6.3
- filepath - filepath
- haskeline >=0.6 - haskeline >=0.6