diff --git a/Data/OFX.hs b/Data/OFX.hs new file mode 100644 --- /dev/null +++ b/Data/OFX.hs @@ -0,0 +1,952 @@ +{-# LANGUAGE OverloadedStrings #-} +-- | Parser for downloaded OFX files. +-- +-- This parser was written based on the OFX version 1.03 +-- specification, which is available at +-- +-- +-- +-- 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 + ( -- * 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 + +import Control.Applicative + ( (<$), (<|>), (*>), many, optional, + (<$>), (<*), (<*>), pure ) +import Control.Monad (replicateM) +import qualified Control.Monad.Exception.Synchronous as Ex +import qualified Data.Time as T + +import Text.Parsec.String (Parser) +import Text.Parsec + ( lookAhead, char, manyTill, anyChar, (), eof, + try, digit, many1, spaces ) +import qualified Text.Parsec as P +import Data.Maybe (listToMaybe) +import qualified Data.Monoid as M +import Data.Monoid ((<>), mempty) +import Text.PrettyPrint + ( Doc, hang, text, sep, vcat, nest, (<+>), ($$), + parens, brackets ) + + +-- +-- 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. +escChar :: Parser Char +escChar = + do + c <- anyChar + case c of + '&' -> do + cs <- manyTill anyChar (char ';') + case cs of + "lt" -> return '<' + "gt" -> return '>' + "amp" -> return '&' + _ -> fail $ "unrecognized esacpe sequence: \"&" + ++ cs ++ ";\"" + _ -> 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 -> Ex.Exceptional String T.ZonedTime +parseDate s = case P.parse date "" s of + Left e -> Ex.throw $ "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 -> Ex.Exceptional String TagData +required n t = case findData n t of + Nothing -> Ex.throw $ "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 -> Ex.Exceptional String AcctType +acctType s + | s == "CHECKING" = return ACHECKING + | s == "SAVINGS" = return ASAVINGS + | s == "MONEYMRKT" = return AMONEYMRKT + | s == "CREDITLINE" = return ACREDITLINE + | otherwise = Ex.throw $ "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 -> Ex.Exceptional String Transaction +transaction t = do + trntyStr <- required "TRNTYPE" t + trnTy <- Ex.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) + (Ex.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 (Ex.Exceptional String Payee) + -- ^ Nothing if there is no PAYEE tag. Just if a PAYEE tag is found, + -- with an Exception if the tag is lacking a required element, or a + -- Success 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 (Ex.Exceptional String Currency) +currency + = fmap (fmap Currency) + . fmap currencyData + . listToMaybe + . find "CURRENCY" + +origCurrency :: Tag -> Maybe (Ex.Exceptional String 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. + + -> Ex.Exceptional String CurrencyData +currencyData t = CurrencyData + <$> required "CURRATE" t + <*> required "CURSYM" t + +bankAcctTo :: Tag -> Maybe (Ex.Exceptional String 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 (Ex.Exceptional String 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 -> Ex.Exceptional String [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) + -> Ex.Exceptional e a + -> Doc +pExceptional fe fa = + Ex.switch (\e -> hang "Exception:" 2 $ parens (fe e)) + (\g -> hang "Success:" 2 $ parens (fa g)) diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2013, 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: + + * 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. + + * 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. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS 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, +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 +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/ofx.cabal b/ofx.cabal new file mode 100644 --- /dev/null +++ b/ofx.cabal @@ -0,0 +1,94 @@ +-- Initial ofx.cabal generated by cabal init. For further documentation, +-- see http://haskell.org/cabal/users-guide/ + +-- The name of the package. +name: ofx + +-- The package version. See the Haskell package versioning policy (PVP) +-- for standards guiding when and how versions should be incremented. +-- http://www.haskell.org/haskellwiki/Package_versioning_policy +-- PVP summary: +-+------- breaking API changes +-- | | +----- non-breaking API additions +-- | | | +--- code changes with no API change +version: 0.2.0.0 + +-- A short (one-line) description of the package. +synopsis: Parser for OFX data + +-- A longer description of the package. +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 + 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 + +-- URL for the project homepage or repository. +homepage: http://www.github.com/massysett/ofx + +-- The license under which the package is released. +license: BSD3 + +-- The file containing the license text. +license-file: LICENSE + +-- The package author(s). +author: Omari Norman + +-- An email address to which users can send suggestions, bug reports, and +-- patches. +maintainer: omari@smileystation.com + +-- A copyright notice. +-- copyright: + +category: Finance + +build-type: Simple + +-- Constraint on the version of Cabal needed to build this package. +cabal-version: >=1.8 + + +source-repository head + type: git + location: git://github.com/massysett/ofx.git + +library + -- Modules exported by the library. + ghc-options: -Wall + + exposed-modules: + Data.OFX + + -- Modules included in this library but not exported. + -- other-modules: + + -- Other library packages from which modules are imported. + build-depends: + base ==4.6.* + , explicit-exception ==0.1.* + , parsec ==3.1.* + , pretty ==1.1.* + , time ==1.4.* +