qif 1.0.0 → 1.1.0

raw patch · 3 files changed

+575/−62 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Test.hs +143/−33
• qif.cabal +3/−1
• src/Data/QIF.hs +429/−28

@@ -9,6 +9,7 @@ import           Data.Text.Lazy(Text) import           Data.Text.Lazy.Builder(Builder, toLazyText) import           Data.Time(Day(..), fromGregorian, addDays)+import           Lens.Micro(set) import           Test.QuickCheck import           Test.Tasty(TestTree, testGroup, defaultMain) import           Test.Tasty.HUnit(testCase, (@=?))@@ -120,29 +121,36 @@ testSecurity =   testGroup "Security Block" [     testCase "Alaska Airlines"-      (Security "Alaska Air Group, Inc" "ALK" Stock Nothing @=?+      (security "Alaska Air Group, Inc" "ALK" Stock Nothing @=?         runP parseSecurity "NAlaska Air Group, Inc\nSALK\nTStock\n^\n")   , testCase "Vanguard S&P"-      (Security "Vanguard S&P 500 Index,Investor Shares" "VFINX"+      (security "Vanguard S&P 500 Index,Investor Shares" "VFINX"                 MutualFund Nothing          @=?         runP parseSecurity           "NVanguard S&P 500 Index,Investor Shares\nSVFINX\nTMutual Fund\n^\n")   , testCase "Vanguard ETF"-      (Security "Vanguard ETF" "VET" ETF (Just "House") @=?+      (security "Vanguard ETF" "VET" ETF (Just "House") @=?         runP parseSecurity "NVanguard ETF\nSVET\nTETF\nGHouse\n^\n")   , testProperty "Security block serialization"       (standardSerializer parseSecurity renderSecurity)   ] +security :: S.Text -> S.Text -> SecurityType -> Maybe S.Text -> Security+security n t y g =+  set secName   n $+  set secTicker t $+  set secType   y $+  set secGoal   g emptySecurity+ testAccount :: TestTree testAccount =   testGroup "Accounts" [     testCase "Umpqua Account"-      (Account "Umpqua Bank" BankAccount "Checking" Nothing Nothing 1234.12 @=?+      (account "Umpqua Bank" BankAccount "Checking" Nothing Nothing 1234.12 @=?         runP parseAccount "NUmpqua Bank\nDChecking\nX\nTBank\nB$1234.12\n^\n")   , testCase "Blue Bank"-      (Account "Blue Bank" CreditCardAccount "" (Just 40)+      (account "Blue Bank" CreditCardAccount "" (Just 40)                (Just (fromGregorian 2012 2 14)) (-520)         @=?          runP parseAccount@@ -153,63 +161,109 @@       (standardSerializer parseAccountHeader renderAccountHeader)   ] +account :: S.Text -> AccountType -> S.Text ->+           Maybe Currency -> Maybe Day -> Currency ->+           Account+account n t d cl bd b =+  set accountName        n  $+  set accountType        t  $+  set accountDescription d  $+  set accountCreditLimit cl $+  set accountBalanceDate bd $+  set accountBalance     b  emptyAccount+ testCategory :: TestTree testCategory =   testGroup "Categories" [     testCase "Auto"-      (Category "Auto" "Automobile-related expenses" Expense False Nothing Nothing @=?+      (category "Auto" "Automobile-related expenses" Expense False Nothing Nothing @=?         runP parseCategory "NAuto\nDAutomobile-related expenses\nE\n^\n")   , testCase "Registration"-      (Category "Registration" "" Expense True Nothing (Just 535) @=?+      (category "Registration" "" Expense True Nothing (Just 535) @=?         runP parseCategory "NRegistration\nD\nT\nE\nR535\n^\n")   , testCase "Salary"-      (Category "Salary" "Income" Income True Nothing Nothing @=?+      (category "Salary" "Income" Income True Nothing Nothing @=?         runP parseCategory "NSalary\nDIncome\nT\nI\n^\n")   , testCase "Dinner"-      (Category "Dinner" "Yum yum" Expense False (Just 200) Nothing @=?+      (category "Dinner" "Yum yum" Expense False (Just 200) Nothing @=?         runP parseCategory "NDinner\nDYum yum\nE\nB200.\n^\n")   , testProperty "Category serialization"       (standardSerializer parseCategory renderCategory)   ] +category :: S.Text -> S.Text -> CategoryKind -> Bool ->+            Maybe Currency -> Maybe Word ->+            Category+category n d k itr ba tsi =+  set catName            n   $+  set catDescription     d   $+  set catKind            k   $+  set catIsTaxRelated    itr $+  set catBudgetAmount    ba  $+  set catTaxScheduleInfo tsi emptyCategory+ testTransaction :: TestTree testTransaction =   testGroup "Transactions" [     testCase "Roost"-      (Transaction (fromGregorian 2012 2 14) "Roost" "Yay fun" (-25) Nothing+      (transaction (fromGregorian 2012 2 14) "Roost" "Yay fun" (-25) Nothing                    (Just "Dining") True False [] @=?         (runP parseTransaction           "D2/14/12\nPRoost\nMYay fun\nT-25\nCX\nLDining\n^\n"))   , testCase "Uncleared Roost"-      (Transaction (fromGregorian 2012 2 14) "Roost" "Yay fun" (-25) Nothing+      (transaction (fromGregorian 2012 2 14) "Roost" "Yay fun" (-25) Nothing                    (Just "Dining") False False [] @=?         (runP parseTransaction           "D2/14/12\nPRoost\nMYay fun\nT-25.\nLDining\n^\n"))   , testCase "Business Roost"-      (Transaction (fromGregorian 2012 2 14) "Roost" "Yay fun" (-25) Nothing+      (transaction (fromGregorian 2012 2 14) "Roost" "Yay fun" (-25) Nothing                    (Just "Dining") True True [] @=?         (runP parseTransaction           "D2/14/12\nPRoost\nMYay fun\nT-25.00\nCX\nF\nLDining\n^\n"))   , testCase "Paycheck"-      (Transaction (fromGregorian 2018 3 4) "Galois" "" 50 Nothing Nothing-                   True False [SplitItem "" (-30) "Checking",-                               SplitItem "" (-20) "Savings"] @=?+      (transaction (fromGregorian 2018 3 4) "Galois" "" 50 Nothing Nothing+                   True False [set entryAmount (-30) $+                               set entryCategory "Checking" emptySplitItem,+                               set entryAmount (-20) $+                               set entryCategory "Savings" emptySplitItem] @=?         (runP parseTransaction          "D3/4/18\nPGalois\nM\nT50.0\nCX\nSChecking\nE\n$-30.0\nSSavings\nE\n$-20\n^\n"))   , testProperty "Transaction serialization"       (standardSerializer parseTransaction renderTransaction)   ] +transaction :: Day -> S.Text -> S.Text -> Currency ->+               Maybe Word -> Maybe S.Text -> Bool -> Bool -> [SplitItem] ->+               Transaction+transaction d p m a n c l r s =+  set entDate         d $+  set entParty        p $+  set entMemo         m $+  set entAmount       a $+  set entNumber       n $+  set entCategory     c $+  set entCleared      l $+  set entReimbursable r $+  set entSplits       s emptyTransaction+ testInvTransaction :: TestTree testInvTransaction =   testGroup "Interest Transactions" [     testCase "Dividend"-      (Dividend (TradeInfo (fromGregorian 2065 7 7) "SEC" Nothing (Just 0) (Just 0) 0)+      (Dividend (set tradeSecurity "SEC" $+                 set tradeSharePrice Nothing $+                 set tradeQuantity (Just 0) $+                 set tradeCommission (Just 0) $+                 set tradeTotalAmount 0 (emptyTrade (fromGregorian 2065 7 7)))         @=?          (runP parseInvTransaction             "D7/7/65\nNDiv\nYSEC\nQ0\nO0.00\nT0\n^\n"))   , testCase "Dividend, with share price"-      (Dividend (TradeInfo (fromGregorian 2065 7 7) "SEC" (Just 0) (Just 0) (Just 0) 0)+      (Dividend (set tradeSecurity "SEC" $+                 set tradeSharePrice (Just 0) $+                 set tradeQuantity (Just 0) $+                 set tradeCommission (Just 0) $+                 set tradeTotalAmount 0 (emptyTrade (fromGregorian 2065 7 7)))         @=?          (runP parseInvTransaction             "D7/7/65\nNDiv\nYSEC\nI0\nQ0\nO0.00\nT0\n^\n"))@@ -229,7 +283,7 @@   , testProperty  "Investment Entries"       (standardSerializer parseInvestmentEntries renderInvestmentEntries)   , testProperty  "Bank Entries"-      (standardSerializer parseTransactionList renderTransactionList)+      (standardSerializer parseBankEntryList renderBankEntryList)   , testProperty  "Credit Card Entries"       (standardSerializer parseCreditCardEntryList renderCreditCardEntryList)   , testProperty  "Asset Entries"@@ -277,8 +331,15 @@                          PreciousMetal, Commodity, StockOption, Other ]  instance Arbitrary Security where-  arbitrary = Security <$> arbitrary <*> arbitrary <*> arbitrary-                       <*> arbitrary+  arbitrary =+    do n <- arbitrary+       t <- arbitrary+       y <- arbitrary+       g <- arbitrary+       return $ set secName   n+              $ set secTicker t+              $ set secType   y+              $ set secGoal   g emptySecurity  instance Arbitrary S.Text where   arbitrary =@@ -291,21 +352,48 @@                          InvestmentAccount, AssetAccount, LiabilityAccount ]  instance Arbitrary Account where-  arbitrary = Account <$> arbitrary <*> arbitrary <*> arbitrary-                      <*> arbitrary <*> arbitrary <*> arbitrary+  arbitrary =+    do (n, t, d, cl, bd, b) <- arbitrary+       return $ set accountName        n+              $ set accountType        t+              $ set accountDescription d+              $ set accountCreditLimit cl+              $ set accountBalanceDate bd+              $ set accountBalance     b emptyAccount  instance Arbitrary Category where-  arbitrary = Category <$> arbitrary <*> arbitrary <*> elements [Income,Expense]-                       <*> arbitrary <*> arbitrary <*> arbitrary+  arbitrary =+    do k <- elements [Income, Expense]+       (n, d, it, ba, ts) <- arbitrary+       return $ set catName            n+              $ set catDescription     d+              $ set catKind            k+              $ set catIsTaxRelated    it+              $ set catBudgetAmount    ba+              $ set catTaxScheduleInfo ts emptyCategory  instance Arbitrary TradeInfo where-  arbitrary = TradeInfo <$> arbitrary <*> arbitrary <*> arbitrary-                        <*> arbitrary <*> arbitrary <*> arbitrary+  arbitrary =+    do (d, s, p, q, c, a) <- arbitrary+       day <- arbitrary+       return $ set tradeDate        d+              $ set tradeSecurity    s+              $ set tradeSharePrice  p+              $ set tradeQuantity    q+              $ set tradeCommission  c+              $ set tradeTotalAmount a (emptyTrade day)  instance Arbitrary TransferInfo where-  arbitrary = TransferInfo <$> arbitrary <*> arbitrary <*> arbitrary-                           <*> arbitrary <*> arbitrary <*> arbitrary-                           <*> arbitrary+  arbitrary =+    do (d, s, m, a, c, t, p) <- arbitrary+       day <- arbitrary+       return $ set transDate        d+              $ set transSummary     s+              $ set transMemo        m+              $ set transAmount      a+              $ set transCleared     c+              $ set transAccount     t+              $ set transSplits      p (emptyTransfer day)  instance Arbitrary InvTransaction where   arbitrary = oneof [ Buy      <$> arbitrary@@ -316,9 +404,31 @@                     ]  instance Arbitrary SplitItem where-  arbitrary = SplitItem <$> arbitrary <*> arbitrary <*> arbitrary+  arbitrary =+    do (m, a, c) <- arbitrary+       return $ set entryMemo     m+              $ set entryAmount   a+              $ set entryCategory c emptySplitItem  instance Arbitrary Transaction where-  arbitrary = Transaction <$> arbitrary <*> arbitrary <*> arbitrary-                        <*> arbitrary <*> arbitrary <*> arbitrary-                        <*> arbitrary <*> arbitrary <*> arbitrary+  arbitrary =+    do (d,p,m,a,n,c,l,r,s) <- arbitrary+       return $ set entDate         d+              $ set entParty        p+              $ set entMemo         m+              $ set entAmount       a+              $ set entNumber       n+              $ set entCategory     c+              $ set entCleared      l+              $ set entReimbursable r+              $ set entSplits       s emptyTransaction++instance Arbitrary QIF where+  arbitrary =+    do (a, c, s, i, n) <- arbitrary+       return $ set qifAccounts               a+              $ set qifCategories             c+              $ set qifSecurities             s+              $ set qifInvestmentTransactions i+              $ set qifNormalTransactions     n emptyQIF+

@@ -1,5 +1,5 @@ name:                qif-version:             1.0.0+version:             1.1.0 synopsis:            A simple QIF file format parser / printer description:         A handy little library for dealing with this awful little                      QIF files in your life.@@ -32,12 +32,14 @@ test-suite test-qif-serialization   type:                exitcode-stdio-1.0   main-is:             Test.hs+  ghc-options:         -Wall   default-language:    Haskell2010   other-extensions:    OverloadedStrings   build-depends:                        attoparsec       >= 0.13  && < 0.15,                        base             >= 4.7  && < 4.10,                        QuickCheck       >= 2.9  && < 3.0,+                       microlens        >= 0.4.7 && < 0.6,                        tasty            >= 0.11 && < 0.15,                        tasty-hunit      >= 0.9  && < 0.12,                        tasty-quickcheck >= 0.8  && < 0.12,

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