{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Hcompta.CLI.Format.Ledger where

import           Data.Foldable (Foldable(..))
import           Data.Function (($), (.))
import qualified Data.List as List
import qualified Data.Text as Text
import qualified Data.Text.Lazy as TL
import           Text.Show (Show(..))
import           Text.WalderLeijen.ANSI.Text (ToDoc(..))
import qualified Text.WalderLeijen.ANSI.Text as W

import qualified Hcompta as H
import qualified Hcompta.Ledger as Ledger

import qualified Hcompta.CLI.Lang as Lang
import qualified Hcompta.CLI.Lib.Leijen.Table as Leijen.Table

instance Lang.Translate Ledger.Error_Read W.Doc where
	translate lang err =
		case err of
		 Ledger.Error_Read_date date -> toDoc lang date
		 Ledger.Error_Read_transaction_not_equilibrated styles tr unit_sums ->
			i18n_transaction_not_equilibrated styles tr unit_sums
			 Lang.Error_Transaction_The_following_transaction_is_not_equilibrated_because
		 Ledger.Error_Read_virtual_transaction_not_equilibrated styles tr unit_sums ->
			i18n_transaction_not_equilibrated styles tr unit_sums
			 Lang.Error_Transaction_The_following_virtual_transaction_is_not_equilibrated_because
		 Ledger.Error_Read_reading_file file_path exn ->
			W.vsep $
			 [ Lang.translate lang $ Lang.Error_Failed_to_read_file file_path
			 , W.text $ TL.pack $ show exn
			 ]
		 Ledger.Error_Read_including_file file_path errs ->
			W.vsep $
			 [ Lang.translate lang $ Lang.Error_Failed_to_include_file file_path
			 , Lang.translate lang errs
			 ]
		where
			i18n_transaction_not_equilibrated styles tr unit_sums msg =
				W.vsep $
				 [ Lang.translate lang msg
				 , W.vsep $ List.map
					 (\(unit, H.Balance_by_Unit_Sum{..}) ->
						Lang.translate lang $
						Lang.Error_Transaction_Ledger_Unit_sums_up_to_the_non_null_amount unit $
						Ledger.amount_styled styles $
						Ledger.Amount unit $
						H.depolarize balance_by_unit_sum_quantity
					 ) unit_sums
				 , W.space
				 , Ledger.write_transaction styles tr
				 ]

instance Leijen.Table.Cell_of_forall_param Ledger.Journal H.Date where
	cell_of_forall_param _ctx date =
		Leijen.Table.cell
		 { Leijen.Table.cell_content = Ledger.write_date        date
		 , Leijen.Table.cell_width   = Ledger.write_date_length date
		 }
instance Leijen.Table.Cell_of_forall_param Ledger.Journal Ledger.Account where
	cell_of_forall_param _ctx account =
		let posting_type = Ledger.Posting_Type_Regular in
		Leijen.Table.cell
		 { Leijen.Table.cell_content = Ledger.write_account        posting_type account
		 , Leijen.Table.cell_width   = Ledger.write_account_length posting_type account
		 }
instance Leijen.Table.Cell_of_forall_param Ledger.Journal (Ledger.Unit, Ledger.Quantity) where
	cell_of_forall_param j (unit, qty) =
		let sty = Ledger.journal_amount_styles j in
		let amt = Ledger.Amount unit qty in
		let sa  = Ledger.amount_styled sty amt in
		Leijen.Table.cell
		 { Leijen.Table.cell_content = Ledger.write_amount        sa
		 , Leijen.Table.cell_width   = Ledger.write_amount_length sa
		 }
instance Leijen.Table.Cell_of_forall_param Ledger.Journal Ledger.Wording where
	cell_of_forall_param _j w =
		Leijen.Table.cell
		 { Leijen.Table.cell_content = toDoc ()    w
		 , Leijen.Table.cell_width   = Text.length w
		 }

instance Foldable f => W.ToDoc1 Ledger.Journal (f Ledger.Transaction) where
	toDoc1 =
		Ledger.write_transactions .
		Ledger.journal_amount_styles