diff options
| -rw-r--r-- | amex.rules | 3 | ||||
| -rw-r--r-- | frb.rules | 2 | ||||
| -rw-r--r-- | parseuploadedcsv.hs | 173 | ||||
| -rw-r--r-- | paypal.rules | 1 |
4 files changed, 179 insertions, 0 deletions
diff --git a/amex.rules b/amex.rules new file mode 100644 index 0000000..a774909 --- /dev/null +++ b/amex.rules @@ -0,0 +1,3 @@ +date-format %-m/%-d/%Y +account1 Liabilities:Payable:American Express +fields date, amount, description diff --git a/frb.rules b/frb.rules new file mode 100644 index 0000000..02df5b2 --- /dev/null +++ b/frb.rules @@ -0,0 +1,2 @@ +date-format %m/%-d/%Y +fields date, description, comment, amount-out, amount-in, skip1, skip2, account1, account2 diff --git a/parseuploadedcsv.hs b/parseuploadedcsv.hs new file mode 100644 index 0000000..3bb75c0 --- /dev/null +++ b/parseuploadedcsv.hs @@ -0,0 +1,173 @@ +{-# LANGUAGE OverloadedStrings #-} + +import Data.CSV.Conduit (defCSVSettings, Row, CSVSettings) +import Data.CSV.Conduit.Parser.ByteString (parseCSV) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as BL +import qualified Data.ByteString.Char8 as BS8 +import Data.Maybe (fromMaybe, listToMaybe, isJust) +import qualified Data.Text as T +import qualified Data.Text.Read as TR +import Data.Word (Word8) + +import Network.CGI (CGI, CGIResult, runCGI, handleErrors, liftIO, output, setHeader, getInputFPS) +import Text.XHtml ((+++), (<<), (!), body, paragraph, form, method, textarea, name, rows, cols, stringToHtml, submit, showHtml, tag, thetype, value, input, enctype) + +-- WOo +import Text.Printf (printf) +import Data.List (groupBy, isPrefixOf) +import Hledger.Read.CsvReader (transactionFromCsvRecord, parseRulesFile) +import Hledger.Data.Types (FormatString(FormatField), HledgerFormatField(FieldNo)) + +data Account = Bank String | CCard String | PayPal String + deriving (Eq,Show) + +acctFRB :: [Row BS.ByteString] -> Maybe Account +acctFRB rs + | length rs < 5 = Nothing + | length (rs !! 2) /= 1 = Nothing + | otherwise = if checking then acctnum else Nothing + where + checking = (rs !! 0) == ["Account Name : CHECKING"] + acctnum = if BS.isPrefixOf "Account Number : " (head $ rs !! 1) then Just (Bank (BS8.unpack (BS.drop 17 (head $ rs !! 1)))) else Nothing + +isAdulterated :: [Row BS.ByteString] -> Bool +isAdulterated rs = head rs == [";;;;;;;;;;;;"] || all ((==1) . length) rs + +acctAmex :: [Row BS.ByteString] -> Maybe Account +acctAmex rs + | length rs < 1 = Nothing + | length (head rs) < 2 = Nothing + | otherwise = if "Reference: " `BS.isPrefixOf` (rs !! 0 !! 1) then Just (CCard "AmEx") else Nothing + +acctPayPal :: [Row BS.ByteString] -> Maybe Account +acctPayPal rs + | length rs < 2 = Nothing + | length (rs !! 1) /= 41 = Nothing + | otherwise = if "donate@freedomboxfoundation.org" == (rs !! 1 !! 10) then Just (PayPal "FBF") else Just (PayPal "Unknown") + +initialForm :: String -> CGI CGIResult +initialForm e = output . showHtml $ tag "head" << tag "title" << stringToHtml "CSV Upload" +++ body << (paragraph << stringToHtml e) +++ (paragraph << form ! [method "post", enctype "multipart/form-data"] << (input ! [thetype "hidden",name "MAX_FILE_SIZE",value "128"] +++ input ! [name "upload",thetype "file"] +++ input ! [thetype "submit",value "Upload it"])) + +toStrict :: BL.ByteString -> BS.ByteString +toStrict = fromMaybe BS.empty . listToMaybe . BL.toChunks + +splitLines :: BS.ByteString -> [BS.ByteString] +splitLines cs + | BS.null cs == True = [] + | otherwise = + let (pre, suf) = BS.break isLineTerminator cs + in pre : case BS8.unpack suf of + ('\r':'\n':rest) -> splitLines (BS8.pack rest) + ('\r':rest) -> splitLines (BS8.pack rest) + ('\n':rest) -> splitLines (BS8.pack rest) + _ -> [] + where + isLineTerminator :: Word8 -> Bool + isLineTerminator c = c' == '\r' || c' == '\n' + where + c' = toEnum (fromEnum c) + +fixEndings :: BS.ByteString -> BS.ByteString +fixEndings = BS8.unlines . splitLines + +-- FIXME: the bank account numbers below have been censored before committal +-- These should live in a config file and not be hardcoded into the source. +processUpload :: BL.ByteString -> CGI CGIResult +processUpload csv = + case parseCSV defCSVSettings (fixEndings (toStrict csv)) of + Left err -> initialForm $ "ERROR: " ++ err + Right [] -> initialForm "This file appears to be invalid or corrupted. Try again with a pristine, unmodified file from the financial institution." + Right rs -> processUpload' rs + where + processUpload' :: [Row BS.ByteString] -> CGI CGIResult + processUpload' rs + | isAdulterated rs = initialForm "This file appears to be adulterated. Ensure that it is downloaded and uploaded without passing through any additional applications." + | isJust (acctPayPal rs) = confirmationForm =<< liftIO (processPayPal (ppAccount . acctPayPal $ rs) rs) + | acctFRB rs == Just (Bank "123") = confirmationForm =<< liftIO (processFRB "SFLC" rs) + | acctFRB rs == Just (Bank "456") = confirmationForm =<< liftIO (processFRB "MR" rs) + | isJust (acctFRB rs) = initialForm "The file you uploaded looks like First Republic but I dunno which account. Please report this problem." + | isJust (acctAmex rs) = confirmationForm =<< liftIO (processAmex rs) + | otherwise = initialForm ("I am confused. Contact the authorities.\n\n" ++ show rs) + +ppAccount :: Maybe Account -> String +ppAccount (Just (PayPal x)) = x +ppAccount _ = "ERROR" + +confirmationForm :: String -> CGI CGIResult +confirmationForm transes = output . showHtml $ tag "head" << tag "title" << stringToHtml "Ledger conversion review" +++ body << paragraph << form ! [method "post"] << (textarea ! [name "transes",rows "30",cols "80"] << stringToHtml transes) +++ submit "submit" "Throw this away" + +cgiMain :: CGI CGIResult +cgiMain = do + setHeader "Content-type" "text/html; charset=UTF-8" + input <- getInputFPS "upload" + case input of + Nothing -> initialForm [] + Just fps -> processUpload fps + +main :: IO () +main = runCGI (handleErrors cgiMain) + +-- Wootang -- + +normAmount :: Bool -> String -> String +normAmount neg amt + | amt == "" = "" + | "-." `isPrefixOf` amt = normAmount neg ("-0." ++ drop 2 amt) + | "." `isPrefixOf` amt = normAmount neg ("0" ++ amt) + | otherwise = printf "$%.2f" newamt + where + newamt :: Double + newamt = if neg then 0 - (read amt) else read amt + +compressWhitespace :: String -> String +compressWhitespace [] = [] +compressWhitespace x = map head $ groupSpaces x + where groupSpaces "" = [""] + groupSpaces x = groupBy (\x y -> x==' ' && y==' ') x + +mergeIdentity :: String -> String -> String -> String +mergeIdentity t c d | c /= "" = d ++ " (" ++ c ++ ")" + | otherwise = d ++ " [TXN# " ++ t ++ "]" + +iOrE2 :: Either String (Double, T.Text) -> Either String (Double, T.Text) -> String +iOrE2 (Left _) _ = "Income:FIXME" +iOrE2 _ (Left _) = "Expenses:FIXME" +iOrE2 (Right a1) (Right a2) = "FIXME" + +massageFRBLine :: String -> [String] -> [String] +massageFRBLine acct [txn,date,desc,memo,debit,credit,balance,checkno,fees] = [date,mergeIdentity txn checkno desc,memo,normAmount True debit,normAmount False credit,balance,fees,"Assets:Bank:" ++ acct ++ ":Checking:FirstRepublic",iOrE2 (TR.double . T.pack $ debit) (TR.double . T.pack $ credit)] +massageFRBLine acct xs = xs + +processFRB :: String -> [Row BS.ByteString] -> IO String +processFRB acct rs = do + Right rules <- parseRulesFile "/etc/csvconversion/frb.rules" + return $! concatMap (show . transactionFromCsvRecord rules . massageFRBLine acct . map BS8.unpack) ((takeWhile (/= [""]) . drop 4) rs) + +isNotPayment :: [BS8.ByteString] -> Bool +isNotPayment [date,refnum,amt,merchant,phone] = (merchant /= "ELECTRONIC PAYMENT RECEIVED-THANK") && (merchant /= "PAYMENT RECEIVED - THANK YOU") +isNotPayment xs = False + +massageAmexLine :: [String] -> [String] +massageAmexLine [date,refnum,amt,merchant,phone] = [date,normAmount False amt,mergedDesc refnum merchant phone] + where + mergedDesc :: String -> String -> String -> String + mergedDesc refnum merchant phone = "[REF#" ++ drop 11 refnum ++ "] " ++ compressWhitespace merchant ++ " [" ++ compressWhitespace phone ++ "]" +massageAmexLine xs = xs + +processAmex :: [Row BS.ByteString] -> IO String +processAmex rs = do + Right rules <- parseRulesFile "/etc/csvconversion/amex.rules" + return $! concatMap (show . transactionFromCsvRecord rules . massageAmexLine . map BS8.unpack) (filter isNotPayment (takeWhile (/= [""]) rs)) + +massagePayPalLine :: String -> [String] -> [String] +massagePayPalLine acct [date,time,tz,name,ttype,status,gross,fee,net,femail,temail,txnid,a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z] = [date,"Assets:Bank:PayPal:" ++ acct, time,tz,mergedDesc name femail txnid,ttype,status,gross,fee,normAmount False net,femail,temail,txnid,a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z] + where + mergedDesc :: String -> String -> String -> String + mergedDesc name femail txnid = name ++ " (" ++ femail ++ ") [TXN#" ++ txnid +massagePayPalLine acct xs = xs + +processPayPal :: String -> [Row BS.ByteString] -> IO String +processPayPal acct rs = do + Right rules <- parseRulesFile "/etc/csvconversion/paypal.rules" + return $! concatMap (show . transactionFromCsvRecord rules . massagePayPalLine acct . map BS8.unpack) (filter isNotPayment (takeWhile (/= [""]) (tail rs))) diff --git a/paypal.rules b/paypal.rules new file mode 100644 index 0000000..ed31074 --- /dev/null +++ b/paypal.rules @@ -0,0 +1 @@ +fields date, account1, blah1, blah2, description, account2, blah5, blah6, blah7, amount |