{-# 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)))