-- sflc-ledger-reports: web interface to hledger-based reports
--  Copyright (C) 2013  Clint Adams
--
--  This program is free software: you can redistribute it and/or modify
--  it under the terms of the GNU Affero General Public License as
--  published by the Free Software Foundation, either version 3 of the
--  License, or (at your option) any later version.
--
--  This program is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
--  GNU Affero General Public License for more details.
--
--  You should have received a copy of the GNU Affero General Public License
--  along with this program.  If not, see <http://www.gnu.org/licenses/>.

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}

module Hledger.RegisterCSV (convertJournalToRegisterCSV) where

import Prelude (String, Double, Show, Eq, (||), Bool(..), const, (<),  (>), snd, (.), ($), maybe, show, id, length, (==), (/=), head, map, FilePath, IO, Either(..), return, concatMap, Char, otherwise)

import Control.Applicative (many)

import qualified Data.Text as T

import Hledger.Data.Amount (showMixedAmount)
import Hledger.Data.Journal (journalAccountNamesUsed)
import Hledger.Data.Types (Journal(..), Transaction(..), Posting(..), MixedAmount(..))
import Hledger.Query (Query(..))
import Hledger.Read (readJournalFile, definputopts)
import Hledger.Reports (postingsReport, defreportopts, PostingsReportItem)

import Data.Conduit (runConduit, (.|))
import Control.Monad.Trans.Resource (MonadUnliftIO (), runResourceT)
import qualified Data.Conduit.List as CL
import Data.CSV.Conduit (fromCSV, defCSVSettings, CSV)

import Text.Parsec.Char (char, digit, satisfy, space)
import Text.Parsec.Combinator (many1)
import Text.Parsec.Prim (ParsecT, Stream, parse)

data AcctReg = AcctReg {
    _acct :: T.Text
  , _openingBalance :: Double
  , _items :: [PostingsReportItem]
} deriving (Show, Eq)

cordGuess :: T.Text -> MixedAmount -> T.Text
cordGuess acct
    | "Assets:" `T.isPrefixOf` acct || "Liabilities:" `T.isPrefixOf` acct || "Equity:" `T.isPrefixOf` acct = cordGuest' True
    | "Income:" `T.isPrefixOf` acct || "Expenses:" `T.isPrefixOf` acct = cordGuest' False
    | otherwise = const "INVALID"
    where
        cordGuest' True amt | amt > 0 = "Deposit"
        cordGuest' True _ = "Check"
        cordGuest' False amt | amt > 0 = "Check"
        cordGuest' False _ = "Deposit"

acctReg :: T.Text -> Journal -> AcctReg
acctReg a j = AcctReg a 0 (snd . postingsReport defreportopts (Acct . T.unpack $ a) $ j)


-- (Maybe Day, Maybe Day, Maybe String, Posting, MixedAmount)
priToLine :: PostingsReportItem -> [T.Text]
priToLine (mday, _, mdesc, p, mixa) = [T.empty, cord, date, num, name, memo, split, amt, bal]
    where
      date = maybe T.empty (T.pack . show) mday
      desc' = maybe "" id mdesc
      (c', desc) = parseDesc desc'
      cord = cordGuess (paccount p) (pamount p)
      num = T.pack c'
      name = T.empty
      memo = T.pack desc
      split = maybe (T.pack "ERROR") (splitField . tpostings) (ptransaction p)
      amt = T.pack . showMixedAmount . pamount $ p
      bal = T.pack . showMixedAmount $ mixa

splitField :: [Posting] -> T.Text
splitField ps
    | length ps < 2 = "ERROR"
    | length ps == 2 = paccount . head $ ps
    | otherwise = "-SPLIT-"

arToLines :: AcctReg -> [[T.Text]]
arToLines ar = [_acct ar,"","","","","","","","0.000000"]:map priToLine (_items ar)

convertJournalToRegisterCSV :: FilePath -> IO (T.Text)
convertJournalToRegisterCSV fp = do
    Right j <- readJournalFile definputopts fp
    csv <- journalToRegisterCSV j
    return $ T.concat csv

journalToRegisterCSV :: ( MonadUnliftIO m
                        , CSV a [T.Text])
                        => Journal 
                        -> m [a]
journalToRegisterCSV j = do
    let accts = journalAccountNamesUsed j
        precsv' = concatMap (\x -> arToLines $ acctReg x j) accts
        precsv = ["","Type","Date","Num","Name","Memo","Split","Amount","Balance"]:precsv'
    csv <- runResourceT . runConduit $
             CL.sourceList precsv .| fromCSV defCSVSettings .| CL.consume
    return csv

parseDesc :: String -> (String, String)
parseDesc d = case parse descParser' "desc" d of
    Left _ -> ("", d)
    Right x -> x

descParser' :: Stream s m Char => ParsecT s u m (String, String)
descParser' = do
    desc' <- many1 (satisfy (/='('))
    _ <- char '('
    checknum <- many1 digit
    _ <- char ')'
    _ <- many space
    return (checknum, desc')