{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
module Hcompta.CLI.Command.Balance where

import           Prelude hiding (foldr)
-- import           Control.Monad ((>=>))
import           Control.Applicative ((<$>))
import           Control.Monad.IO.Class (liftIO)
import           Control.Monad.Trans.Except (runExceptT)
import qualified Data.Either
import qualified Data.Foldable
import           Data.Foldable (foldr)
import qualified Data.List
import qualified Data.Map.Strict as Data.Map
-- import           Data.Map.Strict (Map)
import qualified Data.Text.Lazy as TL
import           System.Console.GetOpt
                 ( ArgDescr(..)
                 , OptDescr(..)
                 , usageInfo
                 )
import           System.Environment as Env (getProgName)
import           System.Exit (exitWith, ExitCode(..))
import qualified System.IO as IO
-- import           Text.Show.Pretty (ppShow)

import qualified Hcompta.Calc.Balance as Balance
import qualified Hcompta.CLI.Args as Args
import qualified Hcompta.CLI.Context as Context
import qualified Hcompta.CLI.Format.Ledger as CLI.Ledger
import qualified Hcompta.CLI.I18N as I18N
import qualified Hcompta.CLI.Lib.Leijen.Table as Table
import qualified Hcompta.CLI.Write as Write
import qualified Hcompta.Format.Ledger as Ledger
import qualified Hcompta.Format.Ledger.Journal as Ledger.Journal
import qualified Hcompta.Format.Ledger.Read as Ledger.Read
import qualified Hcompta.Format.Ledger.Write as Ledger.Write
import qualified Hcompta.Lib.TreeMap as Lib.TreeMap
-- import qualified Hcompta.Lib.Foldable as Lib.Foldable
import qualified Hcompta.Lib.Leijen as W
import           Hcompta.Lib.Leijen (toDoc, ToDoc(..))
-- import qualified Hcompta.Model.Account as Account
import           Hcompta.Model.Account (Account)
import qualified Hcompta.Model.Amount as Amount
import           Hcompta.Model.Amount (Amount)
import           Hcompta.Model.Amount.Unit (Unit)
import qualified Hcompta.Model.Filter as Filter
import qualified Hcompta.Model.Filter.Read as Filter.Read

data Ctx
 =   Ctx
 { ctx_input              :: [FilePath]
 , ctx_redundant          :: Bool
 , ctx_transaction_filter :: Filter.Test_Bool (Filter.Test_Transaction Ledger.Transaction)
 , ctx_posting_filter     :: Filter.Test_Bool (Filter.Test_Posting     Ledger.Posting)
 } deriving (Show)

nil :: Ctx
nil =
	Ctx
	 { ctx_input              = []
	 , ctx_redundant          = False
	 , ctx_transaction_filter = Filter.Any
	 , ctx_posting_filter     = Filter.Any
	 }

usage :: IO String
usage = do
	bin <- Env.getProgName
	return $ unlines $
		[ "SYNTAX "
		, "  "++bin++" balance [option..]"
		, ""
		, usageInfo "OPTIONS" options
		]

options :: Args.Options Ctx
options =
	[ Option "h" ["help"]
	 (NoArg (\_context _ctx -> do
		usage >>= IO.hPutStr IO.stderr
		exitWith ExitSuccess))
	 "show this help"
	, Option "i" ["input"]
	 (ReqArg (\s _context ctx -> do
		return $ ctx{ctx_input=s:ctx_input ctx}) "FILE")
	 "read data from given file, can be use multiple times"
	, Option "t" ["transaction-filter"]
	 (ReqArg (\s context ctx -> do
		ctx_transaction_filter <- do
			case Filter.Read.read Filter.Read.test_transaction s of
			 Left  ko -> Write.fatal context $ toDoc context ko
			 Right ok -> return ok
		return $ ctx{ctx_transaction_filter}) "FILTER")
	 "filter on posting"
	, Option "p" ["posting-filter"]
	 (ReqArg (\s context ctx -> do
		ctx_posting_filter <- do
			case Filter.Read.read Filter.Read.test_posting s of
			 Left  ko -> Write.fatal context $ toDoc context ko
			 Right ok -> return ok
		return $ ctx{ctx_posting_filter}) "FILTER")
	 "filter on balance"
	, Option "" ["redundant"]
	 (OptArg (\arg context ctx -> do
		redundant <- case arg of
		 Nothing    -> return $ True
		 Just "yes" -> return $ True
		 Just "no"  -> return $ False
		 Just _     -> Write.fatal context $
			W.text "--redundant option expects \"yes\", or \"no\" as value"
		return $ ctx{ctx_redundant=redundant})
	  "[yes|no]")
	 "also print accounts with zero amount or the same amounts than its ascending account"
	]

run :: Context.Context -> [String] -> IO ()
run context args = do
	(ctx, text_filters) <- Args.parse context usage options (nil, args)
	read_journals <- do
		CLI.Ledger.paths context $ ctx_input ctx
		>>= do
			mapM $ \path -> do
				liftIO $ runExceptT $ Ledger.Read.file path
				>>= \x -> case x of
				 Left  ko -> return $ Left (path, ko)
				 Right ok -> return $ Right ok
		>>= return . Data.Either.partitionEithers
	case read_journals of
	 (errs@(_:_), _journals) ->
		(flip mapM_) errs $ \(_path, err) -> do
			Write.fatal context $ toDoc context err
	 ([], journals) -> do
		(balance_filter::
		 Filter.Test_Bool (Filter.Test_Balance
			 (Account, Balance.Amount_Sum Amount))) <-
			foldr Filter.And Filter.Any <$> do
			(flip mapM) text_filters $ \s ->
				case Filter.Read.read Filter.Read.test_balance s of
				 Left  ko -> Write.fatal context $ toDoc context ko
				 Right ok -> return ok
		Write.debug context $ "balance_filter: " ++ show balance_filter
		Write.debug context $ "transaction_filter: " ++ show (ctx_transaction_filter ctx)
		Write.debug context $ "posting_filter: " ++ show (ctx_posting_filter ctx)
		let (balance_by_account::Balance.Balance_by_Account (Balance.Amount_Sum Amount) Amount.Unit) =
			foldr
			 (Ledger.Journal.fold
				 (flip (foldr
					 (flip (foldr
						 (\tr ->
							case Filter.test (ctx_transaction_filter ctx) tr of
							 False -> id
							 True ->
								let filter_postings =
									Data.Foldable.concatMap $
									Data.List.filter $
									(Filter.test (ctx_posting_filter ctx)) in
								let balance =
									flip (foldr Balance.by_account) .
									map (\p ->
										( Ledger.posting_account p
										, Data.Map.map Balance.amount_sum (Ledger.posting_amounts p)
										)
									 ) .
									filter_postings in
								balance (Ledger.transaction_postings tr) .
								balance (Ledger.transaction_virtual_postings tr) .
								balance (Ledger.transaction_balanced_virtual_postings tr)
						 ))))
				 . Ledger.journal_transactions))
			 (Balance.balance_by_account Balance.nil)
			 journals
		let balance_expanded =
			Lib.TreeMap.filter_with_Path (\acct ->
				Data.Foldable.any
				 (Filter.test balance_filter . (acct,)) .
				Balance.inclusive) $
			Balance.expanded balance_by_account
		style_color <- Write.with_color context IO.stdout
		Ledger.Write.put Ledger.Write.Style
		 { Ledger.Write.style_align = True
		 , Ledger.Write.style_color
		 } IO.stdout $ do
			toDoc () $
				let title = TL.toStrict . W.displayT . W.renderCompact False .
					I18N.render (Context.langs context) in
				zipWith id
				[ Table.column (title I18N.Message_Balance_debit)  Table.Align_Right
				, Table.column (title I18N.Message_Balance_credit) Table.Align_Right
				, Table.column (title I18N.Message_Balance_total)  Table.Align_Right
				, Table.column (title I18N.Message_Account)        Table.Align_Left
				] $
				flip (write_by_accounts ctx) balance_expanded $
				zipWith (:)
					[ Table.Cell_Line '=' 0
					, Table.Cell_Line '=' 0
					, Table.Cell_Line '=' 0
					, Table.Cell_Line ' ' 0
					] $
				write_by_amounts (repeat []) $
					Data.Map.map Balance.unit_sum_amount $
						Balance.by_unit_of_expanded
						 balance_expanded
						 (Balance.balance_by_unit Balance.nil)

write_by_accounts
 :: Ctx
 -> [[Table.Cell]]
 -> Balance.Expanded (Balance.Amount_Sum Amount)
 -> [[Table.Cell]]
write_by_accounts ctx =
	let posting_type = Ledger.Posting_Type_Regular in
	Lib.TreeMap.foldr_with_Path_and_Node
	 (\account node balance rows -> do
		let descendants = Lib.TreeMap.nodes
			 (Lib.TreeMap.node_descendants node)
		let is_worth =
			ctx_redundant ctx
			-- NOTE: worth if no descendant
			-- but account inclusive
			-- has at least a non-zero amount
			|| (Data.Map.null descendants && not
				 (Data.Map.null
				 (Data.Map.filter
					 (not . Amount.is_zero . Balance.amount_sum_balance)
					 (Balance.inclusive balance))))
			-- NOTE: worth if account exclusive
			-- has at least a non-zero amount
			|| not (Data.Map.null
				 (Data.Map.filter
					 (not . Amount.is_zero . Balance.amount_sum_balance)
					 (Balance.exclusive balance)))
			-- NOTE: worth if account has at least more than
			-- one descendant account whose inclusive
			-- has at least a non-zero amount
			|| Data.Map.size
				 (Data.Map.filter
					 ( maybe False
						 ( not . Data.Foldable.all
							 ( Amount.is_zero
							 . Balance.amount_sum_balance )
						 . Balance.inclusive )
					 . Lib.TreeMap.node_value )
					 descendants) > 1
		case is_worth of
		 False -> rows
		 True ->
			foldr
			 (\(amount_positive, amount_negative, amount) ->
				zipWith (:)
					[ Table.cell
					 { Table.cell_content = maybe W.empty Ledger.Write.amount  amount_positive
					 , Table.cell_width   = maybe 0 Ledger.Write.amount_length amount_positive
					 }
					, Table.cell
					 { Table.cell_content = maybe W.empty Ledger.Write.amount  amount_negative
					 , Table.cell_width   = maybe 0 Ledger.Write.amount_length amount_negative
					 }
					, Table.cell
					 { Table.cell_content = Ledger.Write.amount        $ amount
					 , Table.cell_width   = Ledger.Write.amount_length $ amount
					 }
					, Table.cell
					 { Table.cell_content = Ledger.Write.account        posting_type account
					 , Table.cell_width   = Ledger.Write.account_length posting_type account
					 }
					]
			 )
			 rows $
			let bal = Balance.inclusive balance in
			Data.Map.foldrWithKey
			 (\unit amount acc ->
				( maybe Nothing Balance.amount_sum_positive $ Data.Map.lookup unit $ bal
				, maybe Nothing Balance.amount_sum_negative $ Data.Map.lookup unit $ bal
				, Balance.amount_sum_balance amount
				) : acc
			 ) [] $ bal
	 )

write_by_amounts
 :: [[Table.Cell]]
 -> Data.Map.Map Unit (Balance.Amount_Sum Amount)
 -> [[Table.Cell]]
write_by_amounts =
	foldr
	 (\amount_sum ->
		zipWith (:)
			[ let amt = Balance.amount_sum_positive amount_sum in
				Table.cell
				 { Table.cell_content = maybe W.empty Ledger.Write.amount  amt
				 , Table.cell_width   = maybe 0 Ledger.Write.amount_length amt
				 }
			, let amt = Balance.amount_sum_negative amount_sum in
				Table.cell
				 { Table.cell_content = maybe W.empty Ledger.Write.amount  amt
				 , Table.cell_width   = maybe 0 Ledger.Write.amount_length amt
				 }
			, let amt = Balance.amount_sum_balance amount_sum in
				Table.cell
				 { Table.cell_content = Ledger.Write.amount  amt
				 , Table.cell_width   = Ledger.Write.amount_length amt
				 }
			, Table.cell
				 { Table.cell_content = W.empty
				 , Table.cell_width   = 0
				 }
			]
	 )