ofx 0.4.0.4 → 0.4.2.0
raw patch · 6 files changed
+1104/−1024 lines, 6 filesdep ~basedep ~parsecdep ~prettynew-component:exe:renderOfxnew-component:exe:renderTransactions
Dependency ranges changed: base, parsec, pretty
Files
- Data/OFX.hs +0/−976
- LICENSE +13/−14
- exe/renderOfx.hs +9/−0
- exe/renderTransactions.hs +9/−0
- lib/Data/OFX.hs +1004/−0
- ofx.cabal +69/−34
− Data/OFX.hs
@@ -1,976 +0,0 @@-{-# LANGUAGE OverloadedStrings, FlexibleContexts #-}--- | Parser for downloaded OFX files.------ This parser was written based on the OFX version 1.03--- specification, which is available at------ <http://www.ofx.net>------ It will probably work on earlier versions of OFX without--- incident. However, it may or may not not work on newer versions of--- OFX, which are XML based (this version of OFX is SGML based.)------ It will also parse QFX files, which are OFX files with minor--- proprietary additions by Intuit, the maker of Quicken.------ An OFX file consists of three parts: the HTTP headers (which this--- parser does NOT handle because typically they will not show up in--- files downloaded to disk), the OFX headers, and the OFX data. This--- parser handles the OFX headers and the OFX data.------ The parser in this module simply parses the tags and data into a--- tree, which you can manipulate with other functions. Some functions--- are provided to find the transactions in the tree and place them--- into a 'Transaction' type, which is the data you are most likely--- interested in. If you are interested in other data you can query--- the 'Tag' tree for what you need.------ For example, to read in the filename given on the command line and--- parse it and print it nicely:------ > import System.Environment--- > import Text.Parsec--- > import Text.PrettyPrint--- > import Data.OFX--- > import System.IO--- > import System.Exit--- >--- > main :: IO ()--- > main = do--- > filename:[] <- getArgs--- > contents <- readFile filename--- > ofx <- case parse ofxFile filename contents of--- > Left e -> do--- > hPutStrLn stderr . show $ e--- > exitFailure--- > Right g -> return g--- > putStrLn . render . pFile $ ofx--- > putStrLn--- > . render--- > . pExceptional text (pList . map pTransaction)--- > . transactions--- > $ ofx--- > putStrLn . render . pMaybe text . fiName $ ofx--- > putStrLn . render . pMaybe text . accountNumber $ ofx-----module Data.OFX- ( -- * Error handling- Err- - -- * The OFX data tree- , HeaderTag- , HeaderValue- , OFXHeader(..)- , TagName- , TagData- , Tag(..)- , OFXFile(..)-- -- * Manipulating the OFX tag tree- , find- , findPath- , tagData- , pathData- , findData-- -- * Extracting specific data- , fiName- , creditCardNumber- , bankAccountNumber- , accountNumber-- -- * Types to represent specific OFX data- , Transaction(..)- , transaction- , transactions- , TrnType(..)- , trnType- , Payee(..)- , payee- , CorrectAction(..)- , BankAcctTo(..)- , bankAcctTo- , CCAcctTo(..)- , ccAcctTo- , AcctType(..)- , acctType- , CurrencyData(..)- , currencyData- , Currency(..)- , currency- , OrigCurrency(..)- , origCurrency-- -- * Parsec parsers- , ofxFile- , newline- , escChar- , header- , openingTag- , closingTag- , tag- , date- , time- , tzOffset-- -- * Pretty printers- , pPayee- , pTransaction- , pTag- , pHeader- , pFile- , pEither- , pMaybe- , pList- , label- , pExceptional- ) where------- # Imports-----import Control.Applicative (many, optional, (<|>))-import Control.Monad (replicateM)-import qualified Data.Time as T- -import Text.Parsec.String (Parser)-import Text.Parsec- ( lookAhead, char, manyTill, anyChar, (<?>), eof,- try, digit, many1, spaces, string, choice )-import qualified Text.Parsec as P-import Data.Maybe (listToMaybe)-import Data.Monoid ((<>))-import qualified Data.Monoid as M-import Text.PrettyPrint- ( Doc, hang, text, sep, vcat, nest, (<+>), ($$),- parens, brackets )-------- # Error handling------- | Error handling. Errors are indicated with a Left String;--- successes with a Right.-type Err = Either String------- # Data types------- | Headers consists of simple @tag:value@ pairs; this represents the--- tag.-type HeaderTag = String---- | The value in an OFX header.-type HeaderValue = String---- | An OFX file starts with a number of headers, which take the form--- @tag:value@ followed by a newline. These are followed by a blank--- line.-data OFXHeader = OFXHeader HeaderTag HeaderValue- deriving (Eq, Show)---- | The name of an OFX tag-type TagName = String---- | The data accompanying an OFX tag.-type TagData = String---- | The main OFX data consists of a series of tags. OFX 1.03 is SGML,--- not XML. This means that opening tags need not have closing--- tags. In OFX, a tag either has data and no child elements, or it--- has no data and it has child elements.-data Tag = Tag TagName (Either TagData [Tag])- deriving (Eq, Show)---- | All the data from an OFX file.-data OFXFile = OFXFile- { fHeader :: [OFXHeader]-- , fTag :: Tag- -- ^ All the data will be contained in a root tag with the TagName- -- @OFX@.-- } deriving (Eq, Show)------- # Parsers------- | Parses either a UNIX or an MS-DOS newline. According to 1.2.2,--- OFX does not contain any white space between tags. However, since I--- have seen OFX files that do have whitespace between tags, the--- parser makes allowance for this.-newline :: Parser ()-newline = () <$ char '\n' <|> () <$ (char '\r' *> char '\n')- <?> "newline"---- | Parses a character, possibly with an escape sequence. The--- greater-than sign, less-than sign, and ampersand must be entered--- with escape sequences.------ According to OFX spec section 2.3.2.1, ampersands, less-than signs,--- and greater-than signs must appear as entities. However some banks--- deliver broken OFX files that do not use entities for ampersands--- (and possibly for less-than or greater-than signs too, although I--- have not yet observed such behavior.) There is now an error message--- that reflects this problem. Client code can filter the OFX data--- for known offenders before passing it to this library.-escChar :: Parser Char-escChar =- do- c <- anyChar- case c of- '&' -> do- let mkParser (ch, str) = try (ch <$ string str)- ent <- choice (map mkParser- [('<', "lt"), ('>', "gt"), ('&', "amp")])- <?> ( "entity (\"lt\", \"gt\", or \"amp\")\n"- ++ "some banks create broken OFX files. Try\n"- ++ "removing the ampersands from the file and\n"- ++ "trying again.")- _ <- char ';'- return ent- _ -> return c- <?> "character"--header :: Parser OFXHeader-header- = OFXHeader- <$> manyTill anyChar (char ':')- <* optional (many (char ' '))- <*> manyTill anyChar newline- <?> "OFX header"- --- | Parses any opening tag. Returns the name of the tag.-openingTag :: Parser TagName-openingTag =- do- _ <- char '<'- cs <- manyTill escChar (char '>')- case cs of- [] -> fail "opening tag with empty name"- x:_ ->- if x == '/'- then fail "this is a closing tag"- else return cs- <?> "opening tag"---- | Parses a closing tag with the given name.-closingTag :: TagName -> Parser ()-closingTag n =- do- _ <- char '<'- _ <- char '/'- cs <- manyTill escChar (char '>')- if cs == n- then return ()- else fail $ "expecting closing tag named " ++ n- ++ "; saw closing tag named " ++ cs- <?> "closing tag named " ++ n---- | Parses any tag. The tag itself must be followed by at least one--- character: either the next tag if this is an aggregate tag, or the--- data if this is a data tag. OFX does not allow empty tags.------ The OFX spec seems to say that OFX files do not include trailing--- newlines after tags or data, but I have seen these newlines in QFX--- files, so this parses optional trailing newlines and spaces.-tag :: Parser Tag-tag =- do- -- try is needed because openingTag will overlap with closingTag- n <- try (openingTag <* spaces)- children <- many tag- if null children- then Tag n . Left- <$> manyTill escChar- (eof <|> lookAhead (() <$ char '<') <|> newline)- <* spaces- <* optional (try (closingTag n))- <* spaces- else Tag n (Right children) <$ spaces <* closingTag n- <* spaces- <?> "OFX tag"- ---- | Parses an entire OFX file, including headers.-ofxFile :: Parser OFXFile-ofxFile- = OFXFile- <$> manyTill header newline- <*> tag- <* spaces- <* eof- <?> "OFX file"---- | Parses an OFX date; provides an error message if the parse fails.-parseDate :: String -> Err T.ZonedTime-parseDate s = case P.parse date "" s of- Left e -> Left $ "could not parse date: " ++ s ++ ": "- ++ show e- Right g -> return g---- | Parses an OFX date. Fails if the date is not valid or if there is--- no date to be parsed.-date :: Parser T.ZonedTime-date =- do- ys <- fmap read $ replicateM 4 digit- ms <- fmap read $ replicateM 2 digit- ds <- fmap read $ replicateM 2 digit- day <- case T.fromGregorianValid ys ms ds of- Nothing -> fail $ "invalid date: " ++ show ys- ++ "-" ++ show ms ++ "-" ++ show ds- Just d -> return d- mayTime <- optional time- case mayTime of- Nothing ->- let localTime = T.LocalTime day T.midnight- in return $ T.ZonedTime localTime T.utc- Just (t, z) -> return $ T.ZonedTime (T.LocalTime day t) z- <?> "date"-- --- | Parses an OFX time. Fails if the time is not valid or if there is--- no time to parse. Fails if there is no time to parse; however, if--- there is a time but no zone, returns the time and UTC for the zone.-time :: Parser (T.TimeOfDay, T.TimeZone)-time =- do- h <- fmap read $ replicateM 2 digit- m <- fmap read $ replicateM 2 digit- s <- fmap read $ replicateM 2 digit- (milli, tz) <- do- mayDot <- optional (char '.')- case mayDot of- Nothing -> return (0, T.utc)- Just _ -> do- mil <- fmap ((/ 1000) . read) $ replicateM 3 digit- mayTz <- optional tzOffset- case mayTz of- Nothing -> return (mil, T.utc)- Just t -> return (mil, t)- let sec = s + milli- return (T.TimeOfDay h m sec, tz)- <?> "time"- ---- | Parses a time zone offset. Fails if there is no time zone offset--- to parse.-tzOffset :: Parser T.TimeZone-tzOffset =- do- _ <- char '['- sn <- parseSign- whole <- many1 digit- mayDot <- optional (char '.')- frac <- case mayDot of- Nothing -> return "0"- Just _ -> many1 digit- mayColon <- optional (char ':')- name <- case mayColon of- Nothing -> return ""- Just _ -> many1 P.letter- _ <- char ']'- let off = sn $ round ((read (whole ++ "." ++ frac))- * (60 :: Double))- return $ T.TimeZone off False name- <?> "time zone offset"- where- parseSign = do- mayMinus <- optional (char '-')- case mayMinus of- Nothing -> do- mayPlus <- optional (char '+')- return $ case mayPlus of- Nothing -> id- Just _ -> negate- Just _ -> return negate------- # Manipulating trees of tags------- | Finds child tags with the given name. When a tag is found, that--- tag is not searched for further children with the same name.-find :: TagName -> Tag -> [Tag]-find n t@(Tag x p)- | n == x = [t]- | otherwise = case p of- Left _ -> []- Right ts -> concatMap (find n) ts---- | Descends through a tree of tags to find a tag at a specific--- location in the tree. Fails if any part of the search fails. For--- example, to find the financial institution ORG tag, where @t@ is--- the root @OFX@ tag:------ > findPath ["SIGNONMSGSRSV1", "SONRS", "FI", "ORG"] t--findPath :: [TagName] -> Tag -> Maybe Tag-findPath [] t = Just t-findPath (n:ns) t = case listToMaybe (find n t) of- Nothing -> Nothing- Just r -> findPath ns r---- | Gets the data from a tag, if it is a tag with data.-tagData :: Tag -> Maybe TagData-tagData (Tag _ ei) = either return (const Nothing) ei---- | Goes to a certain path in the tag hierarchy and pulls the--- requested data, if the tag is present and it is a data tag. For--- example, to get the name of the financial institution:------ > pathData ["SIGNONMSGSRSV1", "SONRS", "FI", "ORG"] f-pathData :: [TagName] -> OFXFile -> Maybe TagData-pathData p (OFXFile _ t) = findPath p t >>= tagData----- | Gets the name of the financial institution from the FI tag, if--- available. The OFX spec does not require this tag to be present.-fiName :: OFXFile -> Maybe TagData-fiName = pathData ["SIGNONMSGSRSV1", "SONRS", "FI", "ORG"]----- | Gets the credit card number, if available. The OFX spec does not--- require this tag to be present.-creditCardNumber :: OFXFile -> Maybe TagData-creditCardNumber =- pathData [ "CREDITCARDMSGSRSV1", "CCSTMTTRNRS", "CCSTMTRS",- "CCACCTFROM", "ACCTID" ]---- | Gets the bank account number, if available. The OFX spec does not--- require this tag to be present.-bankAccountNumber :: OFXFile -> Maybe TagData-bankAccountNumber =- pathData [ "BANKMSGSRSV1", "STMTTRNRS", "STMTRS",- "BANKACCTFROM", "ACCTID" ]---- | Gets either the credit card or bank account number, if available.-accountNumber :: OFXFile -> Maybe TagData-accountNumber f = creditCardNumber f <|> bankAccountNumber f- ---- | Finds the first tag (either this tag or any children) that has--- the given name and that is a data tag (not an aggregate tag.) If no--- data tag with the given name is found, returns Nothing.-findData :: TagName -> Tag -> Maybe TagData-findData n (Tag tn e) = case e of- Left d -> if tn == n then Just d else Nothing- Right ts -> M.getFirst . M.mconcat . map M.First- . map (findData n) $ ts----- | Finds the first tag (either this tag or any children) that has--- the given name and that is a data tag. Gives an error message if--- the tag is not found.-required :: TagName -> Tag -> Err TagData-required n t = case findData n t of- Nothing -> Left $ "required tag missing: " ++ n- Just r -> return r-------- # OFX data--- ---- | OFX transaction types. These are used in STMTTRN aggregates, see--- OFX spec section 11.4.2.3.1.1.-data TrnType- = TCREDIT- | TDEBIT-- | TINT- -- ^ Interest earned or paid (which it is depends on sign of amount)-- | TDIV- -- ^ Dividend-- | TFEE- | TSRVCHG-- | TDEP- -- ^ Deposit-- | TATM- -- ^ ATM debit or credit (which it is depends on sign of amount)-- | TPOS- -- ^ Point of sale debit or credit (which it is depends on sign of- -- amount)-- | TXFER- -- ^ Transfer-- | TCHECK- | TPAYMENT- -- ^ Electronic payment-- | TCASH- -- ^ Cash withdrawal-- | TDIRECTDEP- -- ^ Direct deposit-- | TDIRECTDEBIT- -- ^ Merchant initiated debit-- | TREPEATPMT- -- ^ Repeating payment / standing order-- | TOTHER- deriving (Eq, Ord, Show)---- | A single STMTTRN, see OFX spec section 11.4.2.3.1. This is most--- likely what you are interested in after downloading a statement--- from a bank.-data Transaction = Transaction- { txTRNTYPE :: TrnType- -- ^ Transaction type-- , txDTPOSTED :: T.ZonedTime- -- ^ Date transaction was posted to account-- , txDTUSER :: Maybe T.ZonedTime- -- ^ Date user initiated transaction, if known-- , txDTAVAIL :: Maybe T.ZonedTime- -- ^ Date funds are available-- , txTRNAMT :: String- -- ^ Amount of transaction. This is left as the string that was- -- originally in the download. That means the transaction may- -- include a plus or minus sign (no sign is the same as a plus- -- sign.) According to section 3.2.9.2, amounts are always signed- -- from the perspective of the customer.- --- -- Typically negative amounts:- --- -- * Investment buy amount, investment sell quantity- --- -- * Bank statement debit amounts, checks, fees- --- -- * Credit card purchases- --- -- * Margin balance (unless the institution owes the client money)- --- -- Typically positive amounts:- --- -- * Investment sell amount, investment buy quantity- --- -- * Bank statement credits- --- -- * Credit card payments- --- -- * Ledger balance (unless the account is overdrawn)- --- -- Formats for amounts are described in 3.2.9.1. If there is no- -- decimal point, there is an implied decimal point at the end of- -- the value. Trailing and leading spaces \"should\" be- -- stripped. Positive or minus is indicated with a leading sign; a- -- plus sign is assumed if there is no sign.- --- -- An amount has a maximum of 32 alphanumeric characters,- -- including digits and punctuation.- --- -- The radix point is indicated with either a period or a- -- comma. Amounts \"should\" not include any digit grouping- -- characters.-- , txFITID :: String- -- ^ Transaction ID issued by financial institution. Used to- -- detect duplicate downloads.-- , txCORRECTFITID :: Maybe String- -- ^ If present, this indicates the FITID of a previously sent- -- transaction that is corrected by this record. This transaction- -- replaces or deletes the transaction that it corrects, based on- -- the value of CORRECTACTION below.-- , txCORRECTACTION :: Maybe CorrectAction- -- ^ See 'CorrectAction' and 'txCORRECTFITID'-- , txSRVRTID :: Maybe String- -- ^ Server assigned transaction ID; used for transactions- -- initiated by client, such as payment or funds transfer-- , txCHECKNUM :: Maybe String- -- ^ Check or other reference number-- , txREFNUM :: Maybe String- -- ^ Reference number that uniquely identifies the- -- transaction. Can be used in addition to or instead of a- -- CHECKNUM.-- , txSIC :: Maybe String- -- ^ Standard Industrial Code-- , txPAYEEID :: Maybe String- -- ^ Payee identifier if available-- , txPayeeInfo :: Maybe (Either String Payee)- -- ^ Information on the payee. The OFX spec seems to be saying- -- that every transaction must have either NAME, wich is \"name of- -- payee or description of transaction\", or the Payee- -- aggregate. The former is indicated with a Left, the latter with- -- a Right.-- , txAccountTo :: Maybe (Either BankAcctTo CCAcctTo)- -- ^ Information on a transfer. If this transaction wa sa- -- transfer, this may contain information about the account being- -- transferred to.-- , txMEMO :: Maybe String- -- ^ Extra information not in NAME-- , txCurrency :: Maybe (Either Currency OrigCurrency)- -- ^ Currency option. OFX spec says to choose either CURRENCY or- -- ORIGCURRENCY.- } deriving (Show)--data Payee = Payee- { peNAME :: String- , peADDR1 :: String- , peADDR2 :: Maybe String- , peADDR3 :: Maybe String- , peCITY :: String- , peSTATE :: String- , pePOSTALCODE :: String- , peCOUNTRY :: Maybe String- , pePHONE :: String- } deriving (Eq, Show)---- | Can be either REPLACE or DELETE.-data CorrectAction- = REPLACE- -- ^ Replaces the transaction referenced by the CORRECTFITID-- | DELETE- -- ^ Deletes the transaction referenced by the CORRECTFITID- deriving (Eq, Show, Read)--data BankAcctTo = BankAcctTo- { btBANKID :: String- -- ^ Routing and transit number-- , btBRANCHID :: Maybe String- -- ^ Bank identifier for international banks-- , btACCTID :: String- -- ^ Account number-- , btACCTTYPE :: AcctType- -- ^ Type of account-- , btACCTKEY :: Maybe String- -- ^ Checksum for international banks- } deriving Show--data CCAcctTo = CCAcctTo- { ctACCTID :: String- -- ^ Account number-- , ctACCTKEY :: Maybe String- -- ^ Checksum for international banks-- } deriving (Eq, Show)--data AcctType- = ACHECKING- | ASAVINGS- | AMONEYMRKT- | ACREDITLINE- deriving (Eq, Show, Ord)--acctType :: String -> Err AcctType-acctType s- | s == "CHECKING" = return ACHECKING- | s == "SAVINGS" = return ASAVINGS- | s == "MONEYMRKT" = return AMONEYMRKT- | s == "CREDITLINE" = return ACREDITLINE- | otherwise = Left $ "unrecognized account type: " ++ s---- | Holds all data both for CURRENCY and for ORIGCURRENCY.-data CurrencyData = CurrencyData-- { cdCURRATE :: String- -- ^ Ratio of CURDEF currency to CURSYM currency, in decimal form-- , cdCURSYM :: String- -- ^ ISO-4217 3-letter currency identifier- } deriving (Eq, Show)--data Currency = Currency CurrencyData- deriving (Eq, Show)--data OrigCurrency = OrigCurrency CurrencyData- deriving (Eq, Show)------- # Helpers to build aggregates----trnType :: TagData -> Maybe TrnType-trnType d = case d of- "CREDIT" -> Just TCREDIT- "DEBIT" -> Just TDEBIT- "INT" -> Just TINT- "DIV" -> Just TDIV- "FEE" -> Just TFEE- "SRVCHG" -> Just TSRVCHG- "DEP" -> Just TDEP- "ATM" -> Just TATM- "POS" -> Just TPOS- "XFER" -> Just TXFER- "CHECK" -> Just TCHECK- "PAYMENT" -> Just TPAYMENT- "CASH" -> Just TCASH- "DIRECTDEP" -> Just TDIRECTDEP- "DIRECTDEBIT" -> Just TDIRECTDEBIT- "REPEATPMT" -> Just TREPEATPMT- "OTHER" -> Just TOTHER- _ -> Nothing----- | Gets a single Transaction from a tag. The tag should be the one--- named STMTTRN. Fails with an error message if any required field--- was not present.-transaction :: Tag -> Err Transaction-transaction t = do- let fromMaybe e = maybe (Left e) Right- trntyStr <- required "TRNTYPE" t- trnTy <- fromMaybe ("could not parse transaction type: " ++ trntyStr)- $ trnType trntyStr-- dtpStr <- required "DTPOSTED" t- dtp <- parseDate dtpStr-- let mayDtuStr = findData "DTUSER" t- dtu <- maybe (return Nothing) (fmap Just . parseDate) mayDtuStr- - let mayDtAvail = findData "DTAVAIL" t-- dta <- maybe (return Nothing) (fmap Just . parseDate) mayDtAvail- amt <- required "TRNAMT" t- fitid <- required "FITID" t- let correctFitId = findData "CORRECTFITID" t- correctAct <-- case findData "CORRECTACTION" t of- Nothing -> return Nothing- Just d -> - maybe (return Nothing)- (fromMaybe ("could not parse correct action: " ++ d))- . safeRead- $ d- let srvrtid = findData "SRVRTID" t- checknum = findData "CHECKNUM" t- refnum = findData "REFNUM" t- sic = findData "SIC" t- payeeId = findData "PAYEEID" t-- let mayPyeInfo = fmap (return . Left) (findData "NAME" t)- <|> fmap (fmap Right) (payee t)- pyeInfo <- maybe (return Nothing) (fmap Just) mayPyeInfo- - let mayAcctTo = (fmap (fmap Left) $ bankAcctTo t)- <|> (fmap (fmap Right) $ ccAcctTo t)- mayCcy = (fmap (fmap Left) $ currency t)- <|> (fmap (fmap Right) $ origCurrency t)- acctTo <- maybe (return Nothing) (fmap Just) mayAcctTo- ccy <- maybe (return Nothing) (fmap Just) mayCcy- let memo = findData "MEMO" t-- return Transaction- { txTRNTYPE = trnTy- , txDTPOSTED = dtp- , txDTUSER = dtu- , txDTAVAIL = dta- , txTRNAMT = amt- , txFITID = fitid- , txCORRECTFITID = correctFitId- , txCORRECTACTION = correctAct- , txSRVRTID = srvrtid- , txCHECKNUM = checknum- , txREFNUM = refnum- , txSIC = sic- , txPAYEEID = payeeId- , txPayeeInfo = pyeInfo- , txAccountTo = acctTo- , txMEMO = memo- , txCurrency = ccy- } ---- | Parses a Payee record from its parent tag.-payee- :: Tag- -- ^ The tag which contains the PAYEE tag, if there is one. This- -- would typically be a STMTTRN tag.-- -> Maybe (Err Payee)- -- ^ Nothing if there is no PAYEE tag. Just if a PAYEE tag is found,- -- with a Left if the tag is lacking a required element, or a- -- Right if the tag is successfully parsed.- --- -- If there is more than one PAYEE tag, only the first one is- -- considered.-payee = fmap getPayee . listToMaybe . find "PAYEE"- where- getPayee t = Payee- <$> required "NAME" t- <*> required "ADDR1" t- <*> pure (findData "ADDR2" t)- <*> pure (findData "ADDR3" t)- <*> required "CITY" t- <*> required "STATE" t- <*> required "POSTALCODE" t- <*> pure (findData "COUNTRY" t)- <*> required "PHONE" t- --currency :: Tag -> Maybe (Err Currency)-currency- = fmap (fmap Currency)- . fmap currencyData- . listToMaybe- . find "CURRENCY"--origCurrency :: Tag -> Maybe (Err OrigCurrency)-origCurrency- = fmap (fmap OrigCurrency)- . fmap currencyData- . listToMaybe- . find "ORIGCURRENCY"----- | Parses currency data.-currencyData- :: Tag- -- ^ The tag that contains the data, e.g. CURRENCY or ORIGCURRENCY.-- -> Err CurrencyData-currencyData t = CurrencyData- <$> required "CURRATE" t- <*> required "CURSYM" t--bankAcctTo :: Tag -> Maybe (Err BankAcctTo)-bankAcctTo = fmap getTo . listToMaybe . find "BANKACCTTO"- where- getTo t = BankAcctTo- <$> required "BANKID" t- <*> pure (findData "BRANCHID" t)- <*> required "ACCTID" t- <*> (required "ACCTTYPE" t >>= acctType)- <*> pure (findData "ACCTKEY" t)--ccAcctTo :: Tag -> Maybe (Err CCAcctTo)-ccAcctTo = fmap getTo . listToMaybe . find "CCACCTTO"- where- getTo t = CCAcctTo- <$> required "ACCTID" t- <*> pure (findData "ACCTKEY" t)--safeRead :: Read a => String -> Maybe a-safeRead s = case reads s of- (x, ""):[] -> Just x- _ -> Nothing----- | Pulls all Transactions from a file. Might fail if the OFX file--- does not conform to the specification (or if there are bugs in this--- library.) In case of the former, you can manually parse the--- transaction information yourself using functions like--- 'pathData'. In case of the latter, please send bugreports :-)-transactions :: OFXFile -> Err [Transaction]-transactions = mapM transaction . find "STMTTRN" . fTag------- # Pretty printers----pPayee :: Payee -> Doc-pPayee p = hang "Payee:" 2 ls- where- ls = sep [ label "Name" (text . peNAME $ p)- , label "Addr1" (text . peADDR1 $ p)- , label "Addr2" (pMaybe text . peADDR2 $ p)- , label "Addr3" (pMaybe text . peADDR3 $ p)- , label "City" (text . peCITY $ p)- , label "State" (text . peSTATE $ p)- , label "Postal" (text . pePOSTALCODE $ p)- , label "Country" (pMaybe text . peCOUNTRY $ p)- , label "Phone" (text . pePHONE $ p)- ]--pTransaction :: Transaction -> Doc-pTransaction a = hang "Transaction:" 2 ls- where- ls = sep [ label "TRNTYPE" (text . show . txTRNTYPE $ a)- , label "DTPOSTED" (text . show . txDTPOSTED $ a)- , label "DTUSER" (text . show . txDTUSER $ a)- , label "DTAVAIL" (text . show . txDTAVAIL $ a)- , label "TRNAMT" (text . txTRNAMT $ a)- , label "FITID" (text . txFITID $ a)- , label "CORRECTFITID"- (pMaybe text . txCORRECTFITID $ a)- , label "CORRECTACTION"- (text . show . txCORRECTACTION $ a)- , label "SRVRTID" (pMaybe text . txSRVRTID $ a)- , label "CHECKNUM" (pMaybe text . txCHECKNUM $ a)- , label "REFNUM" (pMaybe text . txREFNUM $ a)- , label "SIC" (pMaybe text . txSIC $ a)- , label "PAYEEID" (pMaybe text . txPAYEEID $ a)- , label "PAYEEINFO"- (pMaybe (pEither text (text . show)) . txPayeeInfo $ a)- , label "ACCOUNTTO"- (pMaybe id . fmap (text . show)- . txAccountTo $ a)- , label "MEMO" (pMaybe text . txMEMO $ a)- , label "CURRENCY"- (pMaybe (text . show) . txCurrency $ a)- ]--pTag :: Tag -> Doc-pTag (Tag n ei) = case ei of- Left d -> "<" <> text n <> ">" <> text d- Right ts -> vcat $ "<" <> text n <> ">"- : map (nest 2 . pTag) ts- ++ ["</" <> text n <> ">"]--pHeader :: OFXHeader -> Doc-pHeader (OFXHeader t v) = text t <> ": " <> text v--pFile :: OFXFile -> Doc-pFile (OFXFile hs t)- = "OFX file:"- $$ nest 2 (vcat [ pList . map pHeader $ hs- , mempty- , pTag t ])--pEither :: (a -> Doc) -> (b -> Doc) -> Either a b -> Doc-pEither fa fb = either (\l -> "Left" <+> parens (fa l))- (\r -> "Right" <+> parens (fb r))--pMaybe :: (a -> Doc) -> Maybe a -> Doc-pMaybe f = maybe "Nothing" (\x -> "Just" <+> parens (f x))--pList :: [Doc] -> Doc-pList ds = case ds of- [] -> "[]"- x:[] -> brackets x- x:xs -> sep $ hang "[" 2 x- : map (\d -> hang "," 2 d) xs- ++ [ "]" ]--label :: String -> Doc -> Doc-label s = hang (text (s ++ ":")) (length s + 2)--pExceptional- :: (e -> Doc)- -> (a -> Doc)- -> Either e a- -> Doc-pExceptional fe fa =- either (\e -> hang "Exception:" 2 $ parens (fe e))- (\g -> hang "Success:" 2 $ parens (fa g))
LICENSE view
@@ -1,27 +1,26 @@-Copyright (c) 2013, Omari Norman-+Copyright (c) 2016 Omari Norman All rights reserved. Redistribution and use in source and binary forms, with or without-modification, are permitted provided that the following conditions are met:+modification, are permitted provided that the following conditions are+met: - * Redistributions of source code must retain the above copyright- notice, this list of conditions and the following disclaimer.+1. Redistributions of source code must retain the above copyright+notice, this list of conditions and the following disclaimer. - * Redistributions in binary form must reproduce the above- copyright notice, this list of conditions and the following- disclaimer in the documentation and/or other materials provided- with the distribution.+2. Redistributions in binary form must reproduce the above copyright+notice, this list of conditions and the following disclaimer in the+documentation and/or other materials provided with the distribution. - * Neither the name of Omari Norman nor the names of other- contributors may be used to endorse or promote products derived- from this software without specific prior written permission.+3. Neither the name of the copyright holder nor the names of its+contributors may be used to endorse or promote products derived from+this software without specific prior written permission. -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDER AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT-OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+ exe/renderOfx.hs view
@@ -0,0 +1,9 @@+-- | Reads OFX file on standard input. Parses it and pretty prints+-- the result to standard output.++module Main where++import Data.OFX++main :: IO ()+main = interact prettyRenderOfxFile
+ exe/renderTransactions.hs view
@@ -0,0 +1,9 @@+-- | Reads OFX file on standard input, and gets all transactions.+-- Pretty prints the result to standard output.++module Main where++import Data.OFX++main :: IO ()+main = interact prettyRenderTransactions
+ lib/Data/OFX.hs view
@@ -0,0 +1,1004 @@+{-# LANGUAGE OverloadedStrings, FlexibleContexts #-}+-- | Parser for downloaded OFX files.+--+-- This parser was written based on the OFX version 1.03+-- specification, which is available at+--+-- <http://www.ofx.net>+--+-- It will probably work on earlier versions of OFX without+-- incident. However, it may or may not not work on newer versions of+-- OFX, which are XML based (this version of OFX is SGML based.)+--+-- It will also parse QFX files, which are OFX files with minor+-- proprietary additions by Intuit, the maker of Quicken.+--+-- An OFX file consists of three parts: the HTTP headers (which this+-- parser does NOT handle because typically they will not show up in+-- files downloaded to disk), the OFX headers, and the OFX data. This+-- parser handles the OFX headers and the OFX data.+--+-- The parser in this module simply parses the tags and data into a+-- tree, which you can manipulate with other functions. Some functions+-- are provided to find the transactions in the tree and place them+-- into a 'Transaction' type, which is the data you are most likely+-- interested in. If you are interested in other data you can query+-- the 'Tag' tree for what you need.+--+-- For example, to read in the filename given on the command line and+-- parse it and print it nicely:+--+-- The @ofx@ package includes two executable files that you can use at+-- the command line to test the library and see how it works. The+-- @renderTransactions@ executable reads an OFX file on standard+-- input, runs it through the 'prettyRenderTransactions' function, and+-- prints the result to standard output. The @renderOfx@ executable+-- reads an OFX file on standard input, runs it through the+-- 'prettyRenderOfxFile' function, and prints the result to standard+-- output.++module Data.OFX+ ( -- * Error handling+ Err+ + -- * The OFX data tree+ , HeaderTag+ , HeaderValue+ , OFXHeader(..)+ , TagName+ , TagData+ , Tag(..)+ , OFXFile(..)++ -- * Manipulating the OFX tag tree+ , find+ , findPath+ , tagData+ , pathData+ , findData++ -- * Extracting specific data+ , fiName+ , creditCardNumber+ , bankAccountNumber+ , accountNumber++ -- * Types to represent specific OFX data+ , Transaction(..)+ , transaction+ , transactions+ , TrnType(..)+ , trnType+ , Payee(..)+ , payee+ , CorrectAction(..)+ , BankAcctTo(..)+ , bankAcctTo+ , CCAcctTo(..)+ , ccAcctTo+ , AcctType(..)+ , acctType+ , CurrencyData(..)+ , currencyData+ , Currency(..)+ , currency+ , OrigCurrency(..)+ , origCurrency++ -- * Running parsers+ , parseOfxFile+ , parseTransactions+ , prettyRenderOfxFile+ , prettyRenderTransactions++ -- * Parsec parsers+ , ofxFile+ , newline+ , escChar+ , header+ , openingTag+ , closingTag+ , tag+ , date+ , time+ , tzOffset++ -- * Pretty printers+ , pPayee+ , pTransaction+ , pTag+ , pHeader+ , pFile+ , pEither+ , pMaybe+ , pList+ , label+ , pExceptional+ ) where++--+-- # Imports+--++import Control.Applicative (many, optional, (<|>))+import Control.Monad (replicateM, (<=<))+import qualified Data.Time as T+ +import Text.Parsec.String (Parser)+import Text.Parsec+ ( lookAhead, char, manyTill, anyChar, (<?>), eof,+ try, digit, many1, spaces, string, choice, parse )+import qualified Text.Parsec as P+import Data.Maybe (listToMaybe)+import Data.Monoid ((<>))+import qualified Data.Monoid as M+import Text.PrettyPrint+ ( Doc, hang, text, sep, vcat, nest, (<+>), ($$),+ parens, brackets, render )+++--+-- # Error handling+--++-- | Error handling. Errors are indicated with a Left String;+-- successes with a Right.+type Err = Either String++--+-- # Data types+--++-- | Headers consists of simple @tag:value@ pairs; this represents the+-- tag.+type HeaderTag = String++-- | The value in an OFX header.+type HeaderValue = String++-- | An OFX file starts with a number of headers, which take the form+-- @tag:value@ followed by a newline. These are followed by a blank+-- line.+data OFXHeader = OFXHeader HeaderTag HeaderValue+ deriving (Eq, Show, Read)++-- | The name of an OFX tag+type TagName = String++-- | The data accompanying an OFX tag.+type TagData = String++-- | The main OFX data consists of a series of tags. OFX 1.03 is SGML,+-- not XML. This means that opening tags need not have closing+-- tags. In OFX, a tag either has data and no child elements, or it+-- has no data and it has child elements.+data Tag = Tag TagName (Either TagData [Tag])+ deriving (Eq, Show, Read)++-- | All the data from an OFX file.+data OFXFile = OFXFile+ { fHeader :: [OFXHeader]++ , fTag :: Tag+ -- ^ All the data will be contained in a root tag with the TagName+ -- @OFX@.++ } deriving (Eq, Show, Read)++--+-- # Parsers+--++-- | Parses either a UNIX or an MS-DOS newline. According to 1.2.2,+-- OFX does not contain any white space between tags. However, since I+-- have seen OFX files that do have whitespace between tags, the+-- parser makes allowance for this.+newline :: Parser ()+newline = () <$ char '\n' <|> () <$ (char '\r' *> char '\n')+ <?> "newline"++-- | Parses a character, possibly with an escape sequence. The+-- greater-than sign, less-than sign, and ampersand must be entered+-- with escape sequences.+--+-- According to OFX spec section 2.3.2.1, ampersands, less-than signs,+-- and greater-than signs must appear as entities. However some banks+-- deliver broken OFX files that do not use entities for ampersands+-- (and possibly for less-than or greater-than signs too, although I+-- have not yet observed such behavior.) There is now an error message+-- that reflects this problem. Client code can filter the OFX data+-- for known offenders before passing it to this library.+escChar :: Parser Char+escChar =+ do+ c <- anyChar+ case c of+ '&' -> do+ let mkParser (ch, str) = try (ch <$ string str)+ ent <- choice (map mkParser+ [('<', "lt"), ('>', "gt"), ('&', "amp")])+ <?> ( "entity (\"lt\", \"gt\", or \"amp\")\n"+ ++ "some banks create broken OFX files. Try\n"+ ++ "removing the ampersands from the file and\n"+ ++ "trying again.")+ _ <- char ';'+ return ent+ _ -> return c+ <?> "character"++header :: Parser OFXHeader+header+ = OFXHeader+ <$> manyTill anyChar (char ':')+ <* optional (many (char ' '))+ <*> manyTill anyChar newline+ <?> "OFX header"+ +-- | Parses any opening tag. Returns the name of the tag.+openingTag :: Parser TagName+openingTag =+ do+ _ <- char '<'+ cs <- manyTill escChar (char '>')+ case cs of+ [] -> fail "opening tag with empty name"+ x:_ ->+ if x == '/'+ then fail "this is a closing tag"+ else return cs+ <?> "opening tag"++-- | Parses a closing tag with the given name.+closingTag :: TagName -> Parser ()+closingTag n =+ do+ _ <- char '<'+ _ <- char '/'+ cs <- manyTill escChar (char '>')+ if cs == n+ then return ()+ else fail $ "expecting closing tag named " ++ n+ ++ "; saw closing tag named " ++ cs+ <?> "closing tag named " ++ n++-- | Parses any tag. The tag itself must be followed by at least one+-- character: either the next tag if this is an aggregate tag, or the+-- data if this is a data tag. OFX does not allow empty tags.+--+-- The OFX spec seems to say that OFX files do not include trailing+-- newlines after tags or data, but I have seen these newlines in QFX+-- files, so this parses optional trailing newlines and spaces.+tag :: Parser Tag+tag =+ do+ -- try is needed because openingTag will overlap with closingTag+ n <- try (openingTag <* spaces)+ children <- many tag+ if null children+ then Tag n . Left+ <$> manyTill escChar+ (eof <|> lookAhead (() <$ char '<') <|> newline)+ <* spaces+ <* optional (try (closingTag n))+ <* spaces+ else Tag n (Right children) <$ spaces <* closingTag n+ <* spaces+ <?> "OFX tag"+ ++-- | Parses an entire OFX file, including headers.+ofxFile :: Parser OFXFile+ofxFile+ = OFXFile+ <$> manyTill header newline+ <*> tag+ <* spaces+ <* eof+ <?> "OFX file"++-- | Parses an OFX date; provides an error message if the parse fails.+parseDate :: String -> Err T.ZonedTime+parseDate s = case P.parse date "" s of+ Left e -> Left $ "could not parse date: " ++ s ++ ": "+ ++ show e+ Right g -> return g++-- | Parses an OFX date. Fails if the date is not valid or if there is+-- no date to be parsed.+date :: Parser T.ZonedTime+date =+ do+ ys <- fmap read $ replicateM 4 digit+ ms <- fmap read $ replicateM 2 digit+ ds <- fmap read $ replicateM 2 digit+ day <- case T.fromGregorianValid ys ms ds of+ Nothing -> fail $ "invalid date: " ++ show ys+ ++ "-" ++ show ms ++ "-" ++ show ds+ Just d -> return d+ mayTime <- optional time+ case mayTime of+ Nothing ->+ let localTime = T.LocalTime day T.midnight+ in return $ T.ZonedTime localTime T.utc+ Just (t, z) -> return $ T.ZonedTime (T.LocalTime day t) z+ <?> "date"++ +-- | Parses an OFX time. Fails if the time is not valid or if there is+-- no time to parse. Fails if there is no time to parse; however, if+-- there is a time but no zone, returns the time and UTC for the zone.+time :: Parser (T.TimeOfDay, T.TimeZone)+time =+ do+ h <- fmap read $ replicateM 2 digit+ m <- fmap read $ replicateM 2 digit+ s <- fmap read $ replicateM 2 digit+ (milli, tz) <- do+ mayDot <- optional (char '.')+ case mayDot of+ Nothing -> return (0, T.utc)+ Just _ -> do+ mil <- fmap ((/ 1000) . read) $ replicateM 3 digit+ mayTz <- optional tzOffset+ case mayTz of+ Nothing -> return (mil, T.utc)+ Just t -> return (mil, t)+ let sec = s + milli+ return (T.TimeOfDay h m sec, tz)+ <?> "time"+ ++-- | Parses a time zone offset. Fails if there is no time zone offset+-- to parse.+tzOffset :: Parser T.TimeZone+tzOffset =+ do+ _ <- char '['+ sn <- parseSign+ whole <- many1 digit+ mayDot <- optional (char '.')+ frac <- case mayDot of+ Nothing -> return "0"+ Just _ -> many1 digit+ mayColon <- optional (char ':')+ name <- case mayColon of+ Nothing -> return ""+ Just _ -> many1 P.letter+ _ <- char ']'+ let off = sn $ round ((read (whole ++ "." ++ frac))+ * (60 :: Double))+ return $ T.TimeZone off False name+ <?> "time zone offset"+ where+ parseSign = do+ mayMinus <- optional (char '-')+ case mayMinus of+ Nothing -> do+ mayPlus <- optional (char '+')+ return $ case mayPlus of+ Nothing -> id+ Just _ -> negate+ Just _ -> return negate++--+-- # Manipulating trees of tags+--++-- | Finds child tags with the given name. When a tag is found, that+-- tag is not searched for further children with the same name.+find :: TagName -> Tag -> [Tag]+find n t@(Tag x p)+ | n == x = [t]+ | otherwise = case p of+ Left _ -> []+ Right ts -> concatMap (find n) ts++-- | Descends through a tree of tags to find a tag at a specific+-- location in the tree. Fails if any part of the search fails. For+-- example, to find the financial institution ORG tag, where @t@ is+-- the root @OFX@ tag:+--+-- > findPath ["SIGNONMSGSRSV1", "SONRS", "FI", "ORG"] t++findPath :: [TagName] -> Tag -> Maybe Tag+findPath [] t = Just t+findPath (n:ns) t = case listToMaybe (find n t) of+ Nothing -> Nothing+ Just r -> findPath ns r++-- | Gets the data from a tag, if it is a tag with data.+tagData :: Tag -> Maybe TagData+tagData (Tag _ ei) = either return (const Nothing) ei++-- | Goes to a certain path in the tag hierarchy and pulls the+-- requested data, if the tag is present and it is a data tag. For+-- example, to get the name of the financial institution:+--+-- > pathData ["SIGNONMSGSRSV1", "SONRS", "FI", "ORG"] f+pathData :: [TagName] -> OFXFile -> Maybe TagData+pathData p (OFXFile _ t) = findPath p t >>= tagData+++-- | Gets the name of the financial institution from the FI tag, if+-- available. The OFX spec does not require this tag to be present.+fiName :: OFXFile -> Maybe TagData+fiName = pathData ["SIGNONMSGSRSV1", "SONRS", "FI", "ORG"]+++-- | Gets the credit card number, if available. The OFX spec does not+-- require this tag to be present.+creditCardNumber :: OFXFile -> Maybe TagData+creditCardNumber =+ pathData [ "CREDITCARDMSGSRSV1", "CCSTMTTRNRS", "CCSTMTRS",+ "CCACCTFROM", "ACCTID" ]++-- | Gets the bank account number, if available. The OFX spec does not+-- require this tag to be present.+bankAccountNumber :: OFXFile -> Maybe TagData+bankAccountNumber =+ pathData [ "BANKMSGSRSV1", "STMTTRNRS", "STMTRS",+ "BANKACCTFROM", "ACCTID" ]++-- | Gets either the credit card or bank account number, if available.+accountNumber :: OFXFile -> Maybe TagData+accountNumber f = creditCardNumber f <|> bankAccountNumber f+ ++-- | Finds the first tag (either this tag or any children) that has+-- the given name and that is a data tag (not an aggregate tag.) If no+-- data tag with the given name is found, returns Nothing.+findData :: TagName -> Tag -> Maybe TagData+findData n (Tag tn e) = case e of+ Left d -> if tn == n then Just d else Nothing+ Right ts -> M.getFirst . M.mconcat . map M.First+ . map (findData n) $ ts+++-- | Finds the first tag (either this tag or any children) that has+-- the given name and that is a data tag. Gives an error message if+-- the tag is not found.+required :: TagName -> Tag -> Err TagData+required n t = case findData n t of+ Nothing -> Left $ "required tag missing: " ++ n+ Just r -> return r+++--+-- # OFX data+-- ++-- | OFX transaction types. These are used in STMTTRN aggregates, see+-- OFX spec section 11.4.2.3.1.1.+data TrnType+ = TCREDIT+ | TDEBIT++ | TINT+ -- ^ Interest earned or paid (which it is depends on sign of amount)++ | TDIV+ -- ^ Dividend++ | TFEE+ | TSRVCHG++ | TDEP+ -- ^ Deposit++ | TATM+ -- ^ ATM debit or credit (which it is depends on sign of amount)++ | TPOS+ -- ^ Point of sale debit or credit (which it is depends on sign of+ -- amount)++ | TXFER+ -- ^ Transfer++ | TCHECK+ | TPAYMENT+ -- ^ Electronic payment++ | TCASH+ -- ^ Cash withdrawal++ | TDIRECTDEP+ -- ^ Direct deposit++ | TDIRECTDEBIT+ -- ^ Merchant initiated debit++ | TREPEATPMT+ -- ^ Repeating payment / standing order++ | TOTHER+ deriving (Eq, Ord, Show, Read)++-- | A single STMTTRN, see OFX spec section 11.4.2.3.1. This is most+-- likely what you are interested in after downloading a statement+-- from a bank.+data Transaction = Transaction+ { txTRNTYPE :: TrnType+ -- ^ Transaction type++ , txDTPOSTED :: T.ZonedTime+ -- ^ Date transaction was posted to account++ , txDTUSER :: Maybe T.ZonedTime+ -- ^ Date user initiated transaction, if known++ , txDTAVAIL :: Maybe T.ZonedTime+ -- ^ Date funds are available++ , txTRNAMT :: String+ -- ^ Amount of transaction. This is left as the string that was+ -- originally in the download. That means the transaction may+ -- include a plus or minus sign (no sign is the same as a plus+ -- sign.) According to section 3.2.9.2, amounts are always signed+ -- from the perspective of the customer.+ --+ -- Typically negative amounts:+ --+ -- * Investment buy amount, investment sell quantity+ --+ -- * Bank statement debit amounts, checks, fees+ --+ -- * Credit card purchases+ --+ -- * Margin balance (unless the institution owes the client money)+ --+ -- Typically positive amounts:+ --+ -- * Investment sell amount, investment buy quantity+ --+ -- * Bank statement credits+ --+ -- * Credit card payments+ --+ -- * Ledger balance (unless the account is overdrawn)+ --+ -- Formats for amounts are described in 3.2.9.1. If there is no+ -- decimal point, there is an implied decimal point at the end of+ -- the value. Trailing and leading spaces \"should\" be+ -- stripped. Positive or minus is indicated with a leading sign; a+ -- plus sign is assumed if there is no sign.+ --+ -- An amount has a maximum of 32 alphanumeric characters,+ -- including digits and punctuation.+ --+ -- The radix point is indicated with either a period or a+ -- comma. Amounts \"should\" not include any digit grouping+ -- characters.++ , txFITID :: String+ -- ^ Transaction ID issued by financial institution. Used to+ -- detect duplicate downloads.++ , txCORRECTFITID :: Maybe String+ -- ^ If present, this indicates the FITID of a previously sent+ -- transaction that is corrected by this record. This transaction+ -- replaces or deletes the transaction that it corrects, based on+ -- the value of CORRECTACTION below.++ , txCORRECTACTION :: Maybe CorrectAction+ -- ^ See 'CorrectAction' and 'txCORRECTFITID'++ , txSRVRTID :: Maybe String+ -- ^ Server assigned transaction ID; used for transactions+ -- initiated by client, such as payment or funds transfer++ , txCHECKNUM :: Maybe String+ -- ^ Check or other reference number++ , txREFNUM :: Maybe String+ -- ^ Reference number that uniquely identifies the+ -- transaction. Can be used in addition to or instead of a+ -- CHECKNUM.++ , txSIC :: Maybe String+ -- ^ Standard Industrial Code++ , txPAYEEID :: Maybe String+ -- ^ Payee identifier if available++ , txPayeeInfo :: Maybe (Either String Payee)+ -- ^ Information on the payee. The OFX spec seems to be saying+ -- that every transaction must have either NAME, wich is \"name of+ -- payee or description of transaction\", or the Payee+ -- aggregate. The former is indicated with a Left, the latter with+ -- a Right.++ , txAccountTo :: Maybe (Either BankAcctTo CCAcctTo)+ -- ^ Information on a transfer. If this transaction wa sa+ -- transfer, this may contain information about the account being+ -- transferred to.++ , txMEMO :: Maybe String+ -- ^ Extra information not in NAME++ , txCurrency :: Maybe (Either Currency OrigCurrency)+ -- ^ Currency option. OFX spec says to choose either CURRENCY or+ -- ORIGCURRENCY.+ } deriving (Show, Read)++data Payee = Payee+ { peNAME :: String+ , peADDR1 :: String+ , peADDR2 :: Maybe String+ , peADDR3 :: Maybe String+ , peCITY :: String+ , peSTATE :: String+ , pePOSTALCODE :: String+ , peCOUNTRY :: Maybe String+ , pePHONE :: String+ } deriving (Eq, Show, Read)++-- | Can be either REPLACE or DELETE.+data CorrectAction+ = REPLACE+ -- ^ Replaces the transaction referenced by the CORRECTFITID++ | DELETE+ -- ^ Deletes the transaction referenced by the CORRECTFITID+ deriving (Eq, Show, Read)++data BankAcctTo = BankAcctTo+ { btBANKID :: String+ -- ^ Routing and transit number++ , btBRANCHID :: Maybe String+ -- ^ Bank identifier for international banks++ , btACCTID :: String+ -- ^ Account number++ , btACCTTYPE :: AcctType+ -- ^ Type of account++ , btACCTKEY :: Maybe String+ -- ^ Checksum for international banks+ } deriving (Show, Read)++data CCAcctTo = CCAcctTo+ { ctACCTID :: String+ -- ^ Account number++ , ctACCTKEY :: Maybe String+ -- ^ Checksum for international banks++ } deriving (Eq, Show, Read)++data AcctType+ = ACHECKING+ | ASAVINGS+ | AMONEYMRKT+ | ACREDITLINE+ deriving (Eq, Show, Ord, Read)++acctType :: String -> Err AcctType+acctType s+ | s == "CHECKING" = return ACHECKING+ | s == "SAVINGS" = return ASAVINGS+ | s == "MONEYMRKT" = return AMONEYMRKT+ | s == "CREDITLINE" = return ACREDITLINE+ | otherwise = Left $ "unrecognized account type: " ++ s++-- | Holds all data both for CURRENCY and for ORIGCURRENCY.+data CurrencyData = CurrencyData++ { cdCURRATE :: String+ -- ^ Ratio of CURDEF currency to CURSYM currency, in decimal form++ , cdCURSYM :: String+ -- ^ ISO-4217 3-letter currency identifier+ } deriving (Eq, Show, Read)++data Currency = Currency CurrencyData+ deriving (Eq, Show, Read)++data OrigCurrency = OrigCurrency CurrencyData+ deriving (Eq, Show, Read)++--+-- # Helpers to build aggregates+--+trnType :: TagData -> Maybe TrnType+trnType d = case d of+ "CREDIT" -> Just TCREDIT+ "DEBIT" -> Just TDEBIT+ "INT" -> Just TINT+ "DIV" -> Just TDIV+ "FEE" -> Just TFEE+ "SRVCHG" -> Just TSRVCHG+ "DEP" -> Just TDEP+ "ATM" -> Just TATM+ "POS" -> Just TPOS+ "XFER" -> Just TXFER+ "CHECK" -> Just TCHECK+ "PAYMENT" -> Just TPAYMENT+ "CASH" -> Just TCASH+ "DIRECTDEP" -> Just TDIRECTDEP+ "DIRECTDEBIT" -> Just TDIRECTDEBIT+ "REPEATPMT" -> Just TREPEATPMT+ "OTHER" -> Just TOTHER+ _ -> Nothing+++-- | Gets a single Transaction from a tag. The tag should be the one+-- named STMTTRN. Fails with an error message if any required field+-- was not present.+transaction :: Tag -> Err Transaction+transaction t = do+ let fromMaybe e = maybe (Left e) Right+ trntyStr <- required "TRNTYPE" t+ trnTy <- fromMaybe ("could not parse transaction type: " ++ trntyStr)+ $ trnType trntyStr++ dtpStr <- required "DTPOSTED" t+ dtp <- parseDate dtpStr++ let mayDtuStr = findData "DTUSER" t+ dtu <- maybe (return Nothing) (fmap Just . parseDate) mayDtuStr+ + let mayDtAvail = findData "DTAVAIL" t++ dta <- maybe (return Nothing) (fmap Just . parseDate) mayDtAvail+ amt <- required "TRNAMT" t+ fitid <- required "FITID" t+ let correctFitId = findData "CORRECTFITID" t+ correctAct <-+ case findData "CORRECTACTION" t of+ Nothing -> return Nothing+ Just d -> + maybe (return Nothing)+ (fromMaybe ("could not parse correct action: " ++ d))+ . safeRead+ $ d+ let srvrtid = findData "SRVRTID" t+ checknum = findData "CHECKNUM" t+ refnum = findData "REFNUM" t+ sic = findData "SIC" t+ payeeId = findData "PAYEEID" t++ let mayPyeInfo = fmap (return . Left) (findData "NAME" t)+ <|> fmap (fmap Right) (payee t)+ pyeInfo <- maybe (return Nothing) (fmap Just) mayPyeInfo+ + let mayAcctTo = (fmap (fmap Left) $ bankAcctTo t)+ <|> (fmap (fmap Right) $ ccAcctTo t)+ mayCcy = (fmap (fmap Left) $ currency t)+ <|> (fmap (fmap Right) $ origCurrency t)+ acctTo <- maybe (return Nothing) (fmap Just) mayAcctTo+ ccy <- maybe (return Nothing) (fmap Just) mayCcy+ let memo = findData "MEMO" t++ return Transaction+ { txTRNTYPE = trnTy+ , txDTPOSTED = dtp+ , txDTUSER = dtu+ , txDTAVAIL = dta+ , txTRNAMT = amt+ , txFITID = fitid+ , txCORRECTFITID = correctFitId+ , txCORRECTACTION = correctAct+ , txSRVRTID = srvrtid+ , txCHECKNUM = checknum+ , txREFNUM = refnum+ , txSIC = sic+ , txPAYEEID = payeeId+ , txPayeeInfo = pyeInfo+ , txAccountTo = acctTo+ , txMEMO = memo+ , txCurrency = ccy+ } ++-- | Parses a Payee record from its parent tag.+payee+ :: Tag+ -- ^ The tag which contains the PAYEE tag, if there is one. This+ -- would typically be a STMTTRN tag.++ -> Maybe (Err Payee)+ -- ^ Nothing if there is no PAYEE tag. Just if a PAYEE tag is found,+ -- with a Left if the tag is lacking a required element, or a+ -- Right if the tag is successfully parsed.+ --+ -- If there is more than one PAYEE tag, only the first one is+ -- considered.+payee = fmap getPayee . listToMaybe . find "PAYEE"+ where+ getPayee t = Payee+ <$> required "NAME" t+ <*> required "ADDR1" t+ <*> pure (findData "ADDR2" t)+ <*> pure (findData "ADDR3" t)+ <*> required "CITY" t+ <*> required "STATE" t+ <*> required "POSTALCODE" t+ <*> pure (findData "COUNTRY" t)+ <*> required "PHONE" t+ ++currency :: Tag -> Maybe (Err Currency)+currency+ = fmap (fmap Currency)+ . fmap currencyData+ . listToMaybe+ . find "CURRENCY"++origCurrency :: Tag -> Maybe (Err OrigCurrency)+origCurrency+ = fmap (fmap OrigCurrency)+ . fmap currencyData+ . listToMaybe+ . find "ORIGCURRENCY"+++-- | Parses currency data.+currencyData+ :: Tag+ -- ^ The tag that contains the data, e.g. CURRENCY or ORIGCURRENCY.++ -> Err CurrencyData+currencyData t = CurrencyData+ <$> required "CURRATE" t+ <*> required "CURSYM" t++bankAcctTo :: Tag -> Maybe (Err BankAcctTo)+bankAcctTo = fmap getTo . listToMaybe . find "BANKACCTTO"+ where+ getTo t = BankAcctTo+ <$> required "BANKID" t+ <*> pure (findData "BRANCHID" t)+ <*> required "ACCTID" t+ <*> (required "ACCTTYPE" t >>= acctType)+ <*> pure (findData "ACCTKEY" t)++ccAcctTo :: Tag -> Maybe (Err CCAcctTo)+ccAcctTo = fmap getTo . listToMaybe . find "CCACCTTO"+ where+ getTo t = CCAcctTo+ <$> required "ACCTID" t+ <*> pure (findData "ACCTKEY" t)++safeRead :: Read a => String -> Maybe a+safeRead s = case reads s of+ (x, ""):[] -> Just x+ _ -> Nothing+++-- | Pulls all Transactions from a file. Might fail if the OFX file+-- does not conform to the specification (or if there are bugs in this+-- library.) In case of the former, you can manually parse the+-- transaction information yourself using functions like+-- 'pathData'. In case of the latter, please send bugreports :-)+transactions :: OFXFile -> Err [Transaction]+transactions = mapM transaction . find "STMTTRN" . fTag++--+-- # Pretty printers+--+pPayee :: Payee -> Doc+pPayee p = hang "Payee:" 2 ls+ where+ ls = sep [ label "Name" (text . peNAME $ p)+ , label "Addr1" (text . peADDR1 $ p)+ , label "Addr2" (pMaybe text . peADDR2 $ p)+ , label "Addr3" (pMaybe text . peADDR3 $ p)+ , label "City" (text . peCITY $ p)+ , label "State" (text . peSTATE $ p)+ , label "Postal" (text . pePOSTALCODE $ p)+ , label "Country" (pMaybe text . peCOUNTRY $ p)+ , label "Phone" (text . pePHONE $ p)+ ]++pTransaction :: Transaction -> Doc+pTransaction a = hang "Transaction:" 2 ls+ where+ ls = sep [ label "TRNTYPE" (text . show . txTRNTYPE $ a)+ , label "DTPOSTED" (text . show . txDTPOSTED $ a)+ , label "DTUSER" (text . show . txDTUSER $ a)+ , label "DTAVAIL" (text . show . txDTAVAIL $ a)+ , label "TRNAMT" (text . txTRNAMT $ a)+ , label "FITID" (text . txFITID $ a)+ , label "CORRECTFITID"+ (pMaybe text . txCORRECTFITID $ a)+ , label "CORRECTACTION"+ (text . show . txCORRECTACTION $ a)+ , label "SRVRTID" (pMaybe text . txSRVRTID $ a)+ , label "CHECKNUM" (pMaybe text . txCHECKNUM $ a)+ , label "REFNUM" (pMaybe text . txREFNUM $ a)+ , label "SIC" (pMaybe text . txSIC $ a)+ , label "PAYEEID" (pMaybe text . txPAYEEID $ a)+ , label "PAYEEINFO"+ (pMaybe (pEither text (text . show)) . txPayeeInfo $ a)+ , label "ACCOUNTTO"+ (pMaybe id . fmap (text . show)+ . txAccountTo $ a)+ , label "MEMO" (pMaybe text . txMEMO $ a)+ , label "CURRENCY"+ (pMaybe (text . show) . txCurrency $ a)+ ]++pTag :: Tag -> Doc+pTag (Tag n ei) = case ei of+ Left d -> "<" <> text n <> ">" <> text d+ Right ts -> vcat $ "<" <> text n <> ">"+ : map (nest 2 . pTag) ts+ ++ ["</" <> text n <> ">"]++pHeader :: OFXHeader -> Doc+pHeader (OFXHeader t v) = text t <> ": " <> text v++pFile :: OFXFile -> Doc+pFile (OFXFile hs t)+ = "OFX file:"+ $$ nest 2 (vcat [ pList . map pHeader $ hs+ , mempty+ , pTag t ])++pEither :: (a -> Doc) -> (b -> Doc) -> Either a b -> Doc+pEither fa fb = either (\l -> "Left" <+> parens (fa l))+ (\r -> "Right" <+> parens (fb r))++pMaybe :: (a -> Doc) -> Maybe a -> Doc+pMaybe f = maybe "Nothing" (\x -> "Just" <+> parens (f x))++pList :: [Doc] -> Doc+pList ds = case ds of+ [] -> "[]"+ x:[] -> brackets x+ x:xs -> sep $ hang "[" 2 x+ : map (\d -> hang "," 2 d) xs+ ++ [ "]" ]++label :: String -> Doc -> Doc+label s = hang (text (s ++ ":")) (length s + 2)++pExceptional+ :: (e -> Doc)+ -> (a -> Doc)+ -> Either e a+ -> Doc+pExceptional fe fa =+ either (\e -> hang "Exception:" 2 $ parens (fe e))+ (\g -> hang "Success:" 2 $ parens (fa g))++-- # Running Parsers++-- | Parses an input file. Returns either an error message or the+-- resulting 'OFXFile'.+parseOfxFile :: String -> Err OFXFile+parseOfxFile = either (Left . show) (Right . id) . parse ofxFile ""++-- | Parses an OFX file and gets the list of 'Tranasction'.+parseTransactions :: String -> Err [Transaction]+parseTransactions = transactions <=< parseOfxFile++-- # Parsing and pretty printing++-- | Parses an input file to an OfxFile. Returns a pretty-printed+-- string with the results of the parse.+prettyRenderOfxFile+ :: String+ -- ^ File contents to parse+ -> String+ -- ^ Pretty printed result of rending the result of the parse, which+ -- is either an error message or an 'OFXFile'.+prettyRenderOfxFile+ = render+ . pExceptional text pFile+ . parseOfxFile++-- | Parses an input file to an OfxFile, and then to a list of+-- 'Transaction'. Returns a pretty-printed string with the results.+prettyRenderTransactions+ :: String+ -- ^ File contents to parse+ -> String+ -- ^ Pretty printed result of rendering the result of the parse,+ -- which is either an error message or a list of 'Transaction'.+prettyRenderTransactions+ = render+ . pExceptional text (pList . map pTransaction)+ . parseTransactions
ofx.cabal view
@@ -1,55 +1,90 @@-name: ofx-version: 0.4.0.4-synopsis: Parser for OFX data-description:+-- This Cabal file generated using the Cartel library.+-- Cartel is available at:+-- http://www.github.com/massysett/cartel+--+-- Script name used to generate: gen-ofx-cabal+-- Generated on: 2016-07-12 21:19:09.028404 EDT+-- Cartel library version: 0.16.0.0 +name: ofx+version: 0.4.2.0+cabal-version: >= 1.10+license: BSD3+license-file: LICENSE+build-type: Simple+copyright: Copyright (c) 2016 Omari Norman+author: Omari Norman+maintainer: omari@smileystation.com+stability: Experimental+homepage: http://www.github.com/massysett/ofx+bug-reports: http://www.github.com/massysett/ofx/issues+synopsis: Parser for OFX data+description: A parser for Open Financial Exchange (OFX) financial data. This handles OFX version 1.03, which is documented at http://www.ofx.net This also handles QFX, which is OFX plus some minor additions made by Intuit, the publishers of Quicken.- .- The parser will place all the data into a tree, which you can query for whatever data you may need, although you will need to be familiar with the OFX spec to do this. There is also a Transaction type which you can easily parse from the tree; this will contain- most, if not all, of the data you will be interested in if your OFX+ most, perhaps all, of the data you will be interested in if your OFX file is from a bank or credit card account.- .- All the OFX and QFX files I have seen use the format from the 1.0 series of OFX, which is primarily SGML based. OFX version 2 is XML- based. If this parser works on those files, consider it a happy- accident.-- .-- The OFX spec is available at <http://www.ofx.net>+ based. This parser likely will not work on those files.+category: Finance -homepage: http://www.github.com/massysett/ofx-license: BSD3-license-file: LICENSE-author: Omari Norman-maintainer: omari@smileystation.com-category: Finance-build-type: Simple-cabal-version: >=1.8+Library+ exposed-modules:+ Data.OFX+ ghc-options:+ -Wall+ default-language: Haskell2010+ hs-source-dirs:+ lib+ build-depends:+ base >= 4.8 && < 5+ , parsec >= 3.1+ , pretty >= 1.1+ , time >= 1.4 source-repository head type: git- location: git://github.com/massysett/ofx.git+ location: https://github.com/massysett/ofx.git -library- ghc-options: -Wall+Executable renderOfx+ main-is: renderOfx.hs+ other-modules:+ Data.OFX+ hs-source-dirs:+ exe+ ghc-options:+ -Wall+ default-language: Haskell2010+ hs-source-dirs:+ lib+ build-depends:+ base >= 4.8 && < 5+ , parsec >= 3.1+ , pretty >= 1.1+ , time >= 1.4 - exposed-modules:- Data.OFX- +Executable renderTransactions+ main-is: renderTransactions.hs+ other-modules:+ Data.OFX+ hs-source-dirs:+ exe+ ghc-options:+ -Wall+ default-language: Haskell2010+ hs-source-dirs:+ lib build-depends:- base >=4.5.0.0 && < 5- , parsec >=3.1.0- , pretty >=1.1.0.0- , time >=1.4- + base >= 4.8 && < 5+ , parsec >= 3.1+ , pretty >= 1.1+ , time >= 1.4