qif-1.1.0: src/Data/QIF.hs
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE TemplateHaskell #-}
-- |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)
import Data.Attoparsec.Text(Parser,char,choice,decimal,digit,
endOfInput,endOfLine,inClass,many',
many1,option,satisfy,string)
import qualified Data.Attoparsec.Text as Atto
import Data.Char(digitToInt,isPrint)
import Data.Fixed(Fixed,HasResolution(..),E2)
import Data.Monoid((<>))
import qualified Data.Text as Text
import Data.Text(Text)
import Data.Text.Lazy.Builder(Builder,singleton,fromString,fromText)
import Data.Time(Day(..),fromGregorian,toGregorian)
import Data.Time.Format(defaultTimeLocale,parseTimeM,formatTime)
import Data.Word(Word)
import Lens.Micro(Lens',ASetter',lens,set,over)
import Lens.Micro.Extras(view)
import Lens.Micro.TH(makeLensesWith,lensRules,generateSignatures)
-- Fixed-width Quantities: Currency and Share Counts ---------------------------
data E4
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)
leader <- digitToNum `fmap` digit
firstbit <- beforePoint leader
option (finally firstbit) $
do _ <- char '.'
posres <- afterPoint firstbit 10
return (finally posres)
where
beforePoint acc =
option acc $
choice [
do _ <- char ','
beforePoint acc
, do x <- digitToNum `fmap` digit
beforePoint ((acc * 10) + x)
]
afterPoint acc place =
option acc $
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
_ <- option '$' (char '$')
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
digitToNum :: Num a => Char -> a
digitToNum = fromIntegral . digitToInt
-- Account Types ---------------------------------------------------------------
-- |The type of an account; should be fairly self-explanatory.
data AccountType = BankAccount
| CashAccount
| CreditCardAccount
| InvestmentAccount
| AssetAccount
| 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
, string "Cash" *> return CashAccount
, string "CCard" *> return CreditCardAccount
, string "Invst" *> return InvestmentAccount
, string "Oth A" *> return AssetAccount
, 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"
renderShortAccountType CreditCardAccount = fromText "CCard"
renderShortAccountType InvestmentAccount = fromText "Invst"
renderShortAccountType AssetAccount = fromText "Oth A"
renderShortAccountType LiabilityAccount = fromText "Oth L"
-- Accounts --------------------------------------------------------------------
-- |An account in the QIF file. This same structure applies for all the account
-- types.
data Account = Account {
_accountName :: Text
, _accountType :: AccountType
, _accountDescription :: Text
, _accountCreditLimit :: Maybe Currency
, _accountBalanceDate :: Maybe Day
, _accountBalance :: Currency
}
deriving (Eq, Show)
makeLensesWith (set generateSignatures False lensRules) ''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 = ""
, _accountType = BankAccount
, _accountDescription = ""
, _accountCreditLimit = Nothing
, _accountBalanceDate = Nothing
, _accountBalance = 0
}
-- |Parse an account.
parseAccount :: Parser Account
parseAccount = go emptyAccount
where
go base =
do label <- satisfy (inClass "NTDL/$BX^")
case label of
'N' -> getP go base accountName parseString
'T' -> getP go base accountType parseShortAccountType
'D' -> getP go base accountDescription parseString
'L' -> getP go base accountCreditLimit (Just `fmap` parseCurrency)
'/' -> getP go base accountBalanceDate (Just `fmap` parseDate)
'$' -> getP go base accountBalance parseCurrency
'B' -> getP go base accountBalance parseCurrency
'X' -> many1 endOfLine *> go base
'^' -> many1 endOfLine *> return base
_ -> fail "Unknown, out of scope account label."
getP :: (s -> Parser s) -> s -> ASetter' s a -> Parser a -> Parser s
getP go base field getter =
do x <- getter
_ <- many1 endOfLine
go (set field x base)
getP' :: (s -> Parser s) -> s -> ASetter' s (Maybe a) -> Parser a -> Parser s
getP' go base field getter =
do x <- option Nothing (Just `fmap` getter)
_ <- many1 endOfLine
go (set field x base)
parseString :: Parser Text
parseString = Atto.takeWhile (not . inClass "\r\n")
-- |Render an account.
renderAccount :: Account -> Builder
renderAccount acc = mconcat [
put 'N' acc accountName fromText
, put 'D' acc accountDescription fromText
, put 'T' acc accountType renderShortAccountType
, put 'B' acc accountBalance (renderCurrency True)
, putm 'L' acc accountCreditLimit (renderCurrency True)
, putm '/' acc accountBalanceDate renderDate
, singleton '^' <> singleton '\n'
]
put :: Char -> s -> Lens' s a -> (a -> Builder) -> Builder
put label acc field builder =
singleton label <> builder (view field acc) <> singleton '\n'
putm :: Char -> s -> Lens' s (Maybe a) -> (a -> Builder) -> Builder
putm label acc field builder =
case view field acc of
Just x -> singleton label <> builder x <> singleton '\n'
Nothing -> mempty
putm' :: Char -> s -> Lens' s (Maybe a) -> (a -> Builder) -> Builder
putm' label acc field builder =
case view field acc of
Just x -> singleton label <> builder x <> singleton '\n'
Nothing -> singleton label <> singleton '\n'
-- 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
intime <- parseTimeM False defaultTimeLocale "%-m/%e/%y" (Text.unpack str)
let (year, mon, day) = toGregorian intime
if year < 2000
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
_ <- string "!Account" *> many1 endOfLine
accs <- many' parseAccount
_ <- 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" <>
fromString "!Account\n" <>
mconcat (map renderAccount accs) <>
fromString "!Clear:AutoSwitch\n"
-- Categories ------------------------------------------------------------------
-- |Information about a category that one might mark a transaction against.
data Category = Category {
_catName :: Text
, _catDescription :: Text
, _catKind :: CategoryKind
, _catIsTaxRelated :: Bool
, _catBudgetAmount :: Maybe Currency
, _catTaxScheduleInfo :: Maybe Word
}
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 = ""
, _catDescription = ""
, _catKind = Expense
, _catIsTaxRelated = False
, _catBudgetAmount = Nothing
, _catTaxScheduleInfo = Nothing
}
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
go base =
do label <- satisfy (inClass "NDTIEBR^")
case label of
'N' -> getP go base catName parseString
'D' -> getP go base catDescription parseString
'B' -> getP go base catBudgetAmount (Just `fmap` parseCurrency)
'R' -> getP go base catTaxScheduleInfo (Just `fmap` decimal)
--
'T' -> many1 endOfLine *> go (set catIsTaxRelated True base)
'I' -> many1 endOfLine *> go (set catKind Income base)
'E' -> many1 endOfLine *> go (set catKind Expense base)
--
'^' -> 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
, put 'D' cat catDescription fromText
, if _catIsTaxRelated cat then fromString "T\n" else mempty
, if _catKind cat == Income then fromString "I\n" else "E\n"
, putm 'B' cat catBudgetAmount (renderCurrency True)
, putm 'R' cat catTaxScheduleInfo (fromString . show)
, fromString "^\n"
]
-- 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)
-- 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
, _entryCategory :: Text
}
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
, _entMemo :: Text
, _entAmount :: Currency
, _entNumber :: Maybe Word
, _entCategory :: Maybe Text
, _entCleared :: Bool
, _entReimbursable :: Bool
, _entSplits :: [SplitItem]
}
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 []
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
go base =
do label <- satisfy (inClass "DPMTUCLNSF^")
case label of
'D' -> getP go base entDate parseDate
'P' -> getP go base entParty parseString
'M' -> getP go base entMemo parseString
'T' -> getP go base entAmount parseCurrency
'U' -> getP go base entAmount parseCurrency
'C' -> getP go base entCleared parseCleared
'L' -> getP go base entCategory (Just `fmap` parseString)
'N' -> getP go base entNumber (Just `fmap` decimal)
--
'S' -> do cat <-parseString <* many1 endOfLine
ent <- parseSplit (emptySplitItem{ _entryCategory = cat })
go (over entSplits (++ [ent]) base)
--
'F' -> many1 endOfLine *> go (set entReimbursable True base)
'^' -> 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 <>
put 'P' be entParty fromText <>
put 'M' be entMemo fromText <>
put 'T' be entAmount (renderCurrency False) <>
putm 'N' be entNumber (fromString . show) <>
put 'C' be entCleared renderCleared <>
putm 'L' be entCategory fromText <>
(if view entReimbursable be then singleton 'F' <> newline else mempty) <>
mconcat (map renderSplit (view entSplits be)) <>
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$")
case label of
'E' -> getP parseSplit base entryMemo parseString
'$' -> 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 <>
put 'E' s entryMemo fromText <>
put '$' s entryAmount (renderCurrency False)
parseCleared :: Parser Bool
parseCleared = option False (char 'X' *> return True)
renderCleared :: Bool -> Builder
renderCleared False = mempty
renderCleared True = fromText "X"
newline :: Builder
newline = singleton '\n'
-- Bank Entry Lists ------------------------------------------------------------
-- |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
-- |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
, _tradeSharePrice :: Maybe Currency
, _tradeQuantity :: Maybe ShareQuantity
, _tradeCommission :: Maybe Currency
, _tradeTotalAmount :: Currency
}
deriving (Eq, Show)
-- |Build an empty trade made on a given day.
emptyTrade :: Day -> TradeInfo
emptyTrade day = TradeInfo day "" Nothing Nothing Nothing 0
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
, _transMemo :: Text
, _transAmount :: Currency
, _transCleared :: Bool
, _transAccount :: Text
, _transSplits :: [SplitItem]
}
deriving (Eq, Show)
-- |An empty transfer that occurred on the given day.
emptyTransfer :: Day -> TransferInfo
emptyTransfer day = TransferInfo day "" "" 0 False "" []
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
| Dividend TradeInfo
| 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
dget :: InvTransaction -> Day
dget (Buy tinfo) = view tradeDate tinfo
dget (Sell tinfo) = view tradeDate tinfo
dget (Transfer tinfo) = view transDate tinfo
dget (Dividend tinfo) = view tradeDate tinfo
dget (Interest _ tinfo) = view tradeDate tinfo
dset :: InvTransaction -> Day -> InvTransaction
dset (Buy tinfo) x = Buy (set tradeDate x tinfo)
dset (Sell tinfo) x = Sell (set tradeDate x tinfo)
dset (Transfer tinfo) x = Transfer (set transDate x tinfo)
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
choice [ Transfer `fmap` tranTransaction (emptyTransfer date)
, Buy `fmap` buyTransaction (emptyTrade date)
, Sell `fmap` sellTransaction (emptyTrade date)
, Dividend `fmap` divTransaction (emptyTrade date)
, intTransaction (emptyTrade date)
]
where
tranTransaction base =
do label <- satisfy (inClass "PMTCLNS^")
case label of
'P' -> getP tranTransaction base transSummary parseString
'M' -> getP tranTransaction base transMemo parseString
'T' -> getP tranTransaction base transAmount parseCurrency
'$' -> getP tranTransaction base transAmount parseCurrency
'C' -> getP tranTransaction base transCleared parseCleared
'L' -> getP tranTransaction base transAccount parseString
'N' -> many1 digit *> many1 endOfLine *> tranTransaction base
'S' -> do cat <- parseString <* many1 endOfLine
ent <- parseSplit (emptySplitItem{ _entryCategory = cat })
tranTransaction (over transSplits (++ [ent]) base)
'^' -> many1 endOfLine *> return base
_ -> fail "Unknown, out of scope transfer investment transaction"
--
buyTransaction base = string "NBuy" >> many1 endOfLine >> trade base
sellTransaction base = string "NSell" >> many1 endOfLine >> trade base
divTransaction base = string "NDiv" >> many1 endOfLine >> trade base
trade base =
do label <- satisfy (inClass "YIQOTN^")
case label of
'Y' -> getP trade base tradeSecurity parseString
'I' -> getP' trade base tradeSharePrice parseCurrency
'Q' -> getP' trade base tradeQuantity parseQuantity
'O' -> getP' trade base tradeCommission parseCurrency
'T' -> getP trade base tradeTotalAmount parseCurrency
'^' -> many1 endOfLine *> return base
_ -> fail "Unknown, out of scope trade investment transaction"
--
intTransaction base =
do label <- char 'N' *> parseString <* many1 endOfLine
when (label `elem` ["Buy","Sell"]) $ fail "Shouldn't be here."
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' <>
case ent of
Buy t -> renderTradeInfo "Buy" t
Sell t -> renderTradeInfo "Sell" t
Transfer t -> renderTransferInfo t
Dividend t -> renderTradeInfo "Div" t
Interest n t -> renderTradeInfo n t
renderTradeInfo :: Text -> TradeInfo -> Builder
renderTradeInfo name t =
singleton 'N' <> fromText name <> newline <>
put 'Y' t tradeSecurity fromText <>
putm' 'I' t tradeSharePrice (renderCurrency False) <>
putm' 'Q' t tradeQuantity renderShareQuantity <>
putm' 'O' t tradeCommission (renderCurrency False) <>
put 'T' t tradeTotalAmount (renderCurrency False) <>
singleton '^' <> newline
renderTransferInfo :: TransferInfo -> Builder
renderTransferInfo t =
put 'P' t transSummary fromText <>
put 'M' t transMemo fromText <>
put 'T' t transAmount (renderCurrency False) <>
put 'C' t transCleared renderCleared <>
put 'L' t transAccount fromText <>
mconcat (map renderSplit (view transSplits t)) <>
singleton '^' <> newline
-- 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)
-- 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
-- "Stock", or this will shortcut
string "Stock Option" *> return StockOption
, string "Bond" *> return Bond
, string "CD" *> return CD
, string "Mutual Fund" *> return MutualFund
, string "Index" *> return Index
, string "ETF" *> return ETF
, string "Money Market Fund" *> return MoneyMarket
, string "Precious Metal" *> return PreciousMetal
, string "Commodity" *> return Commodity
, string "Stock" *> return Stock
, string "Other" *> return Other
]
-- |Render a security type.
renderSecurityType :: SecurityType -> Builder
renderSecurityType st =
case st of
Stock -> fromText "Stock"
Bond -> fromText "Bond"
CD -> fromText "CD"
MutualFund -> fromText "Mutual Fund"
Index -> fromText "Index"
ETF -> fromText "ETF"
MoneyMarket -> fromText "Money Market Fund"
PreciousMetal -> fromText "Precious Metal"
Commodity -> fromText "Commodity"
StockOption -> fromText "Stock Option"
Other -> fromText "Other"
-- Securities ------------------------------------------------------------------
-- |The information QIF keeps about a security.
data Security = Security {
_secName :: Text
, _secTicker :: Text
, _secType :: SecurityType
, _secGoal :: Maybe Text
}
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
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
go base =
do label <- satisfy (inClass "NSTG^")
case label of
'N' -> getP go base secName parseString
'S' -> getP go base secTicker parseString
'T' -> getP go base secType parseSecurityType
'G' -> getP go base secGoal (Just `fmap` parseString)
'^' -> 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 <>
put 'S' s secTicker fromText <>
put 'T' s secType renderSecurityType <>
putm 'G' s secGoal fromText <>
singleton '^' <> newline
-- 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]
, _qifInvestmentTransactions :: [(Account, [InvTransaction])]
, _qifNormalTransactions :: [(Account, [Transaction])]
}
deriving (Eq, Show)
-- |An empty QIF file.
emptyQIF :: QIF
emptyQIF = 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
go base = choice [ add' base qifAccounts parseAccountList
, add' base qifCategories parseCategoryList
, add' base qifSecurities parseSecurityList
, getTransactions base
, endOfInput >> return base
]
--
add' :: QIF -> ASetter' QIF [a] -> Parser [a] -> Parser QIF
add' base field getter =
do list <- getter
go (over field (++ list) base)
--
getTransactions base =
do acc <- parseAccountHeader
case view accountType acc of
BankAccount ->
getts parseBankEntryList qifNormalTransactions base acc
CashAccount ->
getts parseCashEntryList qifNormalTransactions base acc
CreditCardAccount ->
getts parseCreditCardEntryList qifNormalTransactions base acc
InvestmentAccount ->
getts parseInvestmentEntries qifInvestmentTransactions base acc
AssetAccount ->
getts parseAssetEntryList qifNormalTransactions base acc
LiabilityAccount ->
getts parseLiabilityEntryList qifNormalTransactions base acc
--
getts :: Parser [a] -> ASetter' QIF [(Account,[a])] ->
QIF -> Account ->
Parser QIF
getts listParser field base account =
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)