{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Hcompta.LCC.Write.Balance where

import Control.Monad (Monad(..))
import Data.Bool
import Data.Char (Char)
import Data.Decimal
import Data.Eq (Eq(..))
-- import Data.Foldable (Foldable(..))
import Data.Function (($), (.), flip, id)
import Data.Functor ((<$>))
import Data.Functor.Compose (Compose(..))
import Data.Proxy (Proxy(..))
import Data.Map.Strict (Map)
import Data.Maybe (Maybe(..), fromMaybe, maybe)
import Data.Monoid (Monoid(..))
import Data.Ord (Ord(..))
import Data.Semigroup (Semigroup(..))
import Data.Text (Text)
import Data.Tuple (fst)
import GHC.Exts (Int(..))
import Prelude (Integer, Num(..), RealFrac(..), Show(..), Integral(..), fromIntegral)
import System.IO (IO)
import qualified Data.ByteString as BS
import qualified Data.Char as Char
import qualified Data.List as L
import qualified Data.Map.Strict as Map
import qualified Data.MonoTraversable as MT
import qualified Data.NonNull as NonNull
import qualified Data.Strict as S
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Enc
import qualified Data.TreeMap.Strict as TM

import qualified Language.Symantic.Document as D

import qualified Hcompta as H

import Hcompta.LCC.Account
import Hcompta.LCC.Amount
import Hcompta.LCC.Chart
import Hcompta.LCC.Compta
import Hcompta.LCC.IO
import Hcompta.LCC.Journal
import Hcompta.LCC.Name
import Hcompta.LCC.Posting
import Hcompta.LCC.Tag
import Hcompta.LCC.Transaction
import Hcompta.LCC.Balance
import Hcompta.LCC.Write.Compta
import Hcompta.LCC.Write.Table
import qualified Hcompta.LCC.Read.Compta as G
import qualified Hcompta.Lib.Strict as S


-- * Class 'Msg_Title'
class Msg_Title lang d where
	msg_Title_Debit   :: d
	msg_Title_Credit  :: d
	msg_Title_Balance :: d
	msg_Title_Account :: d

-- * Type 'FR'
data FR
instance D.Doc_Text d => Msg_Title FR d where
	msg_Title_Debit   = D.textH "Débit"
	msg_Title_Credit  = D.textH "Crédit"
	msg_Title_Balance = D.textH "Solde"
	msg_Title_Account = D.textH "Compte"

-- * Type 'Config_Balance'
data Config_Balance
 =   Config_Balance
 {   config_balance_heritage      :: Bool
 ,   config_balance_total_by_unit :: Bool
 }

instance Writeable (Style_Amount, Amount) d =>
         CellPlainOf (Style_Amount, Amount) d
instance Writeable Date d => CellPlainOf Date d
instance Writeable Account d => CellPlainOf Account d
instance ( CellPlainOf () d
         , CellPlainOf (Style_Amount, Amount) d
         ) => CellPlainOf (Maybe (Style_Amount, Amount)) d where
	cellPlainOf = cellPlainOf () `maybe` cellPlainOf
	
-- instance D.Doc_Text d => CellPlainOf Wording d

-- * Type 'RowsPlain'
type RowsPlain d = [[CellPlain d]] -> [[CellPlain d]]

-- * Class 'RowsPlainOf'
class RowsPlainOf a d where
	rowsPlainOf :: a -> RowsPlain d

instance ( CellPlainOf () d
         , CellPlainOf Account d
         , CellPlainOf (Style_Amount, Amount) d
         ) => RowsPlainOf (Style_Amount, BalByAccount) d where
	rowsPlainOf (sty, bal) =
		flip (TM.foldr_with_Path
		 (\acct sum rows ->
			Map.foldrWithKey
			 (\unit qty ->
				L.zipWith (:)
				 [ cellPlainOf $ (sty,) . Amount unit <$> H.unPositive qty
				 , cellPlainOf $ (sty,) . Amount unit <$> H.unNegative qty
				 , cellPlainOf $ (sty,) $ Amount unit $ H.depolarize qty
				 , cellPlainOf $ Account acct
				 ]
			 )
			 rows sum
		 )) bal
instance ( CellPlainOf () d
         , CellPlainOf Account d
         , CellPlainOf (Style_Amount, Amount) d
         ) => RowsPlainOf (Style_Amount, ClusiveBalByAccount) d where
	rowsPlainOf (sty, bal) =
		flip (TM.foldr_with_Path
		 (\acct S.Clusive{S.inclusive=sum} rows ->
			Map.foldrWithKey
			 (\unit qty ->
				L.zipWith (:)
				 [ cellPlainOf $ (sty,) . Amount unit <$> H.unPositive qty
				 , cellPlainOf $ (sty,) . Amount unit <$> H.unNegative qty
				 , cellPlainOf $ (sty,) $ Amount unit $ H.depolarize qty
				 , cellPlainOf $ Account acct
				 ]
			 )
			 rows sum
		 )) bal
instance ( CellPlainOf () d
         , CellPlainOf Account d
         , CellPlainOf (Style_Amount, Amount) d
         ) => RowsPlainOf (Style_Amount, BalByUnit) d where
	rowsPlainOf (sty, bal) =
		flip (Map.foldrWithKey
		 (\unit H.SumByUnit{H.sumByUnit_quantity=qty} ->
			L.zipWith (:)
			 [ cellPlainOf $ (sty,) . Amount unit <$> H.unPositive qty
			 , cellPlainOf $ (sty,) . Amount unit <$> H.unNegative qty
			 , cellPlainOf $ (sty,) $ Amount unit $ H.depolarize qty
			 , cellPlainOf ()
			 ]
		 )) bal
instance ( Monoid d
         , D.Doc_Text d
         , D.Doc_Color d
         , D.Doc_Decoration d
         , Msg_Title lang Text
         ) => TablePlainOf (Proxy lang, Style_Amount, BalByAccount, BalByUnit) d where
	tablePlainOf (_lang, sty, ba, bu) =
		L.zipWith id
		 [ columnPlain (msg_Title_Debit   @lang) AlignPlainR
		 , columnPlain (msg_Title_Credit  @lang) AlignPlainR
		 , columnPlain (msg_Title_Balance @lang) AlignPlainR
		 , columnPlain (msg_Title_Account @lang) AlignPlainL
		 ] $
		rowsPlainOf (sty, ba) $
		rowsPlainOf (sty, bu) $
		L.repeat []

{-
instance Writeable (Proxy lang, Balance) d where
	write (lang, H.Balance)

instance Writeable (Proxy lang, Compta src ss Balance) d where
	write (lang, Compta{compta_journals=js, compta_style_amounts=sty}) =
		tablePlainOf (lang, sty, )

instance ( CellPlainOf () d
         , CellPlainOf Account d
         , CellPlainOf (Style_Amount, Amount) d
         ) => RowsPlainOf (Style_Amount, BalByAccount, H.BalByUnit) d where
	rowsPlainOf (sty, bal) =

instance TablePlainOf (Style_Amount, H.BalByUnit NameAccount Unit (H.Polarized Quantity)) where
	tablePlainOf conf balByAccount =
		let (rowsByAccount, rowsByUnit) =
			case config_balance_heritage conf of
			 True  -> rowsOfBalByUnit $ H.clusiveBalByAccount balByAccount
			 False -> rowsOfBalByUnit                         balByAccount in
		zipWith id
		 [ tColumn (msg_Title_Debit   @lang) AlignR
		 , tColumn (msg_Title_Credit  @lang) AlignR
		 , tColumn (msg_Title_Balance @lang) AlignR
		 , tColumn (msg_Title_Account @lang) AlignL
		 ] $
		rowsByAccount $
		(if config_balance_total_by_unit conf
		 then zipWith (:)
			 [ tCellLine '=' 0
			 , tCellLine '=' 0
			 , tCellLine '=' 0
			 , tCellLine ' ' 0
			 ] . rowsByUnit
		 else id) $
		L.repeat []
		where
		expand :: Forall_Journal_Balance_by_Account ->
		          Forall_Journal_Balance_by_Account_Expanded
		expand = Format.journal_wrap
		rowsOfBalByUnit ::
		 ( Format.Journal_Filter Context (Const BalByAccount) ()
		 , Format.Journal_Wrap BalByAccount Forall_Journal_Balance_by_Unit
		 , Format.Journal_Leijen_Table_Cells (Const BalByAccount) ()
		 ) =>
		 BalByAccount ->
		 ( [[CellPlain d]] -> [[CellPlain d]]
		 , [[CellPlain d]] -> [[CellPlain d]] )
		rowsOfBalByUnit =
			(***) tCellsOfBalByAccount tCellsOfBalByUnit .
			(&&&) id sum_by_unit .
			Format.journal_filter ctx .
			Const
			where
			sum_by_unit ::
			 Format.Journal_Wrap BalByAccount Forall_Journal_Balance_by_Unit =>
			 Const BalByAccount () ->
			 Const Forall_Journal_Balance_by_Unit ()
			sum_by_unit = Const . Format.journal_wrap . getConst

{-
ttableOf :: forall lang d.
 D.Doc_Text d =>
 D.Doc_Color d =>
 BalByAccount -> TTable d


-}




{-
instance Leijen.Table.Table_of (C.Context, Context) Forall_Journal_Balance_by_Account where
-}










{-
-- * 'H.Balance_by_Account'

-- ** Type 'Format_Balance_by_Account'

type Format_Journal_Balance_by_Account
 = Format
   (   JCC.Journal Balance_by_Account_JCC)
   (Ledger.Journal Balance_by_Account_Ledger)

-- JCC
type Balance_by_Account_JCC
 = H.Balance_by_Account JCC.Account_Section
                        JCC.Unit
                        (H.Polarized JCC.Quantity)
instance Format.Journal (JCC.Journal Balance_by_Account_JCC) where
	type Journal_Format   (JCC.Journal Balance_by_Account_JCC)
	 = Format_Journal_Balance_by_Account
	journal_format = Format_JCC

-- Ledger
type Balance_by_Account_Ledger
 = H.Balance_by_Account Ledger.Account_Section
                        Ledger.Unit
                        (H.Polarized Ledger.Quantity)
instance Format.Journal (Ledger.Journal Balance_by_Account_Ledger) where
	type Journal_Format   (Ledger.Journal Balance_by_Account_Ledger)
	 = Format_Journal_Balance_by_Account
	journal_format = Format_Ledger

-- ** Class 'Journal_Balance_by_Account'

class
 ( Format.Journal (j m)
 , Format.Journal_Format (j m) ~ Format_Journal_Balance_by_Account
 , Format.Journal_Read j
 , Format.Journal_Monoid (j m)
 , Format.Journal_Leijen_Table_Cells j m
 , Format.Journal_Wrap (j m) Forall_Journal_Balance_by_Account_Expanded
 , Format.Journal_Wrap (j m) Forall_Journal_Balance_by_Unit
 , Format.Journal_Filter Context j m
 , Journal_Equilibrium_Transaction j m
 ) => Journal_Balance_by_Account j m

instance Journal_Balance_by_Account    JCC.Journal Balance_by_Account_JCC
instance Journal_Balance_by_Account Ledger.Journal Balance_by_Account_Ledger

-- ** Type 'Forall_Journal_Balance_by_Account'

data    Forall_Journal_Balance_by_Account
 = forall j m. Journal_Balance_by_Account  j m
 =>     Forall_Journal_Balance_by_Account (j m)

instance Format.Journal Forall_Journal_Balance_by_Account where
	type Journal_Format   Forall_Journal_Balance_by_Account = Format_Journal_Balance_by_Account
	journal_format
	 (Forall_Journal_Balance_by_Account j) =
		Format.journal_format j
instance Format.Journal_Empty Forall_Journal_Balance_by_Account where
	journal_empty f =
		case f of
		 Format_JCC    () -> Forall_Journal_Balance_by_Account (mempty::JCC.Journal Balance_by_Account_JCC)
		 Format_Ledger () -> Forall_Journal_Balance_by_Account (mempty::Ledger.Journal Balance_by_Account_Ledger)
instance Format.Journal_Monoid Forall_Journal_Balance_by_Account where
	journal_flatten
	 (Forall_Journal_Balance_by_Account j) =
		Forall_Journal_Balance_by_Account $
		Format.journal_flatten j
	journal_fold f (Forall_Journal_Balance_by_Account j) =
		Format.journal_fold (f . Forall_Journal_Balance_by_Account) j
instance Monoid Forall_Journal_Balance_by_Account where
	mempty = Forall_Journal_Balance_by_Account (mempty::JCC.Journal Balance_by_Account_JCC)
	mappend x y =
		case (mappend `on` Format.journal_format) x y of
		 Format_JCC    j -> Forall_Journal_Balance_by_Account j
		 Format_Ledger j -> Forall_Journal_Balance_by_Account j
	mconcat js =
		case js of
		 [] -> mempty
		 j:jn -> List.foldl' mappend j jn

-- ** 'journal_read'

type Journal_Filter_Simplified transaction
 = Filter.Simplified
   (Filter.Filter_Bool
   (Filter.Filter_Transaction transaction))
type Journal_Read_Cons txn
 = txn -> Filter.Filtered (Journal_Filter_Simplified txn) txn
journal_read
 :: Context -> FilePath
 -> IO (Either (Format.Message W.Doc) Forall_Journal_Balance_by_Account)
journal_read ctx =
	case ctx_input_format ctx of
	 Format_JCC () ->
		let wrap (j::JCC.Journal Balance_by_Account_JCC)
			 = Forall_Journal_Balance_by_Account j in
		let cons :: Journal_Read_Cons (JCC.Charted JCC.Transaction)
			 = Filter.Filtered (ctx_filter_transaction ctx) in
		liftM ((+++) Format.Message wrap) .
		Format.journal_read cons
	 Format_Ledger () ->
		let wrap (j::Ledger.Journal Balance_by_Account_Ledger)
			 = Forall_Journal_Balance_by_Account j in
		let cons :: Journal_Read_Cons (Ledger.Charted Ledger.Transaction)
			 = Filter.Filtered (ctx_filter_transaction ctx) in
		liftM ((+++) Format.Message wrap) .
		Format.journal_read cons

{-
-- ** Type family 'Balance_by_Account'

type family Balance_by_Account (j:: * -> *) m
type instance Balance_by_Account
   j (Balance.Expanded           as u (Polarized q))
 = j (Balance.Balance_by_Account as u (Polarized q))
type instance Balance_by_Account
   (Const Forall_Journal_Balance_by_Account_Expanded) ()
 = (Const Forall_Journal_Balance_by_Account         ) ()
-}

-- Instances 'Format.Journal_Filter'

instance
 ( Functor j
 , Format.Journal_Chart j
 
 , as ~ Format.Journal_Account_Section j
 , Data as
 {-, Filter.Account (Account_Tags, TreeMap.Path as)-}
 , NFData as
 , Ord as
 , Show as
 
 , q ~ Format.Journal_Quantity j
 , Format.Journal_Quantity j ~ Decimal
 , H.Addable q
 , H.Zero q
 
 , H.Unit u
 ) => Format.Journal_Filter Context j (H.Balance_by_Account as u (H.Polarized q)) where
	journal_filter ctx j =
		case Filter.simplified $ ctx_filter_balance ctx of
		 Right True | ctx_redundant ctx -> j
		 Right True ->
			TreeMap.filter_with_Path_and_Node
			 (\n _p -> is_worth n) <$> j
		 Right False -> const mempty <$> j
		 Left flt ->
			(<$> j) $
			TreeMap.map_Maybe_with_Path_and_Node
			 (\node account (H.Balance_by_Account_Sum bal) ->
				(if is_worth node bal then id else const Strict.Nothing) $
				case Map.mapMaybeWithKey
				 (\unit qty ->
					if Filter.test flt
						 ( (H.chart_account_tags account (Format.journal_chart j), account)
						 , (unit, qty)
						 )
					then Just qty
					else Nothing
				 ) bal of
				 m | Map.null m -> Strict.Nothing
				 m -> Strict.Just $ H.Balance_by_Account_Sum m
			 )
		where
			is_worth
			 :: (Ord k0, Foldable t0, H.Addable a0, H.Zero a0)
			 => TreeMap.Node k0 x0
			 -> t0 (H.Polarized a0)
			 -> Bool
			is_worth _node bal =
				ctx_redundant ctx
				-- NOTE: worth if no descendant
				-- but Account's exclusive
				-- has at least a non-zero Amount
				|| Foldable.any
					 (not . H.quantity_null . H.depolarize)
					 bal
instance Format.Journal_Filter Context (Const Forall_Journal_Balance_by_Account) () where
	journal_filter ctx
	 (Const (Forall_Journal_Balance_by_Account j)) =
		Const $ Forall_Journal_Balance_by_Account $
		Format.journal_filter ctx j

-- Instances 'Format.Journal_Leijen_Table_Cells'

instance
 ( Format.Journal_Content j
 , Journal j
 
 , as ~ Format.Journal_Account_Section j
 , Ord as
 , H.Addable (Format.Journal_Quantity j)
 
 , Leijen.Table.Cell_of_forall_param j (TreeMap.Path as)
 
 , Balance_by_Account_Sum amt
 , Balance_by_Account_Sum_Unit amt ~ Format.Journal_Unit j
 , Balance_by_Account_Sum_Quantity amt ~ H.Polarized (Format.Journal_Quantity j)
 ) => Format.Journal_Leijen_Table_Cells j (TreeMap as amt) where
	journal_leijen_table_cells jnl =
		flip (TreeMap.foldr_with_Path
		 (\account balance rows ->
			let H.Balance_by_Account_Sum bal = balance_by_account_sum balance in
			Map.foldrWithKey
			 (\unit qty ->
				zipWith (:)
				 [ cell_of $ (unit,) <$> H.polarized_positive qty
				 , cell_of $ (unit,) <$> H.polarized_negative qty
				 , cell_of (unit, H.depolarize qty)
				 , cell_of account
				 ]
			 )
			 rows bal
		 ))
		 (Format.journal_content jnl)
		where
			cell_of :: Leijen.Table.Cell_of_forall_param j x => x -> Leijen.Table.Cell
			cell_of = Leijen.Table.cell_of_forall_param jnl
instance Format.Journal_Leijen_Table_Cells (Const Forall_Journal_Balance_by_Account) () where
	journal_leijen_table_cells
	 (Const (Forall_Journal_Balance_by_Account j)) =
		Format.journal_leijen_table_cells j

-- ** Class 'Balance_by_Account_Sum'

-- | A class to get a 'H.Balance_Account_Sum'
--   when operating on 'H.Balance_by_Account'
--   or 'H.Balance_Expanded' 'Strict.inclusive' field.
class Balance_by_Account_Sum amt where
	type Balance_by_Account_Sum_Unit     amt
	type Balance_by_Account_Sum_Quantity amt
	balance_by_account_sum
	 :: amt -> H.Balance_by_Account_Sum (Balance_by_Account_Sum_Unit amt)
	                                    (Balance_by_Account_Sum_Quantity amt)
instance Balance_by_Account_Sum (H.Balance_by_Account_Sum u q) where
	type Balance_by_Account_Sum_Unit     (H.Balance_by_Account_Sum u q) = u
	type Balance_by_Account_Sum_Quantity (H.Balance_by_Account_Sum u q) = q
	balance_by_account_sum = id
instance Balance_by_Account_Sum (H.Balance_by_Account_Sum_Expanded u q) where
	type Balance_by_Account_Sum_Unit     (H.Balance_by_Account_Sum_Expanded u q) = u
	type Balance_by_Account_Sum_Quantity (H.Balance_by_Account_Sum_Expanded u q) = q
	balance_by_account_sum = Strict.inclusive

-- * 'H.Balance_Expanded'

-- ** Type 'Format_Journal_Balance_by_Account_Expanded'

type Format_Journal_Balance_by_Account_Expanded
 = Format
   (   JCC.Journal Balance_by_Account_Expanded_JCC)
   (Ledger.Journal Balance_by_Account_Expanded_Ledger)

-- JCC
type Balance_by_Account_Expanded_JCC
 = H.Balance_Expanded JCC.Account_Section
                    JCC.Unit
                    (H.Polarized JCC.Quantity)
instance Format.Journal (JCC.Journal Balance_by_Account_Expanded_JCC) where
	type Journal_Format   (JCC.Journal Balance_by_Account_Expanded_JCC)
	 = Format_Journal_Balance_by_Account_Expanded
	journal_format = Format_JCC

-- Ledger
type Balance_by_Account_Expanded_Ledger
 = H.Balance_Expanded Ledger.Account_Section
                      Ledger.Unit
                      (H.Polarized Ledger.Quantity)
instance Format.Journal (Ledger.Journal Balance_by_Account_Expanded_Ledger) where
	type Journal_Format   (Ledger.Journal Balance_by_Account_Expanded_Ledger)
	 = Format_Journal_Balance_by_Account_Expanded
	journal_format = Format_Ledger

-- ** Class 'Journal_Balance_by_Account_Expanded'

class
 ( Format.Journal (j m)
 , Format.Journal_Format (j m) ~ Format_Journal_Balance_by_Account_Expanded
 , Format.Journal_Leijen_Table_Cells j m
 , Format.Journal_Wrap (j m) Forall_Journal_Balance_by_Unit
 , Format.Journal_Filter Context j m
 ) => Journal_Balance_by_Account_Expanded j m

instance Journal_Balance_by_Account_Expanded    JCC.Journal Balance_by_Account_Expanded_JCC
instance Journal_Balance_by_Account_Expanded Ledger.Journal Balance_by_Account_Expanded_Ledger

-- ** Type 'Forall_Journal_Balance_by_Account_Expanded'

data    Forall_Journal_Balance_by_Account_Expanded
 = forall j m. Journal_Balance_by_Account_Expanded  j m
 =>     Forall_Journal_Balance_by_Account_Expanded (j m)

instance Format.Journal Forall_Journal_Balance_by_Account_Expanded where
	type Journal_Format   Forall_Journal_Balance_by_Account_Expanded = Format_Journal_Balance_by_Account_Expanded
	journal_format
	 (Forall_Journal_Balance_by_Account_Expanded j) =
		Format.journal_format j

-- Instances 'Format.Journal_Filter'

instance
 ( Functor j
 , Format.Journal_Chart j
 , as ~ Format.Journal_Account_Section j
 , Data as
 {-, Filter.Account (Account_Tags, TreeMap.Path as)-}
 , NFData as
 , Ord as
 , Show as
 , q ~ Format.Journal_Quantity j
 , Format.Journal_Quantity j ~ Decimal
 , H.Addable q
 , H.Zero q
 , H.Unit u
 ) => Format.Journal_Filter Context j (H.Balance_Expanded as u (H.Polarized q)) where
	journal_filter ctx j =
		case Filter.simplified $ ctx_filter_balance ctx of
		 Right True | ctx_redundant ctx -> j
		 Right True ->
			TreeMap.filter_with_Path_and_Node
			 (const . is_worth) <$> j
		 Right False -> const mempty <$> j
		 Left flt ->
			(<$> j) $
			TreeMap.map_Maybe_with_Path_and_Node
			 (\node account bal ->
				(if is_worth node bal then id else const Strict.Nothing) $
				case Map.mapMaybeWithKey
				 (\unit qty ->
					if Filter.test flt
						 ( (H.chart_account_tags account (Format.journal_chart j), account)
						 , (unit, qty)
						 )
					then Just qty
					else Nothing
				 ) (H.unBalance_by_Account_Sum $ Strict.inclusive bal) of
				 m | Map.null m -> Strict.Nothing
				 m -> Strict.Just $ bal{Strict.inclusive=H.Balance_by_Account_Sum m}
			 )
		where
			is_worth node bal =
				let descendants = TreeMap.nodes
					 (TreeMap.node_descendants node) in
				ctx_redundant ctx
				-- NOTE: worth if no descendant
				-- but Account's inclusive
				-- has at least a non-zero Amount
				|| (Map.null descendants &&
					Foldable.any
						 (not . H.quantity_null . H.depolarize)
						 (H.unBalance_by_Account_Sum $ Strict.inclusive bal))
				-- NOTE: worth if Account's exclusive
				-- has at least a non-zero Amount
				|| (Foldable.any
					 (not . H.quantity_null . H.depolarize)
					 (H.unBalance_by_Account_Sum $ Strict.exclusive bal))
				-- NOTE: worth if Account has at least more than
				-- one descendant Account whose inclusive
				-- has at least a non-zero Amount
				|| Map.size
					 ( Map.filter
						 ( Strict.maybe False
							 ( Foldable.any
								 (not . H.quantity_null . H.depolarize)
							 . H.unBalance_by_Account_Sum
							 . Strict.inclusive )
						 . TreeMap.node_value )
						 descendants
					 ) > 1
instance Format.Journal_Filter Context (Const Forall_Journal_Balance_by_Account_Expanded) () where
	journal_filter ctx
	 (Const (Forall_Journal_Balance_by_Account_Expanded j)) =
		Const $ Forall_Journal_Balance_by_Account_Expanded $
		Format.journal_filter ctx j

-- Instances 'Format.Journal_Leijen_Table_Cells'

instance Format.Journal_Leijen_Table_Cells (Const Forall_Journal_Balance_by_Account_Expanded) x where
	journal_leijen_table_cells
	 (Const (Forall_Journal_Balance_by_Account_Expanded j)) =
		Format.journal_leijen_table_cells j

-- Instances H.Balance_by_Account -> H.Balance_Expanded

instance
 ( Functor j
 , Journal_Balance_by_Account_Expanded j (H.Balance_Expanded as u q)
 
 -- NOTE: constraints from H.balance_expanded
 , Ord as
 , Ord u
 , H.Addable q
 ) => Format.Journal_Wrap (j (H.Balance_by_Account as u q))
                          Forall_Journal_Balance_by_Account_Expanded where
	journal_wrap =
		Forall_Journal_Balance_by_Account_Expanded .
		fmap H.balance_expanded

instance Format.Journal_Wrap Forall_Journal_Balance_by_Account
                             Forall_Journal_Balance_by_Account_Expanded where
	journal_wrap (Forall_Journal_Balance_by_Account j) = Format.journal_wrap j











-- * 'H.Balance_by_Unit'

type Format_Journal_Balance_by_Unit
 = Format
   (   JCC.Journal Balance_by_Unit_JCC)
   (Ledger.Journal Balance_by_Unit_Ledger)

-- JCC
type Balance_by_Unit_JCC
 = H.Balance_by_Unit JCC.Account
                     JCC.Unit
                     (H.Polarized JCC.Quantity)
instance Format.Journal (JCC.Journal Balance_by_Unit_JCC) where
	type Journal_Format   (JCC.Journal Balance_by_Unit_JCC)
	 = Format_Journal_Balance_by_Unit
	journal_format = Format_JCC

-- Ledger
type Balance_by_Unit_Ledger
 = H.Balance_by_Unit Ledger.Account
                     Ledger.Unit
                     (H.Polarized Ledger.Quantity)
instance Format.Journal (Ledger.Journal Balance_by_Unit_Ledger) where
	type Journal_Format   (Ledger.Journal Balance_by_Unit_Ledger)
	 = Format_Journal_Balance_by_Unit
	journal_format = Format_Ledger

-- ** Class 'Journal_Balance_by_Unit'

class
 ( Format.Journal (j m)
 , Format.Journal_Format (j m) ~ Format_Journal_Balance_by_Unit
 , Format.Journal_Leijen_Table_Cells j m
 -- , Journal_Equilibrium_Postings j m
 )
 => Journal_Balance_by_Unit j m

instance Journal_Balance_by_Unit    JCC.Journal Balance_by_Unit_JCC
instance Journal_Balance_by_Unit Ledger.Journal Balance_by_Unit_Ledger

-- ** Type 'Forall_Journal_Balance_by_Unit'

data    Forall_Journal_Balance_by_Unit
 = forall j m. Journal_Balance_by_Unit  j m
 =>     Forall_Journal_Balance_by_Unit (j m)

instance Format.Journal Forall_Journal_Balance_by_Unit where
	type Journal_Format   Forall_Journal_Balance_by_Unit = Format_Journal_Balance_by_Unit
	journal_format (Forall_Journal_Balance_by_Unit j) = Format.journal_format j

-- Instances H.Balance_by_Account -> H.Balance_by_Unit

instance
 ( Functor j
 , Journal_Balance_by_Unit j (H.Balance_by_Unit (H.Account_Path as) u q)
 
 -- NOTE: constraints from H.balance_by_unit_of_by_account
 , H.Account (H.Account_Path as)
 , Ord as
 , Ord u
 , H.Addable q
 ) => Format.Journal_Wrap (j (H.Balance_by_Account as u q))
                          Forall_Journal_Balance_by_Unit where
	journal_wrap =
		Forall_Journal_Balance_by_Unit .
		fmap (flip H.balance_by_unit_of_by_account mempty)

instance Format.Journal_Wrap Forall_Journal_Balance_by_Account
                             Forall_Journal_Balance_by_Unit where
	journal_wrap
	 (Forall_Journal_Balance_by_Account j) =
		Format.journal_wrap j

-- Instances H.Balance_Expanded -> H.Balance_by_Unit

instance
 ( Functor j
 , Journal_Balance_by_Unit j (H.Balance_by_Unit (H.Account_Path as) u q)
 
 -- NOTE: constraints from H.balance_by_unit_of_expanded
 , H.Account (H.Account_Path as)
 , Ord as
 , Ord u
 , H.Addable q
 ) => Format.Journal_Wrap (j (H.Balance_Expanded as u q))
                          Forall_Journal_Balance_by_Unit where
	journal_wrap =
		Forall_Journal_Balance_by_Unit .
		fmap (flip H.balance_by_unit_of_expanded mempty)

instance Format.Journal_Wrap Forall_Journal_Balance_by_Account_Expanded
                             Forall_Journal_Balance_by_Unit where
	journal_wrap
	 (Forall_Journal_Balance_by_Account_Expanded j) =
		Format.journal_wrap j

-- Instances 'Format.Journal_Leijen_Table_Cells'

instance
 ( Format.Journal_Content j
 , Journal j
 
 , a ~ Format.Journal_Account j
 , H.Account a
 , u ~ Format.Journal_Unit j
 , Ord u
 , q ~ Format.Journal_Quantity j
 , H.Addable (Format.Journal_Quantity j)
 ) => Format.Journal_Leijen_Table_Cells j (H.Balance_by_Unit a u (H.Polarized q)) where
	journal_leijen_table_cells jnl acc =
		let H.Balance_by_Unit bal = Format.journal_content jnl in
		Map.foldrWithKey
		 (\unit amt ->
			let qty = H.balance_by_unit_sum_quantity amt in
			zipWith (:)
				[ Leijen.Table.cell_of_forall_param jnl $ (unit,) <$> H.polarized_positive qty
				, Leijen.Table.cell_of_forall_param jnl $ (unit,) <$> H.polarized_negative qty
				, Leijen.Table.cell_of_forall_param jnl (unit, H.depolarize qty)
				, Leijen.Table.cell
				]
		 ) acc bal
instance Format.Journal_Leijen_Table_Cells (Const Forall_Journal_Balance_by_Unit) () where
	journal_leijen_table_cells
	 (Const (Forall_Journal_Balance_by_Unit j)) =
		Format.journal_leijen_table_cells j









-- * Class 'Journal'

class
 ( Leijen.Table.Cell_of_forall_param j (Format.Journal_Unit j, Format.Journal_Quantity j)
 , W.ToDoc1 j [Format.Journal_Transaction j]
 ) => Journal (j:: * -> *) where
	journal_posting
	 :: forall m. j m
	 -> H.Account_Path (Format.Journal_Account_Section j)
	 -> Map (Format.Journal_Unit j)
	        (Format.Journal_Quantity j)
	 -> [Text] -- ^ Comments
	 -> Format.Journal_Posting j
	journal_transaction
	 :: forall m. j m
	 -> Text -- ^ Wording
	 -> (H.Date, [H.Date])
	 -> Map (H.Account_Path (Format.Journal_Account_Section j))
	        [Format.Journal_Posting j]
	 -> Format.Journal_Transaction j

instance Journal JCC.Journal where
	journal_posting _j acct
	 posting_amounts
	 posting_comments =
		(JCC.posting acct)
		 { JCC.posting_amounts
		 , JCC.posting_comments
		 }
	journal_transaction _j
	 transaction_wording
	 transaction_dates
	 transaction_postings =
		JCC.transaction
		 { JCC.transaction_wording
		 , JCC.transaction_dates
		 , JCC.transaction_postings
		 }
instance Journal Ledger.Journal where
	journal_posting _j acct
	 posting_amounts
	 posting_comments =
		(Ledger.posting acct)
		 { Ledger.posting_amounts
		 , Ledger.posting_comments
		 }
	journal_transaction _j
	 transaction_wording
	 transaction_dates
	 transaction_postings =
		Ledger.transaction
		 { Ledger.transaction_wording
		 , Ledger.transaction_dates
		 , Ledger.transaction_postings
		 }













-- * Class 'Journal_Equilibrium_Transaction'

class Journal_Equilibrium_Transaction j m where
	journal_equilibrium_transaction
	 :: j m
	 -> C.Context
	 -> Context
	 -> Lang.Exercise_OC
	 -> H.Date
	 -> W.Doc

instance
 ( Format.Journal_Content j
 , Journal j
 
 , as ~ Format.Journal_Account_Section j
 , Format.Journal_Account_Section j ~ Text
 , Format.Journal_Account j ~ TreeMap.Path Text
 , Num quantity
 , quantity ~ Format.Journal_Quantity j
 , Ord unit
 , Ord quantity
 , H.Zero (Format.Journal_Quantity j)
 , H.Addable (Format.Journal_Quantity j)
 , unit ~ Format.Journal_Unit j
 ) => Journal_Equilibrium_Transaction
 j (H.Balance_by_Account as unit (H.Polarized quantity)) where
	journal_equilibrium_transaction
	 j c ctx oc now =
		let bal_by_account = Format.journal_content j in
		let H.Balance_by_Unit bal_by_unit =
			H.balance_by_unit_of_by_account bal_by_account mempty in
		let postings =
			Map.foldlWithKey
			 (\acc unit H.Balance_by_Unit_Sum{..} ->
				let qty =
					(case oc of
					 Lang.Exercise_Closing -> id
					 Lang.Exercise_Opening -> negate) $
					H.depolarize balance_by_unit_sum_quantity in
				case H.quantity_sign qty of
				 LT ->
					let account = snd $ ctx_account_equilibrium ctx in
					Map.insertWith mappend account
					 [journal_posting j account
						 (Map.singleton unit qty)
						 [ Lang.translate (C.lang c) Lang.Comment_Equilibrium ]]
					 acc
				 EQ -> acc
				 GT ->
					let account = fst $ ctx_account_equilibrium ctx in
					Map.insertWith mappend account
					 [journal_posting j account
						 (Map.singleton unit qty)
						 [ Lang.translate (C.lang c) Lang.Comment_Equilibrium ]]
					 acc
			 )
			 Map.empty
			 bal_by_unit
		 in
		W.toDoc1 j [
		journal_transaction j
		 (Lang.translate (C.lang c) (Lang.Description_Exercise oc))
		 (now{Time.utctDayTime=0}, []) $
		Map.unionWith mappend postings $
		TreeMap.flatten_with_Path
		 (\posting_account (H.Balance_by_Account_Sum amount_by_unit) ->
			[ journal_posting j posting_account
				 (flip fmap amount_by_unit $
					(case oc of
					 Lang.Exercise_Closing -> negate
					 Lang.Exercise_Opening -> id)
					. H.depolarize)
				 []
			]
		 )
		 bal_by_account
		 ]

instance Journal_Equilibrium_Transaction (Const Forall_Journal_Balance_by_Account) () where
	journal_equilibrium_transaction
	 (Const (Forall_Journal_Balance_by_Account j)) =
		journal_equilibrium_transaction j

-}

{-
instance
  ToDoc (C.Context, Context, Date, Lang.Exercise_OC)
        ( Forall_Journal_Balance_by_Account
        , Forall_Journal_Balance_by_Unit ) where
	toDoc c
	 ( Forall_Journal_Balance_by_Account bal_by_account
	 , Forall_Journal_Balance_by_Unit    bal_by_unit
	 ) =
		toDoc c (bal_by_account, bal_by_unit)
-}

-}