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

-- import           Control.Monad.Trans.Except (ExceptT(..))
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           Control.DeepSeq (NFData)
import           Prelude (($))
-- import           System.IO (IO)
import           Text.Show (Show(..))

import           Hcompta.Date (Date)
import qualified Hcompta.Balance as Balance
-- import qualified Hcompta.CLI.Format as CLI.Format
-- import           Hcompta.CLI.Lang (Lang)
import qualified Hcompta.CLI.Lang as Lang
import qualified Hcompta.Format.Ledger       as Ledger
import qualified Hcompta.Format.Ledger.Read  as Ledger
import qualified Hcompta.Format.Ledger.Write as Ledger
-- import           Hcompta.Lib.Consable (Consable)
import           Hcompta.Lib.Leijen (ToDoc(..))
import qualified Hcompta.Lib.Leijen as W
-- import qualified Hcompta.Lib.Parsec as Parsec
import qualified Hcompta.Polarize as Polarize
import qualified Hcompta.CLI.Lib.Leijen.Table as Leijen.Table

instance Lang.Translate Ledger.Read_Error W.Doc where
	translate lang err =
		case err of
		 Ledger.Read_Error_date date -> toDoc lang date
		 Ledger.Read_Error_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.Read_Error_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.Read_Error_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.Read_Error_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, Balance.Unit_Sum{Balance.unit_sum_quantity}) ->
						Lang.translate lang $
						Lang.Error_Transaction_Ledger_Unit_sums_up_to_the_non_null_amount unit $
						Ledger.amount_styled styles $
						Ledger.Amount unit $
						Polarize.depolarize unit_sum_quantity
					 ) unit_sums
				 , W.space
				 , Ledger.write_transaction styles tr
				 ]

instance Leijen.Table.Cell_of_forall_param Ledger.Journal 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.Leijen_of_forall_param Ledger.Journal (f Ledger.Transaction) where
	leijen_of_forall_param =
		Ledger.write_transactions .
		Ledger.journal_amount_styles