diff --git a/Test.hs b/Test.hs --- a/Test.hs +++ b/Test.hs @@ -9,6 +9,7 @@ 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, (@=?)) @@ -120,29 +121,36 @@ testSecurity = testGroup "Security Block" [ testCase "Alaska Airlines" - (Security "Alaska Air Group, Inc" "ALK" Stock Nothing @=? + (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" + (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") @=? + (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 @=? + (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) + (account "Blue Bank" CreditCardAccount "" (Just 40) (Just (fromGregorian 2012 2 14)) (-520) @=? runP parseAccount @@ -153,63 +161,109 @@ (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 @=? + (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) @=? + (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 @=? + (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 @=? + (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 + (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 + (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 + (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 [SplitItem "" (-30) "Checking", - SplitItem "" (-20) "Savings"] @=? + (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 (TradeInfo (fromGregorian 2065 7 7) "SEC" Nothing (Just 0) (Just 0) 0) + (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 (TradeInfo (fromGregorian 2065 7 7) "SEC" (Just 0) (Just 0) (Just 0) 0) + (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")) @@ -229,7 +283,7 @@ , testProperty "Investment Entries" (standardSerializer parseInvestmentEntries renderInvestmentEntries) , testProperty "Bank Entries" - (standardSerializer parseTransactionList renderTransactionList) + (standardSerializer parseBankEntryList renderBankEntryList) , testProperty "Credit Card Entries" (standardSerializer parseCreditCardEntryList renderCreditCardEntryList) , testProperty "Asset Entries" @@ -277,8 +331,15 @@ PreciousMetal, Commodity, StockOption, Other ] instance Arbitrary Security where - arbitrary = Security <$> arbitrary <*> arbitrary <*> arbitrary - <*> arbitrary + 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 = @@ -291,21 +352,48 @@ InvestmentAccount, AssetAccount, LiabilityAccount ] instance Arbitrary Account where - arbitrary = Account <$> arbitrary <*> arbitrary <*> arbitrary - <*> arbitrary <*> arbitrary <*> arbitrary + 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 = Category <$> arbitrary <*> arbitrary <*> elements [Income,Expense] - <*> arbitrary <*> arbitrary <*> arbitrary + 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 = TradeInfo <$> arbitrary <*> arbitrary <*> arbitrary - <*> arbitrary <*> arbitrary <*> arbitrary + 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 = TransferInfo <$> arbitrary <*> arbitrary <*> arbitrary - <*> arbitrary <*> arbitrary <*> arbitrary - <*> arbitrary + 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 @@ -316,9 +404,31 @@ ] instance Arbitrary SplitItem where - arbitrary = SplitItem <$> arbitrary <*> arbitrary <*> arbitrary + arbitrary = + do (m, a, c) <- arbitrary + return $ set entryMemo m + $ set entryAmount a + $ set entryCategory c emptySplitItem instance Arbitrary Transaction where - arbitrary = Transaction <$> arbitrary <*> arbitrary <*> arbitrary - <*> arbitrary <*> arbitrary <*> arbitrary - <*> arbitrary <*> arbitrary <*> arbitrary + 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 + diff --git a/qif.cabal b/qif.cabal --- a/qif.cabal +++ b/qif.cabal @@ -1,5 +1,5 @@ name: qif -version: 1.0.0 +version: 1.1.0 synopsis: A simple QIF file format parser / printer description: A handy little library for dealing with this awful little QIF files in your life. @@ -32,12 +32,14 @@ test-suite test-qif-serialization type: exitcode-stdio-1.0 main-is: Test.hs + ghc-options: -Wall default-language: Haskell2010 other-extensions: OverloadedStrings build-depends: attoparsec >= 0.13 && < 0.15, base >= 4.7 && < 4.10, QuickCheck >= 2.9 && < 3.0, + microlens >= 0.4.7 && < 0.6, tasty >= 0.11 && < 0.15, tasty-hunit >= 0.9 && < 0.12, tasty-quickcheck >= 0.8 && < 0.12, diff --git a/src/Data/QIF.hs b/src/Data/QIF.hs --- a/src/Data/QIF.hs +++ b/src/Data/QIF.hs @@ -1,7 +1,110 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE TemplateHaskell #-} -module Data.QIF +-- |A module for parsing or rendering QIF files. +-- +-- QIF is a fairly braindead format designed for transfering financial data +-- between applications. If you're writing a new financial application, you +-- might want to find a newer format to share with other applications (if you +-- can find one), and you definitely shouldn't use this as the database. For one +-- thing, this format uses two-digit years, which is just kind of lazy. Also, it +-- enforces absolutely no consistency constraints in terms of cross-references +-- or transaction sums. +-- +-- To parse a QIF file, I suggest using "Data.Attoparsec.Text.Lazy" and a lazy +-- 'Text' data structure, as follows: +-- +-- @ +-- do txt <- Text.pack `fmap` readFile "my.qif" +-- case parse parseQIF txt of +-- Fail around _ err -> +-- fail ("Parse error (" ++ err ++ ") around :" ++ +-- show (Text.take 10 around)) +-- Done _ res -> +-- somethingInteresting res +-- @ +-- +-- To render a QIF file, you can run the builders from "Data.Text.LazyBuilder" +-- directly, as so: +-- +-- @ +-- Data.Text.Lazy.IO.writeFile "my.qif" (toLazyText (renderQIF myQIF)) +-- @ +-- +module Data.QIF( + QIF, emptyQIF + , qifAccounts, qifCategories + , qifSecurities, qifInvestmentTransactions + , qifNormalTransactions + , parseQIF, renderQIF + -- * Various lists in QIF + , parseAccountList, renderAccountList + , parseCategoryList, renderCategoryList + , parseBankEntryList, renderBankEntryList + , parseInvestmentEntries, renderInvestmentEntries + , parseCashEntryList, renderCashEntryList + , parseCreditCardEntryList, renderCreditCardEntryList + , parseAssetEntryList, renderAssetEntryList + , parseLiabilityEntryList, renderLiabilityEntryList + , parseSecurityList, renderSecurityList + -- * Account Information + , Account, emptyAccount + , accountName, accountType + , accountDescription, accountCreditLimit + , accountBalanceDate, accountBalance + , parseAccount, renderAccount + , AccountType(..), parseAccountType, renderAccountType + , parseShortAccountType, renderShortAccountType + , parseAccountHeader, renderAccountHeader + -- * Category Information + , CategoryKind(..) + , Category, emptyCategory + , catName, catDescription + , catKind, catIsTaxRelated + , catBudgetAmount, catTaxScheduleInfo + , parseCategory, renderCategory + -- * Transaction Information + , SplitItem, emptySplitItem + , entryMemo, entryAmount + , entryCategory + , parseSplit, renderSplit + -- ** Standard Transactions (Bank, Credit Card, etc.) + , Transaction, emptyTransaction + , entDate, entParty + , entMemo, entAmount + , entNumber, entCategory + , entCleared, entReimbursable + , entSplits + , parseTransaction, renderTransaction + -- ** Investment Account Transactions + -- *** Trade Information + , TradeInfo, emptyTrade + , tradeDate, tradeSecurity + , tradeSharePrice, tradeQuantity + , tradeCommission, tradeTotalAmount + -- *** Transfer Information + , TransferInfo, emptyTransfer + , transDate, transSummary + , transMemo, transAmount + , transCleared, transAccount + , transSplits + -- *** Actual Investment Actions + , InvTransaction(..) + , invEntDate + , parseInvTransaction, renderInvTransaction + -- * Security Types + , SecurityType(..), parseSecurityType, renderSecurityType + , Security, emptySecurity + , secName, secTicker + , secType, secGoal + , parseSecurity, renderSecurity + -- * Fixed-width quantities + , Currency, parseCurrency, renderCurrency + , ShareQuantity, parseShareQuantity, renderShareQuantity + , parseQuantity, renderQuantity + -- * Old-school dates + , parseDate, renderDate + ) where import Control.Monad(when) @@ -20,7 +123,7 @@ import Data.Word(Word) import Lens.Micro(Lens',ASetter',lens,set,over) import Lens.Micro.Extras(view) -import Lens.Micro.TH(makeLenses) +import Lens.Micro.TH(makeLensesWith,lensRules,generateSignatures) -- Fixed-width Quantities: Currency and Share Counts --------------------------- @@ -28,9 +131,17 @@ instance HasResolution E4 where resolution _ = 10000 +-- |A fixed width implementation of currency, based on the U.S. dollar. Future +-- versions of this library that wish to support other currencies may wish to +-- change this, or to abstract the rest of the library over a currency type. type Currency = Fixed E2 + +-- |A fixed-width implementation of quantities for shares. So far, I have seen +-- sites report share quantities to up to four decimal points, henced the value. type ShareQuantity = Fixed E4 +-- |Parse a fixed-width number. Should parse negative values, as well. This does +-- support QIF's annoying "5." notation, as well. parseQuantity :: HasResolution a => Parser (Fixed a) parseQuantity = do finally <- option id (char '-' >> return negate) @@ -54,9 +165,15 @@ do d <- digitToNum `fmap` digit afterPoint (acc + (d / place)) (place * 10) +-- |Render a quantity. As opposed to the parser, this output function will +-- always represent numbers to their full precision. renderQuantity :: HasResolution a => Fixed a -> Builder renderQuantity = fromString . show +-- |Parse a currency. This is slightly differentiated from 'parseQuantity' in +-- that it will happily ignore a dollar sign placed in the correct location. +-- Note that this will support negative amounts written as either \"-$500\" or +-- as \"$-500\". parseCurrency :: Parser Currency parseCurrency = do finally <- option id (char '-' *> return negate) -- kept to deal with -$1 @@ -64,15 +181,21 @@ amount <- parseQuantity return (finally amount) +-- |Render a currency. The boolean state whether or not to include a dollar +-- sign. When dollar signs are included, negatives are written as \"-$500\" +-- rather than \"$-500\". renderCurrency :: Bool -> Currency -> Builder renderCurrency showDollar x = neg <> (if showDollar then singleton '$' else mempty) <> renderQuantity x' where (x',neg) = if x < 0 then (negate x, singleton '-') else (x,mempty) + +-- |Parse a share quantity. Currently an alias for 'parseQuantity'. parseShareQuantity :: Parser ShareQuantity parseShareQuantity = parseQuantity +-- |Render a share quantity. Currently an alias for 'renderQuantity'. renderShareQuantity :: ShareQuantity -> Builder renderShareQuantity = renderQuantity @@ -81,6 +204,7 @@ -- Account Types --------------------------------------------------------------- +-- |The type of an account; should be fairly self-explanatory. data AccountType = BankAccount | CashAccount | CreditCardAccount @@ -89,9 +213,13 @@ | LiabilityAccount deriving (Eq, Read, Show) +-- |Parse a fully-rendered account type (e.g, \"!Type:Bank\"), used for +-- section headings. parseAccountType :: Parser AccountType parseAccountType = string "!Type:" *> parseShortAccountType +-- |Parse the short version of an account type (e.g., "Bank"), which is used in +-- a couple different places. parseShortAccountType :: Parser AccountType parseShortAccountType = choice [ string "Bank" *> return BankAccount @@ -102,9 +230,12 @@ , string "Oth L" *> return LiabilityAccount ] +-- |Render a fully-rendered account type (e.g., \"!Type:Bank\"), used for +-- section headings. renderAccountType :: AccountType -> Builder renderAccountType acc = fromText "!Type:" <> renderShortAccountType acc +-- |Render the short version of an account type (e.g., \"Bank\"). renderShortAccountType :: AccountType -> Builder renderShortAccountType BankAccount = fromText "Bank" renderShortAccountType CashAccount = fromText "Cash" @@ -115,6 +246,8 @@ -- Accounts -------------------------------------------------------------------- +-- |An account in the QIF file. This same structure applies for all the account +-- types. data Account = Account { _accountName :: Text , _accountType :: AccountType @@ -125,11 +258,24 @@ } deriving (Eq, Show) -pennies :: Currency -> Integer -pennies x = truncate (x * 100.0) +makeLensesWith (set generateSignatures False lensRules) ''Account -makeLenses ''Account +-- |The name of the account +accountName :: Lens' Account Text +-- |The type of the account +accountType :: Lens' Account AccountType +-- |The description of the account; in my limited experience this can (and most +-- likely will) be empty. +accountDescription :: Lens' Account Text +-- |For accounts with limits, the credit limit for the account. +accountCreditLimit :: Lens' Account (Maybe Currency) +-- |The date at which the balance in the next field was current. +accountBalanceDate :: Lens' Account (Maybe Day) +-- |The current balance. +accountBalance :: Lens' Account Currency +-- |A blank account. Defaults to 'BankAccount' for the type, with the obvious +-- zeros, empty strings, and Nothings elsewhere. emptyAccount :: Account emptyAccount = Account { _accountName = "" @@ -140,6 +286,7 @@ , _accountBalance = 0 } +-- |Parse an account. parseAccount :: Parser Account parseAccount = go emptyAccount where @@ -172,6 +319,7 @@ parseString :: Parser Text parseString = Atto.takeWhile (not . inClass "\r\n") +-- |Render an account. renderAccount :: Account -> Builder renderAccount acc = mconcat [ put 'N' acc accountName fromText @@ -201,6 +349,12 @@ -- Dates ----------------------------------------------------------------------- +-- |Parse a date, using old-school, incredibly unwise, \"mm/dd/yy\" formats. To +-- simplify my life, this assumes that all dates start in 2000, rather than in +-- 1970 or some other date. Thus, if you have data going back before 2000, +-- you'll need to post-process this to the appropriate date, by subtracting 100 +-- appropriately. Hopefully by 2100 noone will be using QIF anymore, and this +-- won't matter. parseDate :: Parser Day parseDate = do str <- Atto.takeWhile isPrint @@ -210,11 +364,13 @@ then return (fromGregorian (2000 + (year `mod` 100)) mon day) else return intime +-- |Render the date in QIF's silly format. renderDate :: Day -> Builder renderDate = fromString . formatTime defaultTimeLocale "%-m/%e/%y" -- ----------------------------------------------------------------------------- +-- |Parse the list of accounts associated with this QIF file. parseAccountList :: Parser [Account] parseAccountList = do _ <- string "!Option:AutoSwitch" *> many1 endOfLine @@ -223,6 +379,7 @@ _ <- string "!Clear:AutoSwitch" *> many1 endOfLine return accs +-- |Render the list of accounts associated with this QIF file. renderAccountList :: [Account] -> Builder renderAccountList accs = fromString "!Option:AutoSwitch\n" <> @@ -232,6 +389,7 @@ -- Categories ------------------------------------------------------------------ +-- |Information about a category that one might mark a transaction against. data Category = Category { _catName :: Text , _catDescription :: Text @@ -242,9 +400,11 @@ } deriving (Eq, Show) +-- |Whether a category is an income category or an expense category. data CategoryKind = Income | Expense deriving (Eq, Show) +-- |A blank category. We default categories to 'Expense'. emptyCategory :: Category emptyCategory = Category { _catName = "" @@ -255,8 +415,22 @@ , _catTaxScheduleInfo = Nothing } -makeLenses ''Category +makeLensesWith (set generateSignatures False lensRules) ''Category +-- |The name of the category. +catName :: Lens' Category Text +-- |A description of the category in question. Often empty. +catDescription :: Lens' Category Text +-- |The kind of category; 'Expense' or 'Income' +catKind :: Lens' Category CategoryKind +-- |Whether or not this category might be tax-related. +catIsTaxRelated :: Lens' Category Bool +-- |A budget amount, if a budget has been established and published. +catBudgetAmount :: Lens' Category (Maybe Currency) +-- |A number describing the tax schedule to look at. +catTaxScheduleInfo :: Lens' Category (Maybe Word) + +-- |Parse a category. parseCategory :: Parser Category parseCategory = go emptyCategory where @@ -275,6 +449,7 @@ '^' -> many1 endOfLine *> return base _ -> fail "Unknown, out of scope category label." +-- |Render a category. renderCategory :: Category -> Builder renderCategory cat = mconcat [ put 'N' cat catName fromText @@ -288,12 +463,15 @@ -- Category Lists -------------------------------------------------------------- +-- |Parse the list of categories (and the header for said list). parseCategoryList :: Parser [Category] parseCategoryList = do _ <- string "!Type:Cat" _ <- many1 endOfLine many' parseCategory +-- |Render the header for the list of categories followed by each of the +-- categories. renderCategoryList :: [Category] -> Builder renderCategoryList cats = fromString "!Type:Cat\n" <> mconcat (map renderCategory cats) @@ -301,17 +479,26 @@ -- Account Headers ------------------------------------------------------------- +-- |Sections full of transactions start with the header demarcating what account +-- the transactions are in regard to. This parses that header, returning the +-- account. Note that if you were expecting to be a somewhat reasonable +-- standard, and just reference a previously-defined account, you're in for a +-- disappointment. This is a completely fresh 'Account' structure, and you'll +-- have to match things up (and merge any differences) yourself. parseAccountHeader :: Parser Account parseAccountHeader = do _ <- string "!Account" _ <- many1 endOfLine parseAccount +-- |Render the header that should proceed any list of transactions. renderAccountHeader :: Account -> Builder renderAccountHeader acc = fromString "!Account\n" <> renderAccount acc -- Bank Entries ---------------------------------------------------------------- +-- |When a single transaction is split across a couple categories, this is your +-- friend. data SplitItem = SplitItem { _entryMemo :: Text , _entryAmount :: Currency @@ -319,9 +506,20 @@ } deriving (Eq, Show) +-- |An empty 'SplitItem'. No texts, no money. So sad. emptySplitItem :: SplitItem emptySplitItem = SplitItem "" 0 "" +makeLensesWith (set generateSignatures False lensRules) ''SplitItem + +-- |Any memo taken as part of this split. +entryMemo :: Lens' SplitItem Text +-- |The amount of money in this split. +entryAmount :: Lens' SplitItem Currency +-- |The category associated with this split. +entryCategory :: Lens' SplitItem Text + +-- |A normal transaction, that doesn't include an action in the stock market. data Transaction = Transaction { _entDate :: Day , _entParty :: Text @@ -335,13 +533,36 @@ } deriving (Eq, Show) +-- |A transaction with no real data, that happened to occur on January 1st, +-- 2000. Happy new year! emptyTransaction :: Transaction emptyTransaction = Transaction (fromGregorian 2000 1 1) "" "" 0 Nothing Nothing False False [] -makeLenses ''SplitItem -makeLenses ''Transaction +makeLensesWith (set generateSignatures False lensRules) ''Transaction +-- |The date of the transaction. +entDate :: Lens' Transaction Day +-- |The other party to the transaction. +entParty :: Lens' Transaction Text +-- |Any memos taken about the transaction. +entMemo :: Lens' Transaction Text +-- |The total amount of the transaction. +entAmount :: Lens' Transaction Currency +-- |The check or other number, as appropriate. +entNumber :: Lens' Transaction (Maybe Word) +-- |The category associated with the transaction, if provided. +entCategory :: Lens' Transaction (Maybe Text) +-- |Whether or not this transaction has cleared. +entCleared :: Lens' Transaction Bool +-- |Whether or not this transaction is reimbursable. +entReimbursable :: Lens' Transaction Bool +-- |Any splits assocaited with this transaction. +entSplits :: Lens' Transaction [SplitItem] + +-- |Parse a transaction. Note that this function only does parsing, not +-- consistency checking. Thus, you may end up with a transaction whose splits do +-- not sum to the total transaction amount, or is missing a category, etc. parseTransaction :: Parser Transaction parseTransaction = go emptyTransaction where @@ -365,7 +586,9 @@ '^' -> many1 endOfLine *> return base _ -> fail "Unknown, out of scope bank entry label." - +-- |Render a transaction. This function assumes that you have performed any +-- consistency checking you're going to do before writing out this transaction. +-- It won't do any for you. renderTransaction :: Transaction -> Builder renderTransaction be = put 'D' be entDate renderDate <> @@ -380,6 +603,9 @@ singleton '^' <> newline where +-- |Parse a split. Note that some banking programs may end up emitting empty +-- splits, and we don't do anything about that. So you might want to check if +-- what you get back is 'emptyTransaction', or something morally similar. parseSplit :: SplitItem -> Parser SplitItem parseSplit base = option base $ do label <- satisfy (inClass "E$") @@ -388,6 +614,8 @@ '$' -> getP parseSplit base entryAmount parseCurrency _ -> fail "Unknown, out of scope split entry label." +-- |Render a split. Please be sensible in what you emit; this function won't +-- check your work for you. renderSplit :: SplitItem -> Builder renderSplit s = put 'S' s entryCategory fromText <> @@ -406,17 +634,26 @@ -- Bank Entry Lists ------------------------------------------------------------ -parseTransactionList :: Parser [Transaction] -parseTransactionList = +-- |Parse a list of bank transactions. You should probably call this directly +-- after 'parseAccountHeader' and discovering that it's a 'Bank' account. You +-- should also not trust the results of this, as it does no consistency checking +-- on your behalf. +parseBankEntryList :: Parser [Transaction] +parseBankEntryList = do _ <- string "!Type:Bank" >> many1 endOfLine many' parseTransaction -renderTransactionList :: [Transaction] -> Builder -renderTransactionList ls = +-- |Render a list of bank transactions. Please do any consistency checking you +-- want before calling this. You probably also want to have called +-- 'renderAccountHeader' with an appropriate 'Bank' account before calling this +-- one. +renderBankEntryList :: [Transaction] -> Builder +renderBankEntryList ls = fromText "!Type:Bank" <> newline <> mconcat (map renderTransaction ls) -- Investment Entries --------------------------------------------------------- +-- |Information about a given trade. data TradeInfo = TradeInfo { _tradeDate :: Day , _tradeSecurity :: Text @@ -427,11 +664,31 @@ } deriving (Eq, Show) +-- |Build an empty trade made on a given day. emptyTrade :: Day -> TradeInfo emptyTrade day = TradeInfo day "" Nothing Nothing Nothing 0 -makeLenses ''TradeInfo +makeLensesWith (set generateSignatures False lensRules) ''TradeInfo +-- |The date of the trade. +tradeDate :: Lens' TradeInfo Day +-- |The security this trade was about. Note that while we probably should be +-- doing some input validation on this, we're not. So if you're consuming this +-- value, be a bit paranoid. +tradeSecurity :: Lens' TradeInfo Text +-- |The share price of the security during the trade, if provided. +tradeSharePrice :: Lens' TradeInfo (Maybe Currency) +-- |The amount of the share traded, if provided. +tradeQuantity :: Lens' TradeInfo (Maybe ShareQuantity) +-- |The annoying commission taken out of the trade, if provided. Note that QIF +-- does differentiate between Nothing and (Just 0.00), for some reason. +tradeCommission :: Lens' TradeInfo (Maybe Currency) +-- |The total amount of the trade. +tradeTotalAmount :: Lens' TradeInfo Currency + +-- |Information about a transfer into an investment account. This probably looks +-- like a normal transaction in a non-investment account, and each one probably +-- has a sibling that is exactly that. data TransferInfo = TransferInfo { _transDate :: Day , _transSummary :: Text @@ -443,11 +700,33 @@ } deriving (Eq, Show) +-- |An empty transfer that occurred on the given day. emptyTransfer :: Day -> TransferInfo emptyTransfer day = TransferInfo day "" "" 0 False "" [] -makeLenses ''TransferInfo +makeLensesWith (set generateSignatures False lensRules) ''TransferInfo +-- |The date of the transfer. +transDate :: Lens' TransferInfo Day +-- |A summary of the transfer. Sometimes the other party in the transfer, or +-- just a short name, and sometimes blank. +transSummary :: Lens' TransferInfo Text +-- |A memo or note about the transaction. Often blank, in our limited +-- experience. +transMemo :: Lens' TransferInfo Text +-- |The amount of the transfer. +transAmount :: Lens' TransferInfo Currency +-- |Whether or not the transfer has cleared. +transCleared :: Lens' TransferInfo Bool +-- |The account with which this transaction took place ... usually. Sometimes +-- this is empty. Make of that as you will. +transAccount :: Lens' TransferInfo Text +-- |Any splits associated with the transaction. +transSplits :: Lens' TransferInfo [SplitItem] + +-- |An action in an investment account. These are the ones I've seen in QIF +-- files shown to me. If you run into other ones, please file a bug or submit a +-- patch. data InvTransaction = Buy TradeInfo | Sell TradeInfo | Transfer TransferInfo @@ -455,6 +734,8 @@ | Interest Text TradeInfo deriving (Eq, Show) +-- |The date of an investment account action, regardless of what kind of +-- transaction it was. invEntDate :: Lens' InvTransaction Day invEntDate = lens dget dset where @@ -471,6 +752,10 @@ dset (Dividend tinfo) x = Dividend (set tradeDate x tinfo) dset (Interest a tinfo) x = Interest a (set tradeDate x tinfo) +-- |Parse an investment transaction. Like it's sister function, +-- 'parseTransaction', this function doesn't do any semantic validation. So it's +-- possible that the date in the transaction doesn't make any sense. So ... +-- that's on you. parseInvTransaction :: Parser InvTransaction parseInvTransaction = do date <- char 'D' *> parseDate <* many1 endOfLine @@ -517,6 +802,8 @@ tr <- trade base return (Interest label tr) +-- |Render an investment transaction. As you might expect, this doesn't check +-- your work. So be careful. renderInvTransaction :: InvTransaction -> Builder renderInvTransaction ent = singleton 'D' <> renderDate (view invEntDate ent) <> singleton '\n' <> @@ -549,11 +836,15 @@ -- Investment Entry Lists ------------------------------------------------------ +-- |Parse a list of investment entries. You probably should've called +-- 'parseAccountHeader' right before this and found an investment account. parseInvestmentEntries :: Parser [InvTransaction] parseInvestmentEntries = do _ <- string "!Type:Invst" >> many1 endOfLine many' parseInvTransaction +-- |Render a list of investment transactions. You should probably have just +-- called 'renderAccountHeader' with an investment account. renderInvestmentEntries :: [InvTransaction] -> Builder renderInvestmentEntries ents = fromText "!Type:Invst" <> newline <> mconcat (map renderInvTransaction ents) @@ -561,54 +852,81 @@ -- Cash Entry Lists ------------------------------------------------------------ +-- |Parse a list of cash transactions. You should probably have just called +-- 'parseAccountHeader' and found a 'Cash' account. You should probably also +-- be a bit paranoid about checking over the date you read, as we perform no +-- semantic checks on your behalf. parseCashEntryList :: Parser [Transaction] parseCashEntryList = do _ <- string "!Type:Cash" >> many1 endOfLine many' parseTransaction +-- |Render a list of cash transactions. You should have just called +-- 'renderAccountHeader' with a 'Cash' account. renderCashEntryList :: [Transaction] -> Builder renderCashEntryList ls = fromText "!Type:Cash" <> newline <> mconcat (map renderTransaction ls) -- Credit Card Entry Lists ----------------------------------------------------- +-- |Parse a list of credit card transactions. You should probably have just +-- called 'parseAccountHeader' and found a 'Cash' account. You should probably +-- also be a bit paranoid about checking over the date you read, as we perform +-- no semantic checks on your behalf. parseCreditCardEntryList :: Parser [Transaction] parseCreditCardEntryList = do _ <- string "!Type:CCard" >> many1 endOfLine many' parseTransaction +-- |Render a list of credit card transactions. You should have just called +-- 'renderAccountHeader' with a 'CreditCard' account. renderCreditCardEntryList :: [Transaction] -> Builder renderCreditCardEntryList ls = fromText "!Type:CCard" <> newline <> mconcat (map renderTransaction ls) -- Asset Entry Lists ----------------------------------------------------------- +-- |Parse a list of transactions in an asset account. Again, you probably should +-- have just called 'parseAccountHeader' and found an 'Asset' account, and you +-- should make sure to do any data validation you care about. Because this +-- library just doesn't care. parseAssetEntryList :: Parser [Transaction] parseAssetEntryList = do _ <- string "!Type:Oth A" >> many1 endOfLine many' parseTransaction +-- |Render a list of transactions on an asset. Did you call +-- 'renderAccountHeader' before this with an asset account? You should have! renderAssetEntryList :: [Transaction] -> Builder renderAssetEntryList ls = fromText "!Type:Oth A" <> newline <> mconcat (map renderTransaction ls) -- Liability Entry Lists ------------------------------------------------------- +-- |Last one! Parse a list of transactions about a liability. Probably a loan, +-- which you may or may not regret. You *will* regret it, however, if you didn't +-- call 'parseAccountHeader' first and find a 'Liability' account. You will also +-- regret it if you don't do some input validation on what you get from this +-- function. parseLiabilityEntryList :: Parser [Transaction] parseLiabilityEntryList = do _ <- string "!Type:Oth L" >> many1 endOfLine many' parseTransaction +-- |Render a list of transactions about a liability, probably right after you +-- called 'renderAccountHeader' with a liability account. renderLiabilityEntryList :: [Transaction] -> Builder renderLiabilityEntryList ls = fromText "!Type:Oth L" <> newline <> mconcat (map renderTransaction ls) -- Security Types -------------------------------------------------------------- +-- |The kinds of securities QIF files will reference. data SecurityType = Stock | Bond | CD | MutualFund | Index | ETF | MoneyMarket | PreciousMetal | Commodity | StockOption | Other deriving (Eq, Show) +-- |Parse a security type. parseSecurityType :: Parser SecurityType parseSecurityType = choice [ -- these are intentionally out of order; "Stock Option" *MUST* precede @@ -626,6 +944,7 @@ , string "Other" *> return Other ] +-- |Render a security type. renderSecurityType :: SecurityType -> Builder renderSecurityType st = case st of @@ -643,6 +962,7 @@ -- Securities ------------------------------------------------------------------ +-- |The information QIF keeps about a security. data Security = Security { _secName :: Text , _secTicker :: Text @@ -651,11 +971,26 @@ } deriving (Eq, Show) +-- |An empty security, forlorn and alone, with no name, no ticker, and no goals. +-- Definitely a stock, though. emptySecurity :: Security emptySecurity = Security "" "" Stock Nothing -makeLenses ''Security +makeLensesWith (set generateSignatures False lensRules) ''Security +-- |The name of the security. +secName :: Lens' Security Text +-- |The ticker symbol for the security. If I was a better person this would do +-- some validation on the input. +secTicker :: Lens' Security Text +-- |The type of security. +secType :: Lens' Security SecurityType +-- |The goal for the security. I think this is for things like "Buying a house" +-- or "Saving for college", but I've never actually seen this used in the wild. +secGoal :: Lens' Security (Maybe Text) + +-- |Parse a security. Performs no validation that the name makes sense, the +-- ticker makes sense, or that the two go together. Good luck with that. parseSecurity :: Parser Security parseSecurity = go emptySecurity where @@ -669,6 +1004,9 @@ '^' -> many1 endOfLine *> return base _ -> fail "Unknown, out of scope security label." +-- |Render a security. You should probably make sure that your data structure +-- makes sense before you write it, but that's your thing. This function won't +-- judget you. renderSecurity :: Security -> Builder renderSecurity s = put 'N' s secName fromText <> @@ -679,31 +1017,72 @@ -- Securities Lists ------------------------------------------------------------ +-- |Parse a list of securities out of the QIF file. parseSecurityList :: Parser [Security] parseSecurityList = do _ <- string "!Type:Security" >> many1 endOfLine many' parseSecurity +-- |Render a list of securities. renderSecurityList :: [Security] -> Builder renderSecurityList ls = fromText "!Type:Security" <> newline <> mconcat (map renderSecurity ls) -- Securities Lists ------------------------------------------------------------ +-- |The semantic content of a QIF file. (Explicitly this: very little semantic +-- processing has gone into this data structure, and it could contain semantic +-- errors in the underlying file. Checking for these things is your job.) data QIF = QIF { - _qifAccounts :: [Account] - , _qifCategories :: [Category] - , _qifSecurities :: [Security] - , _qifInvestmentActions :: [(Account, [InvTransaction])] - , _qifNormalActions :: [(Account, [Transaction])] + _qifAccounts :: [Account] + , _qifCategories :: [Category] + , _qifSecurities :: [Security] + , _qifInvestmentTransactions :: [(Account, [InvTransaction])] + , _qifNormalTransactions :: [(Account, [Transaction])] } deriving (Eq, Show) +-- |An empty QIF file. emptyQIF :: QIF emptyQIF = QIF [] [] [] [] [] -makeLenses ''QIF +makeLensesWith (set generateSignatures False lensRules) ''QIF +-- |The accounts associated with the QIF file. We hope. You might expect that +-- there would be an invariant that 'qifAccounts' would be the same as 'map' +-- 'fst' 'qifInvestmentTransactions' '++' 'map' 'fst' 'qifNormalTransactions'. +-- I would, and it'd be nice if you tried to maintain that in your code. But, +-- unfortuntely, there's nothing in the QIF file format that requires this. So +-- you should probably be careful, and make sure you handle the case in which +-- this item mentions accounts not seen anywhere else, and the case in which +-- 'qifNormalTransactions' and 'qifInvestmentTransactions' suddenly invent new +-- accounts. +qifAccounts :: Lens' QIF [Account] +-- |The list of categories saved in this QIF file. Like 'qifAccounts', there +-- doesn't seem to be anything enforcing consistency in the actual QIF file. So +-- you may find that this list mentions categories not referenced elsewhere -- +-- which is not necessarily too surprising -- but also that there may be +-- transactions that mention new categories unlisted in this field. +qifCategories :: Lens' QIF [Category] +-- |A cached list of securities. As with the other fields, be warned, as this is +-- not required to be complete, as far as I can tell. +qifSecurities :: Lens' QIF [Security] +-- |A list of investment accounts and the transactions associated with those +-- accounts. Typically each 'Account' should reference an account in +-- 'qifAccount' and include exactly the same date, but there's nothing in the +-- file structure that enforces this invariant. +qifInvestmentTransactions :: Lens' QIF [(Account, [InvTransaction])] +-- |A list of non-investment accounts and the transactions associated with them. +-- Again, one might expect that each 'Account' here should reference an account +-- in 'qifAccount', and contain exactly the same data, but there's nothing in +-- the file structure that enforces this constraint. +qifNormalTransactions :: Lens' QIF [(Account, [Transaction])] + +-- |Parse a QIF file. This function is purely a syntactic parse, and makes no +-- attempt to verify that the data it parses makes sense. So please be a bit +-- paranoid with all the numbers and strings you receive, and perform any +-- validation you need on your own. Also, this function assumes that it is +-- parsing only a QIF file, and that it should run to the end of the input. parseQIF :: Parser QIF parseQIF = go emptyQIF where @@ -723,17 +1102,17 @@ do acc <- parseAccountHeader case view accountType acc of BankAccount -> - getts parseTransactionList qifNormalActions base acc + getts parseBankEntryList qifNormalTransactions base acc CashAccount -> - getts parseCashEntryList qifNormalActions base acc + getts parseCashEntryList qifNormalTransactions base acc CreditCardAccount -> - getts parseCreditCardEntryList qifNormalActions base acc + getts parseCreditCardEntryList qifNormalTransactions base acc InvestmentAccount -> - getts parseInvestmentEntries qifInvestmentActions base acc + getts parseInvestmentEntries qifInvestmentTransactions base acc AssetAccount -> - getts parseAssetEntryList qifNormalActions base acc + getts parseAssetEntryList qifNormalTransactions base acc LiabilityAccount -> - getts parseLiabilityEntryList qifNormalActions base acc + getts parseLiabilityEntryList qifNormalTransactions base acc -- getts :: Parser [a] -> ASetter' QIF [(Account,[a])] -> QIF -> Account -> @@ -742,3 +1121,25 @@ do list <- listParser go (over field (++ [(account, list)]) base) +-- |Render out a QIF File. Because it's the order I've seen in my early example +-- QIF files, this renders in the following order: account list, category list, +-- investment accounts and their transactions, non-investment accounts and their +-- transactions, and then security lists. +renderQIF :: QIF -> Builder +renderQIF qif = + renderAccountList (view qifAccounts qif) <> + renderCategoryList (view qifCategories qif) <> + mconcat + (map (\ (acc,trans) -> renderAccountHeader acc <> renderInvestmentEntries trans) + (view qifInvestmentTransactions qif)) <> + mconcat + (map (\ (acc,trans) -> renderAccountHeader acc <> + case view accountType acc of + BankAccount -> renderBankEntryList trans + CashAccount -> renderCashEntryList trans + CreditCardAccount -> renderCreditCardEntryList trans + InvestmentAccount -> error "Investment account in normal list?" + AssetAccount -> renderAssetEntryList trans + LiabilityAccount -> renderLiabilityEntryList trans) + (view qifNormalTransactions qif)) <> + renderSecurityList (view qifSecurities qif)