1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
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)))
|
