{-# LANGUAGE Arrows, NoMonomorphismRestriction #-}
import Text.XML.HXT.Core
import Text.Printf (printf)
import Data.List (groupBy)
import Data.List.Split (splitOn)
import Data.Maybe (fromMaybe)
import Data.Time.Calendar (Day (ModifiedJulianDay))
import Data.Time.Format (formatTime)
import Data.Time.LocalTime (LocalTime (LocalTime), TimeOfDay (TimeOfDay))
import Data.Time.Parse (strptime)
import System.Locale (defaultTimeLocale)
import System.Process (readProcessWithExitCode)
import Hledger.Cli.Format (FormatString (FormatField), Field (FieldNo))
import Hledger.Cli.Convert
normAmount :: String -> String
normAmount amt | amt == "" = ""
| otherwise = printf "%.2f" (read amt :: Double)
compressWhitespace :: String -> String
compressWhitespace x = map head $ groupSpaces x
where groupSpaces "" = [""]
groupSpaces x = groupBy (\x y -> x==' ' && y==' ') x
data Transaction = Transaction
� { trnType, dtUser, dtPosted, trnAmt, fitId, refNum, name, memo :: String }
� deriving (Show, Eq)
-- this doesn't get the timezone right
ofxDateParse :: String -> String
ofxDateParse x = formatTime defaultTimeLocale "%Y-%m-%d" (fst (fromMaybe (LocalTime (ModifiedJulianDay 100) (TimeOfDay 0 0 0), "") (strptime "%Y%m%d%H%M%S.%OS" x)))
parseFakeXML string = readString [ withValidate no
� � � � � � � � � � � � � � �, withRemoveWS yes
� � � � � � � � � � � � � � �] string
atTag tag = deep (isElem >>> hasName tag)
text = getChildren >>> getText
textAtTag tag = atTag tag >>> text
getTransactions = atTag "STMTTRN" >>>
� proc l -> do
� � trnType <- textAtTag "TRNTYPE" -< l
� � dtUser�� <- textAtTag "DTUSER" � �-< l
� � dtPosted <- textAtTag "DTPOSTED" -< l
� � trnAmt <- textAtTag "TRNAMT" -< l
� � fitId <- textAtTag "FITID" -< l
� � refNum <- textAtTag "REFNUM" -< l
� � name <- textAtTag "NAME" -< l
� � memo <- textAtTag "MEMO" -< l
� � returnA -< Transaction
� � � { trnType � = trnType,
� � � � dtUser = ofxDateParse dtUser,
� � � � dtPosted = ofxDateParse dtPosted,
� � � � trnAmt � � = trnAmt,
� � � � fitId � � = fitId,
� � � � refNum � � = refNum,
� � � � name � � = name,
� � � � memo �= memo }
ofxrules = CsvRules {
dateField=Just 0,
dateFormat=Nothing,
statusField=Nothing,
codeField=Nothing,
descriptionField=[FormatField False Nothing Nothing (FieldNo 2)],
amountField=Just 1,
inField=Nothing,
outField=Nothing,
currencyField=Nothing,
baseCurrency=Nothing,
accountField=Nothing,
account2Field=Nothing,
effectiveDateField=Nothing,
baseAccount="Liabilities:American Express",
accountRules=[]
}
txnToCsvRecord :: Transaction -> CsvRecord
txnToCsvRecord x = [dtUser x, normAmount (trnAmt x), compressWhitespace (name x) ++ "(" ++ refNum x ++ ")", fitId x, memo x]
printTxnWithComment :: CsvRecord -> IO ()
printTxnWithComment x = putStrLn ("; " ++ x !! 3 ++ " - " ++ x !! 4) >> printTxn False ofxrules x
main = do
filecontents <- readFile "/tmp/ofx.ofx"
let splitfilecontents = splitOn "\n\n" filecontents
let ofxheader = head splitfilecontents
let ofxsgml = splitfilecontents !! 1
(_, fakexml, _) <- readProcessWithExitCode "/usr/bin/sgml2xml" [] ofxsgml
� transes <- runX (parseFakeXML fakexml >>> getTransactions)
let records = map txnToCsvRecord transes
� mapM_ (printTxnWithComment) records