{-# 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)