qif-1.1.0: Test.hs
{-# LANGUAGE OverloadedStrings #-}
import Control.Monad(replicateM)
import Data.Attoparsec.Text(Parser)
import Data.Attoparsec.Text.Lazy(Result(..),parse)
import Data.Char(isPrint)
import Data.QIF
import Data.String(fromString)
import qualified Data.Text as S
import Data.Text.Lazy(Text)
import Data.Text.Lazy.Builder(Builder, toLazyText)
import Data.Time(Day(..), fromGregorian, addDays)
import Lens.Micro(set)
import Test.QuickCheck
import Test.Tasty(TestTree, testGroup, defaultMain)
import Test.Tasty.HUnit(testCase, (@=?))
import Test.Tasty.QuickCheck(testProperty)
import Debug.Trace
main :: IO ()
main = defaultMain $ testGroup "All Tests" [
testBasics
, testBlocks
, testLists
]
-- -----------------------------------------------------------------------------
testBasics :: TestTree
testBasics =
testGroup "Basic constants" [
testQuantities
, testDates
, testSecurityType
]
testQuantities :: TestTree
testQuantities =
testGroup "Simple Quantities" [
testGroup "Currency" [
testCase "1.25" (1.25 @=? (runP parseCurrency "1.25"))
, testCase "$1.25" (1.25 @=? (runP parseCurrency "$1.25"))
, testCase "-1.25" (-1.25 @=? (runP parseCurrency "-1.25"))
, testCase "-$1.25" (-1.25 @=? (runP parseCurrency "-$1.25"))
, testCase "-$1.2" (-1.2 @=? (runP parseCurrency "-$1.2"))
, testCase "-$1." (-1 @=? (runP parseCurrency "-$1."))
, testCase "-1" (-1 @=? (runP parseCurrency "-1"))
, testCase "-1.2" (-1.2 @=? (runP parseCurrency "-1.2"))
, testCase "-1.0" (-1 @=? (runP parseCurrency "-1.0"))
, testCase "1.1" (1.1 @=? (runP parseCurrency "1.1"))
, testCase "1." (1 @=? (runP parseCurrency "1."))
, testProperty "Currency Serialization" currencySerialization
],
testGroup "Share Quantities" [
testCase "-3.0351" (-3.0351 @=? (runP parseShareQuantity "-3.0351"))
, testCase "-3.035" (-3.035 @=? (runP parseShareQuantity "-3.035"))
, testCase "-3.03" (-3.03 @=? (runP parseShareQuantity "-3.03"))
, testCase "-3.3" (-3.3 @=? (runP parseShareQuantity "-3.3"))
, testCase "-3." (-3 @=? (runP parseShareQuantity "-3."))
, testCase "-3" (-3 @=? (runP parseShareQuantity "-3"))
, testCase "3.0351" (3.0351 @=? (runP parseShareQuantity "3.0351"))
, testCase "3.035" (3.035 @=? (runP parseShareQuantity "3.035"))
, testCase "3.03" (3.03 @=? (runP parseShareQuantity "3.03"))
, testCase "3.3" (3.3 @=? (runP parseShareQuantity "3.3"))
, testCase "3." (3 @=? (runP parseShareQuantity "3."))
, testCase "3" (3 @=? (runP parseShareQuantity "3"))
, testProperty "Share quantity serialization"
(standardSerializer parseShareQuantity renderShareQuantity)
]
]
testDates :: TestTree
testDates = testGroup "Dates" [
testCase "12/12/15" (fromGregorian 2015 12 12 @=? runP parseDate "12/12/15")
, testCase "5/14/15" (fromGregorian 2015 5 14 @=? runP parseDate "5/14/15")
, testCase "3/4/00" (fromGregorian 2000 3 4 @=? runP parseDate "3/4/00")
, testCase "10/5/13" (fromGregorian 2013 10 5 @=? runP parseDate "10/5/13")
, testProperty "Date serialization"
(standardSerializer parseDate renderDate)
]
testSecurityType :: TestTree
testSecurityType = testGroup "Security types" [
testCase "Stock Option"
(StockOption @=? runP parseSecurityType "Stock Option")
, testCase "Bond"
(Bond @=? runP parseSecurityType "Bond")
, testCase "CD"
(CD @=? runP parseSecurityType "CD")
, testCase "Mutual Fund"
(MutualFund @=? runP parseSecurityType "Mutual Fund")
, testCase "Index"
(Index @=? runP parseSecurityType "Index")
, testCase "ETF"
(ETF @=? runP parseSecurityType "ETF")
, testCase "Money Market Fund"
(MoneyMarket @=? runP parseSecurityType "Money Market Fund")
, testCase "Precious Metal"
(PreciousMetal @=? runP parseSecurityType "Precious Metal")
, testCase "Commodity"
(Commodity @=? runP parseSecurityType "Commodity")
, testCase "Stock"
(Stock @=? runP parseSecurityType "Stock")
, testProperty "Security type serialization"
(standardSerializer parseSecurityType renderSecurityType)
]
-- -----------------------------------------------------------------------------
testBlocks :: TestTree
testBlocks =
testGroup "Standard Blocks" [
testSecurity
, testAccount
, testCategory
, testTransaction
, testInvTransaction
]
testSecurity :: TestTree
testSecurity =
testGroup "Security Block" [
testCase "Alaska Airlines"
(security "Alaska Air Group, Inc" "ALK" Stock Nothing @=?
runP parseSecurity "NAlaska Air Group, Inc\nSALK\nTStock\n^\n")
, testCase "Vanguard S&P"
(security "Vanguard S&P 500 Index,Investor Shares" "VFINX"
MutualFund Nothing
@=?
runP parseSecurity
"NVanguard S&P 500 Index,Investor Shares\nSVFINX\nTMutual Fund\n^\n")
, testCase "Vanguard ETF"
(security "Vanguard ETF" "VET" ETF (Just "House") @=?
runP parseSecurity "NVanguard ETF\nSVET\nTETF\nGHouse\n^\n")
, testProperty "Security block serialization"
(standardSerializer parseSecurity renderSecurity)
]
security :: S.Text -> S.Text -> SecurityType -> Maybe S.Text -> Security
security n t y g =
set secName n $
set secTicker t $
set secType y $
set secGoal g emptySecurity
testAccount :: TestTree
testAccount =
testGroup "Accounts" [
testCase "Umpqua Account"
(account "Umpqua Bank" BankAccount "Checking" Nothing Nothing 1234.12 @=?
runP parseAccount "NUmpqua Bank\nDChecking\nX\nTBank\nB$1234.12\n^\n")
, testCase "Blue Bank"
(account "Blue Bank" CreditCardAccount "" (Just 40)
(Just (fromGregorian 2012 2 14)) (-520)
@=?
runP parseAccount
"NBlue Bank\nD\nX\nTCCard\n/2/14/12\nL40.0\nB-$520.\n^\n")
, testProperty "Account serialization"
(standardSerializer parseAccount renderAccount)
, testProperty "Account header serialization"
(standardSerializer parseAccountHeader renderAccountHeader)
]
account :: S.Text -> AccountType -> S.Text ->
Maybe Currency -> Maybe Day -> Currency ->
Account
account n t d cl bd b =
set accountName n $
set accountType t $
set accountDescription d $
set accountCreditLimit cl $
set accountBalanceDate bd $
set accountBalance b emptyAccount
testCategory :: TestTree
testCategory =
testGroup "Categories" [
testCase "Auto"
(category "Auto" "Automobile-related expenses" Expense False Nothing Nothing @=?
runP parseCategory "NAuto\nDAutomobile-related expenses\nE\n^\n")
, testCase "Registration"
(category "Registration" "" Expense True Nothing (Just 535) @=?
runP parseCategory "NRegistration\nD\nT\nE\nR535\n^\n")
, testCase "Salary"
(category "Salary" "Income" Income True Nothing Nothing @=?
runP parseCategory "NSalary\nDIncome\nT\nI\n^\n")
, testCase "Dinner"
(category "Dinner" "Yum yum" Expense False (Just 200) Nothing @=?
runP parseCategory "NDinner\nDYum yum\nE\nB200.\n^\n")
, testProperty "Category serialization"
(standardSerializer parseCategory renderCategory)
]
category :: S.Text -> S.Text -> CategoryKind -> Bool ->
Maybe Currency -> Maybe Word ->
Category
category n d k itr ba tsi =
set catName n $
set catDescription d $
set catKind k $
set catIsTaxRelated itr $
set catBudgetAmount ba $
set catTaxScheduleInfo tsi emptyCategory
testTransaction :: TestTree
testTransaction =
testGroup "Transactions" [
testCase "Roost"
(transaction (fromGregorian 2012 2 14) "Roost" "Yay fun" (-25) Nothing
(Just "Dining") True False [] @=?
(runP parseTransaction
"D2/14/12\nPRoost\nMYay fun\nT-25\nCX\nLDining\n^\n"))
, testCase "Uncleared Roost"
(transaction (fromGregorian 2012 2 14) "Roost" "Yay fun" (-25) Nothing
(Just "Dining") False False [] @=?
(runP parseTransaction
"D2/14/12\nPRoost\nMYay fun\nT-25.\nLDining\n^\n"))
, testCase "Business Roost"
(transaction (fromGregorian 2012 2 14) "Roost" "Yay fun" (-25) Nothing
(Just "Dining") True True [] @=?
(runP parseTransaction
"D2/14/12\nPRoost\nMYay fun\nT-25.00\nCX\nF\nLDining\n^\n"))
, testCase "Paycheck"
(transaction (fromGregorian 2018 3 4) "Galois" "" 50 Nothing Nothing
True False [set entryAmount (-30) $
set entryCategory "Checking" emptySplitItem,
set entryAmount (-20) $
set entryCategory "Savings" emptySplitItem] @=?
(runP parseTransaction
"D3/4/18\nPGalois\nM\nT50.0\nCX\nSChecking\nE\n$-30.0\nSSavings\nE\n$-20\n^\n"))
, testProperty "Transaction serialization"
(standardSerializer parseTransaction renderTransaction)
]
transaction :: Day -> S.Text -> S.Text -> Currency ->
Maybe Word -> Maybe S.Text -> Bool -> Bool -> [SplitItem] ->
Transaction
transaction d p m a n c l r s =
set entDate d $
set entParty p $
set entMemo m $
set entAmount a $
set entNumber n $
set entCategory c $
set entCleared l $
set entReimbursable r $
set entSplits s emptyTransaction
testInvTransaction :: TestTree
testInvTransaction =
testGroup "Interest Transactions" [
testCase "Dividend"
(Dividend (set tradeSecurity "SEC" $
set tradeSharePrice Nothing $
set tradeQuantity (Just 0) $
set tradeCommission (Just 0) $
set tradeTotalAmount 0 (emptyTrade (fromGregorian 2065 7 7)))
@=?
(runP parseInvTransaction
"D7/7/65\nNDiv\nYSEC\nQ0\nO0.00\nT0\n^\n"))
, testCase "Dividend, with share price"
(Dividend (set tradeSecurity "SEC" $
set tradeSharePrice (Just 0) $
set tradeQuantity (Just 0) $
set tradeCommission (Just 0) $
set tradeTotalAmount 0 (emptyTrade (fromGregorian 2065 7 7)))
@=?
(runP parseInvTransaction
"D7/7/65\nNDiv\nYSEC\nI0\nQ0\nO0.00\nT0\n^\n"))
, testProperty "Interest transaction serialization"
(standardSerializer parseInvTransaction renderInvTransaction)
]
-- -----------------------------------------------------------------------------
testLists :: TestTree
testLists =
testGroup "Lists of structures" [
testProperty "Account List"
(standardSerializer parseAccountList renderAccountList)
, testProperty "Category List"
(standardSerializer parseCategoryList renderCategoryList)
, testProperty "Investment Entries"
(standardSerializer parseInvestmentEntries renderInvestmentEntries)
, testProperty "Bank Entries"
(standardSerializer parseBankEntryList renderBankEntryList)
, testProperty "Credit Card Entries"
(standardSerializer parseCreditCardEntryList renderCreditCardEntryList)
, testProperty "Asset Entries"
(standardSerializer parseAssetEntryList renderAssetEntryList)
, testProperty "Liability Entries"
(standardSerializer parseLiabilityEntryList renderLiabilityEntryList)
, testProperty "Security list"
(standardSerializer parseSecurityList renderSecurityList)
]
-- -----------------------------------------------------------------------------
currencySerialization :: Bool -> Currency -> Property
currencySerialization doDollar amt =
amt === (runP parseCurrency (runR (renderCurrency doDollar) amt))
standardSerializer :: (Eq a, Show a) =>
Parser a -> (a -> Builder) ->
a ->
Property
standardSerializer parser renderer x =
x === (runP parser (runR renderer x))
-- -----------------------------------------------------------------------------
runP :: Parser a -> Text -> a
runP parser txt = go (parse parser txt)
where
go (Fail _ _ err) = error ("Parser error: " ++ err)
go (Done _ res) = res
runR :: (a -> Builder) -> a -> Text
runR builder v = toLazyText (builder v)
-- -----------------------------------------------------------------------------
instance Arbitrary Day where
arbitrary =
do let base = fromGregorian 2000 1 1
x <- choose (0, 36524)
return (addDays x base)
instance Arbitrary SecurityType where
arbitrary = elements [ Stock, Bond, CD, MutualFund, Index, ETF, MoneyMarket,
PreciousMetal, Commodity, StockOption, Other ]
instance Arbitrary Security where
arbitrary =
do n <- arbitrary
t <- arbitrary
y <- arbitrary
g <- arbitrary
return $ set secName n
$ set secTicker t
$ set secType y
$ set secGoal g emptySecurity
instance Arbitrary S.Text where
arbitrary =
do len <- choose (0,150)
chrs <- replicateM len (suchThat arbitrary isPrint)
return (fromString chrs)
instance Arbitrary AccountType where
arbitrary = elements [ BankAccount, CashAccount, CreditCardAccount,
InvestmentAccount, AssetAccount, LiabilityAccount ]
instance Arbitrary Account where
arbitrary =
do (n, t, d, cl, bd, b) <- arbitrary
return $ set accountName n
$ set accountType t
$ set accountDescription d
$ set accountCreditLimit cl
$ set accountBalanceDate bd
$ set accountBalance b emptyAccount
instance Arbitrary Category where
arbitrary =
do k <- elements [Income, Expense]
(n, d, it, ba, ts) <- arbitrary
return $ set catName n
$ set catDescription d
$ set catKind k
$ set catIsTaxRelated it
$ set catBudgetAmount ba
$ set catTaxScheduleInfo ts emptyCategory
instance Arbitrary TradeInfo where
arbitrary =
do (d, s, p, q, c, a) <- arbitrary
day <- arbitrary
return $ set tradeDate d
$ set tradeSecurity s
$ set tradeSharePrice p
$ set tradeQuantity q
$ set tradeCommission c
$ set tradeTotalAmount a (emptyTrade day)
instance Arbitrary TransferInfo where
arbitrary =
do (d, s, m, a, c, t, p) <- arbitrary
day <- arbitrary
return $ set transDate d
$ set transSummary s
$ set transMemo m
$ set transAmount a
$ set transCleared c
$ set transAccount t
$ set transSplits p (emptyTransfer day)
instance Arbitrary InvTransaction where
arbitrary = oneof [ Buy <$> arbitrary
, Sell <$> arbitrary
, Transfer <$> arbitrary
, Dividend <$> arbitrary
, Interest <$> arbitrary <*> arbitrary
]
instance Arbitrary SplitItem where
arbitrary =
do (m, a, c) <- arbitrary
return $ set entryMemo m
$ set entryAmount a
$ set entryCategory c emptySplitItem
instance Arbitrary Transaction where
arbitrary =
do (d,p,m,a,n,c,l,r,s) <- arbitrary
return $ set entDate d
$ set entParty p
$ set entMemo m
$ set entAmount a
$ set entNumber n
$ set entCategory c
$ set entCleared l
$ set entReimbursable r
$ set entSplits s emptyTransaction
instance Arbitrary QIF where
arbitrary =
do (a, c, s, i, n) <- arbitrary
return $ set qifAccounts a
$ set qifCategories c
$ set qifSecurities s
$ set qifInvestmentTransactions i
$ set qifNormalTransactions n emptyQIF