module Data.QIF(
QIF, emptyQIF
, qifAccounts, qifCategories
, qifSecurities, qifInvestmentTransactions
, qifNormalTransactions
, parseQIF, renderQIF
, parseAccountList, renderAccountList
, parseCategoryList, renderCategoryList
, parseBankEntryList, renderBankEntryList
, parseInvestmentEntries, renderInvestmentEntries
, parseCashEntryList, renderCashEntryList
, parseCreditCardEntryList, renderCreditCardEntryList
, parseAssetEntryList, renderAssetEntryList
, parseLiabilityEntryList, renderLiabilityEntryList
, parseSecurityList, renderSecurityList
, Account, emptyAccount
, accountName, accountType
, accountDescription, accountCreditLimit
, accountBalanceDate, accountBalance
, parseAccount, renderAccount
, AccountType(..), parseAccountType, renderAccountType
, parseShortAccountType, renderShortAccountType
, parseAccountHeader, renderAccountHeader
, CategoryKind(..)
, Category, emptyCategory
, catName, catDescription
, catKind, catIsTaxRelated
, catBudgetAmount, catTaxScheduleInfo
, parseCategory, renderCategory
, SplitItem, emptySplitItem
, entryMemo, entryAmount
, entryCategory
, parseSplit, renderSplit
, Transaction, emptyTransaction
, entDate, entParty
, entMemo, entAmount
, entNumber, entCategory
, entCleared, entReimbursable
, entSplits
, parseTransaction, renderTransaction
, TradeInfo, emptyTrade
, tradeDate, tradeSecurity
, tradeSharePrice, tradeQuantity
, tradeCommission, tradeTotalAmount
, TransferInfo, emptyTransfer
, transDate, transSummary
, transMemo, transAmount
, transCleared, transAccount
, transSplits
, InvTransaction(..)
, invEntDate
, parseInvTransaction, renderInvTransaction
, SecurityType(..), parseSecurityType, renderSecurityType
, Security, emptySecurity
, secName, secTicker
, secType, secGoal
, parseSecurity, renderSecurity
, Currency, parseCurrency, renderCurrency
, ShareQuantity, parseShareQuantity, renderShareQuantity
, parseQuantity, renderQuantity
, 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)
data E4
instance HasResolution E4 where
resolution _ = 10000
type Currency = Fixed E2
type ShareQuantity = Fixed E4
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)
renderQuantity :: HasResolution a => Fixed a -> Builder
renderQuantity = fromString . show
parseCurrency :: Parser Currency
parseCurrency =
do finally <- option id (char '-' *> return negate)
_ <- option '$' (char '$')
amount <- parseQuantity
return (finally amount)
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)
parseShareQuantity :: Parser ShareQuantity
parseShareQuantity = parseQuantity
renderShareQuantity :: ShareQuantity -> Builder
renderShareQuantity = renderQuantity
digitToNum :: Num a => Char -> a
digitToNum = fromIntegral . digitToInt
data AccountType = BankAccount
| CashAccount
| CreditCardAccount
| InvestmentAccount
| AssetAccount
| LiabilityAccount
deriving (Eq, Read, Show)
parseAccountType :: Parser AccountType
parseAccountType = string "!Type:" *> parseShortAccountType
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
]
renderAccountType :: AccountType -> Builder
renderAccountType acc = fromText "!Type:" <> renderShortAccountType acc
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"
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
accountName :: Lens' Account Text
accountType :: Lens' Account AccountType
accountDescription :: Lens' Account Text
accountCreditLimit :: Lens' Account (Maybe Currency)
accountBalanceDate :: Lens' Account (Maybe Day)
accountBalance :: Lens' Account Currency
emptyAccount :: Account
emptyAccount = Account {
_accountName = ""
, _accountType = BankAccount
, _accountDescription = ""
, _accountCreditLimit = Nothing
, _accountBalanceDate = Nothing
, _accountBalance = 0
}
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")
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'
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
renderDate :: Day -> Builder
renderDate = fromString . formatTime defaultTimeLocale "%-m/%e/%y"
parseAccountList :: Parser [Account]
parseAccountList =
do _ <- string "!Option:AutoSwitch" *> many1 endOfLine
_ <- string "!Account" *> many1 endOfLine
accs <- many' parseAccount
_ <- string "!Clear:AutoSwitch" *> many1 endOfLine
return accs
renderAccountList :: [Account] -> Builder
renderAccountList accs =
fromString "!Option:AutoSwitch\n" <>
fromString "!Account\n" <>
mconcat (map renderAccount accs) <>
fromString "!Clear:AutoSwitch\n"
data Category = Category {
_catName :: Text
, _catDescription :: Text
, _catKind :: CategoryKind
, _catIsTaxRelated :: Bool
, _catBudgetAmount :: Maybe Currency
, _catTaxScheduleInfo :: Maybe Word
}
deriving (Eq, Show)
data CategoryKind = Income | Expense
deriving (Eq, Show)
emptyCategory :: Category
emptyCategory = Category {
_catName = ""
, _catDescription = ""
, _catKind = Expense
, _catIsTaxRelated = False
, _catBudgetAmount = Nothing
, _catTaxScheduleInfo = Nothing
}
makeLensesWith (set generateSignatures False lensRules) ''Category
catName :: Lens' Category Text
catDescription :: Lens' Category Text
catKind :: Lens' Category CategoryKind
catIsTaxRelated :: Lens' Category Bool
catBudgetAmount :: Lens' Category (Maybe Currency)
catTaxScheduleInfo :: Lens' Category (Maybe Word)
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."
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"
]
parseCategoryList :: Parser [Category]
parseCategoryList =
do _ <- string "!Type:Cat"
_ <- many1 endOfLine
many' parseCategory
renderCategoryList :: [Category] -> Builder
renderCategoryList cats =
fromString "!Type:Cat\n" <> mconcat (map renderCategory cats)
parseAccountHeader :: Parser Account
parseAccountHeader =
do _ <- string "!Account"
_ <- many1 endOfLine
parseAccount
renderAccountHeader :: Account -> Builder
renderAccountHeader acc = fromString "!Account\n" <> renderAccount acc
data SplitItem = SplitItem {
_entryMemo :: Text
, _entryAmount :: Currency
, _entryCategory :: Text
}
deriving (Eq, Show)
emptySplitItem :: SplitItem
emptySplitItem = SplitItem "" 0 ""
makeLensesWith (set generateSignatures False lensRules) ''SplitItem
entryMemo :: Lens' SplitItem Text
entryAmount :: Lens' SplitItem Currency
entryCategory :: Lens' SplitItem Text
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)
emptyTransaction :: Transaction
emptyTransaction =
Transaction (fromGregorian 2000 1 1) "" "" 0 Nothing Nothing False False []
makeLensesWith (set generateSignatures False lensRules) ''Transaction
entDate :: Lens' Transaction Day
entParty :: Lens' Transaction Text
entMemo :: Lens' Transaction Text
entAmount :: Lens' Transaction Currency
entNumber :: Lens' Transaction (Maybe Word)
entCategory :: Lens' Transaction (Maybe Text)
entCleared :: Lens' Transaction Bool
entReimbursable :: Lens' Transaction Bool
entSplits :: Lens' Transaction [SplitItem]
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."
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
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."
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'
parseBankEntryList :: Parser [Transaction]
parseBankEntryList =
do _ <- string "!Type:Bank" >> many1 endOfLine
many' parseTransaction
renderBankEntryList :: [Transaction] -> Builder
renderBankEntryList ls =
fromText "!Type:Bank" <> newline <> mconcat (map renderTransaction ls)
data TradeInfo = TradeInfo {
_tradeDate :: Day
, _tradeSecurity :: Text
, _tradeSharePrice :: Maybe Currency
, _tradeQuantity :: Maybe ShareQuantity
, _tradeCommission :: Maybe Currency
, _tradeTotalAmount :: Currency
}
deriving (Eq, Show)
emptyTrade :: Day -> TradeInfo
emptyTrade day = TradeInfo day "" Nothing Nothing Nothing 0
makeLensesWith (set generateSignatures False lensRules) ''TradeInfo
tradeDate :: Lens' TradeInfo Day
tradeSecurity :: Lens' TradeInfo Text
tradeSharePrice :: Lens' TradeInfo (Maybe Currency)
tradeQuantity :: Lens' TradeInfo (Maybe ShareQuantity)
tradeCommission :: Lens' TradeInfo (Maybe Currency)
tradeTotalAmount :: Lens' TradeInfo Currency
data TransferInfo = TransferInfo {
_transDate :: Day
, _transSummary :: Text
, _transMemo :: Text
, _transAmount :: Currency
, _transCleared :: Bool
, _transAccount :: Text
, _transSplits :: [SplitItem]
}
deriving (Eq, Show)
emptyTransfer :: Day -> TransferInfo
emptyTransfer day = TransferInfo day "" "" 0 False "" []
makeLensesWith (set generateSignatures False lensRules) ''TransferInfo
transDate :: Lens' TransferInfo Day
transSummary :: Lens' TransferInfo Text
transMemo :: Lens' TransferInfo Text
transAmount :: Lens' TransferInfo Currency
transCleared :: Lens' TransferInfo Bool
transAccount :: Lens' TransferInfo Text
transSplits :: Lens' TransferInfo [SplitItem]
data InvTransaction = Buy TradeInfo
| Sell TradeInfo
| Transfer TransferInfo
| Dividend TradeInfo
| Interest Text TradeInfo
deriving (Eq, Show)
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)
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)
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
parseInvestmentEntries :: Parser [InvTransaction]
parseInvestmentEntries =
do _ <- string "!Type:Invst" >> many1 endOfLine
many' parseInvTransaction
renderInvestmentEntries :: [InvTransaction] -> Builder
renderInvestmentEntries ents =
fromText "!Type:Invst" <> newline <> mconcat (map renderInvTransaction ents)
parseCashEntryList :: Parser [Transaction]
parseCashEntryList =
do _ <- string "!Type:Cash" >> many1 endOfLine
many' parseTransaction
renderCashEntryList :: [Transaction] -> Builder
renderCashEntryList ls =
fromText "!Type:Cash" <> newline <> mconcat (map renderTransaction ls)
parseCreditCardEntryList :: Parser [Transaction]
parseCreditCardEntryList =
do _ <- string "!Type:CCard" >> many1 endOfLine
many' parseTransaction
renderCreditCardEntryList :: [Transaction] -> Builder
renderCreditCardEntryList ls =
fromText "!Type:CCard" <> newline <> mconcat (map renderTransaction ls)
parseAssetEntryList :: Parser [Transaction]
parseAssetEntryList =
do _ <- string "!Type:Oth A" >> many1 endOfLine
many' parseTransaction
renderAssetEntryList :: [Transaction] -> Builder
renderAssetEntryList ls =
fromText "!Type:Oth A" <> newline <> mconcat (map renderTransaction ls)
parseLiabilityEntryList :: Parser [Transaction]
parseLiabilityEntryList =
do _ <- string "!Type:Oth L" >> many1 endOfLine
many' parseTransaction
renderLiabilityEntryList :: [Transaction] -> Builder
renderLiabilityEntryList ls =
fromText "!Type:Oth L" <> newline <> mconcat (map renderTransaction ls)
data SecurityType = Stock | Bond | CD | MutualFund | Index | ETF | MoneyMarket
| PreciousMetal | Commodity | StockOption | Other
deriving (Eq, Show)
parseSecurityType :: Parser SecurityType
parseSecurityType = choice [
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
]
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"
data Security = Security {
_secName :: Text
, _secTicker :: Text
, _secType :: SecurityType
, _secGoal :: Maybe Text
}
deriving (Eq, Show)
emptySecurity :: Security
emptySecurity = Security "" "" Stock Nothing
makeLensesWith (set generateSignatures False lensRules) ''Security
secName :: Lens' Security Text
secTicker :: Lens' Security Text
secType :: Lens' Security SecurityType
secGoal :: Lens' Security (Maybe Text)
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."
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
parseSecurityList :: Parser [Security]
parseSecurityList =
do _ <- string "!Type:Security" >> many1 endOfLine
many' parseSecurity
renderSecurityList :: [Security] -> Builder
renderSecurityList ls =
fromText "!Type:Security" <> newline <> mconcat (map renderSecurity ls)
data QIF = QIF {
_qifAccounts :: [Account]
, _qifCategories :: [Category]
, _qifSecurities :: [Security]
, _qifInvestmentTransactions :: [(Account, [InvTransaction])]
, _qifNormalTransactions :: [(Account, [Transaction])]
}
deriving (Eq, Show)
emptyQIF :: QIF
emptyQIF = QIF [] [] [] [] []
makeLensesWith (set generateSignatures False lensRules) ''QIF
qifAccounts :: Lens' QIF [Account]
qifCategories :: Lens' QIF [Category]
qifSecurities :: Lens' QIF [Security]
qifInvestmentTransactions :: Lens' QIF [(Account, [InvTransaction])]
qifNormalTransactions :: Lens' QIF [(Account, [Transaction])]
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)
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)