{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Hcompta.CLI.Command.Balance where

import           Control.Applicative ((<*), Const(..), Applicative(..))
import           Control.Arrow (first, (+++), (&&&), (***))
import           Control.DeepSeq (NFData)
import           Control.Monad (Monad(..), liftM, mapM)
import           Control.Monad.IO.Class (liftIO)
import           Data.Bool
import           Data.Data
import           Data.Decimal (Decimal)
import           Data.Either (Either(..), partitionEithers)
import           Data.Eq (Eq(..))
import           Data.Foldable (Foldable(..), any)
import           Data.Function (($), (.), const, on)
import           Data.Functor (Functor(..), (<$>))
import           Data.List ((++), repeat)
-- import           Data.List.NonEmpty (NonEmpty(..))
import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import           Data.Maybe (Maybe(..))
import           Data.Monoid (Monoid(..))
import           Data.Ord (Ord(..), Ordering(..))
import qualified Data.Strict.Maybe as Strict
import           Data.String (String)
import           Data.Text (Text)
import qualified Data.Time.Clock as Time
import           Data.Tuple (fst, snd)
import           Prelude (Bounded(..), FilePath, IO, Num(..), id, flip, unlines, zipWith)
import           System.Console.GetOpt
                 ( ArgDescr(..)
                 , OptDescr(..)
                 , usageInfo
                 )
import           System.Environment as Env (getProgName)
import           System.Exit (exitSuccess)
import qualified System.IO as IO
import qualified Text.Parsec
import           Text.Show (Show(..))

import           Hcompta.Account (Account_Tags)
import qualified Hcompta.Account as Account
import qualified Hcompta.Balance as Balance
import qualified Hcompta.CLI.Args as Args
import qualified Hcompta.CLI.Context as C
import qualified Hcompta.CLI.Env as CLI.Env
import           Hcompta.CLI.Format (Format(..), Formats)
import qualified Hcompta.CLI.Format as Format
import           Hcompta.CLI.Format.JCC ()
import           Hcompta.CLI.Format.Ledger ()
import qualified Hcompta.CLI.Lang as Lang
import qualified Hcompta.CLI.Lib.Leijen.Table as Leijen.Table
import qualified Hcompta.CLI.Write as Write
import qualified Hcompta.Chart as Chart
import           Hcompta.Date (Date)
import qualified Hcompta.Date as Date
import qualified Hcompta.Filter as Filter
import qualified Hcompta.Filter.Amount as Filter.Amount
import qualified Hcompta.Filter.Read as Filter.Read
import qualified Hcompta.Format.JCC as JCC
import qualified Hcompta.Format.Ledger      as Ledger
import qualified Hcompta.Format.Ledger.Read as Ledger
import           Hcompta.Lib.Leijen (toDoc, ToDoc(..))
import qualified Hcompta.Lib.Leijen as W
import qualified Hcompta.Lib.Parsec as R
import           Hcompta.Lib.TreeMap (TreeMap)
import qualified Hcompta.Lib.TreeMap as TreeMap
import           Hcompta.Polarize (Polarized)
import qualified Hcompta.Polarize as Polarize
import qualified Hcompta.Posting as Posting
import qualified Hcompta.Quantity as Quantity
import           Hcompta.Unit (Unit(..))

-- type Sum = (Ledger.Unit, Polarize.Polarized Ledger.Quantity)

data Context
 =   Context
 { ctx_filter_transaction :: forall t.
                             ( Filter.Transaction t
                             , Filter.Amount_Quantity
                               (Posting.Posting_Amount
                               (Filter.Transaction_Posting t))
                               ~ Filter.Amount.Quantity
                             ) => Filter.Simplified
                                  (Filter.Filter_Bool
                                  (Filter.Filter_Transaction t))
 , ctx_filter_balance     :: forall b.
                             ( Filter.Balance b
                             , Filter.Amount_Quantity
                               (Filter.Balance_Amount b)
                               ~ Filter.Amount.Quantity
                             ) => Filter.Simplified
                                  (Filter.Filter_Bool
                                  (Filter.Filter_Balance b))
 -- , ctx_filter_posting      :: CLI.Format.Filter_Posting
 , ctx_heritage            :: Bool
 , ctx_input               :: [FilePath]
 , ctx_input_format        :: Formats
 , ctx_output              :: [(Write.Mode, FilePath)]
 , ctx_output_format       :: (Maybe Formats, Output_Format)
 , ctx_reduce_date         :: Bool
 , ctx_redundant           :: Bool
 , ctx_total_by_unit       :: Bool
 , ctx_account_equilibrium :: (JCC.Account, JCC.Account)
 } -- deriving (Show)

data Output_Format
 =   Output_Format_Table
 |   Output_Format_Transaction Lang.Exercise_OC
 deriving (Eq, Show)

context :: C.Context -> Context
context c =
	Context
	 { ctx_filter_transaction  = Filter.Simplified $ Right True
	 , ctx_filter_balance      = Filter.Simplified $ Right True
	 -- , ctx_filter_posting      = mempty
	 , ctx_heritage            = True
	 , ctx_input               = []
	 , ctx_input_format        = mempty
	 , ctx_output              = []
	 , ctx_output_format       = (Nothing, Output_Format_Table)
	 , ctx_reduce_date         = True
	 , ctx_redundant           = False
	 , ctx_total_by_unit       = True
	 , ctx_account_equilibrium =
		let e = C.translate c Lang.Account_Equilibrium
		in (e, e)
	 }

usage :: C.Context -> IO String
usage c = do
	bin <- Env.getProgName
	return $ unlines $
		[ C.translate c Lang.Section_Description
		, "  "++C.translate c Lang.Help_Command_Balance
		, ""
		, C.translate c Lang.Section_Syntax
		, "  "++bin++" balance ["++C.translate c Lang.Type_Option++"] [...]"++
		                     " ["++C.translate c Lang.Type_File_Journal++"] [...]"
		, ""
		, usageInfo (C.translate c Lang.Section_Options) (options c)
		]

options :: C.Context -> Args.Options Context
options c =
	[ Option "b" ["filter-balance"]
	 (ReqArg (\s ctx -> do
		filter <-
			R.runParserT_with_Error
			 Filter.Read.filter_balance
			 Filter.Read.context "" s
		case filter of
		 Left (ko::[R.Error Filter.Read.Error]) -> Write.fatal c ko
		 Right flt ->
			return $
				ctx{ctx_filter_balance =
					Filter.and (ctx_filter_balance ctx) $
					(Filter.simplify $
						Filter.Read.get_Forall_Filter_Balance_Decimal <$> flt)
				 }) $
		C.translate c Lang.Type_Filter_Balance) $
		C.translate c Lang.Help_Option_Filter_Balance
	{-, Option "p" ["filter-posting"]
	 (ReqArg (\s ctx -> do
		read <- liftIO $ Filter.Read.read Filter.Read.filter_posting s
		case read of
		 Left ko -> Write.fatal c ko
		 Right filter -> return $
			ctx{ctx_filter_posting =
				(ctx_filter_posting ctx <>) $
				CLI.Format.All
				 (Filter.simplify $ Filter.Read.get_Forall_Filter_Posting_Decimal <$> filter)
				 (Filter.simplify $ Filter.Read.get_Forall_Filter_Posting_Decimal <$> filter)
			 }) $
		C.translate c Lang.Type_Filter_Posting) $
		C.translate c Lang.Help_Option_Filter_Posting
	-}
	, Option "t" ["filter-transaction"]
	 (ReqArg (\s ctx -> do
		filter <-
			R.runParserT_with_Error
			 Filter.Read.filter_transaction
			 Filter.Read.context "" s
		case filter of
		 Left ko -> Write.fatal c ko
		 Right flt ->
			return $
				ctx{ctx_filter_transaction =
					Filter.and (ctx_filter_transaction ctx) $
					(Filter.simplify $
						Filter.Read.get_Forall_Filter_Transaction_Decimal <$> flt)
				 }) $
		C.translate c Lang.Type_Filter_Transaction) $
		C.translate c Lang.Help_Option_Filter_Transaction
	, Option "h" ["help"]
	 (NoArg (\_ctx -> do
		usage c >>= IO.hPutStr IO.stderr
		exitSuccess)) $
		C.translate c Lang.Help_Option_Help
	, Option "i" ["input"]
	 (ReqArg (\s ctx -> do
		return $ ctx{ctx_input=s:ctx_input ctx}) $
		C.translate c Lang.Type_File_Journal) $
		C.translate c Lang.Help_Option_Input
	, Option "f" ["input-format"]
	 (OptArg (\arg ctx -> do
		ctx_input_format <- case arg of
		 Nothing       -> return $ Format_JCC ()
		 Just "jcc"    -> return $ Format_JCC ()
		 Just "ledger" -> return $ Format_Ledger ()
		 Just _        -> Write.fatal c $
			W.text "--input-format option expects \"jcc\", or \"ledger\" as value"
		return $ ctx{ctx_input_format})
	  "[jcc|ledger]")
	  "input format"
	, Option "o" ["output"]
	 (ReqArg (\s ctx -> do
		return $ ctx{ctx_output=(Write.Mode_Append, s):ctx_output ctx}) $
		C.translate c Lang.Type_File) $
		C.translate c Lang.Help_Option_Output
	, Option "O" ["overwrite"]
	 (ReqArg (\s ctx -> do
		return $ ctx{ctx_output=(Write.Mode_Over, s):ctx_output ctx}) $
		C.translate c Lang.Type_File) $
		C.translate c Lang.Help_Option_Overwrite
	{- NOTE: not used so far.
	, Option "" ["reduce-date"]
	 (OptArg (\arg ctx -> do
		ctx_reduce_date <- case arg of
		 Nothing    -> return $ True
		 Just "yes" -> return $ True
		 Just "no"  -> return $ False
		 Just _     -> Write.fatal c $
			W.text "--reduce-date option expects \"yes\", or \"no\" as value"
		return $ ctx{ctx_reduce_date})
	  "[yes|no]")
	 "use advanced date reducer to speed up filtering"
	-}
	, Option "" ["redundant"]
	 (OptArg (\arg ctx -> do
		ctx_redundant <- case arg of
		 Nothing    -> return $ True
		 Just "yes" -> return $ True
		 Just "no"  -> return $ False
		 Just _     -> Write.fatal c Lang.Error_Option_Balance_Redundant
		return $ ctx{ctx_redundant})
	  "[no|yes]") $
		C.translate c Lang.Help_Option_Balance_Redundant
	, Option "" ["heritage"]
	 (OptArg (\arg ctx -> do
		ctx_heritage <- case arg of
		 Nothing    -> return $ True
		 Just "yes" -> return $ True
		 Just "no"  -> return $ False
		 Just _     -> Write.fatal c Lang.Error_Option_Balance_Heritage
		return $ ctx{ctx_heritage})
	  "[yes|no]") $
		C.translate c Lang.Help_Option_Balance_Heritage
	, Option "" ["total"]
	 (OptArg (\arg ctx -> do
		ctx_total_by_unit <- case arg of
		 Nothing    -> return $ True
		 Just "yes" -> return $ True
		 Just "no"  -> return $ False
		 Just _     -> Write.fatal c Lang.Error_Option_Balance_Total
		return $ ctx{ctx_total_by_unit})
	  "[yes|no]") $
		C.translate c Lang.Help_Option_Balance_Total
	, Option "F" ["output-format"]
	 (ReqArg (\arg ctx -> do
		ctx_output_format <- case arg of
		 "table"        -> return $ (Nothing                , Output_Format_Table)
		 "table.jcc"    -> return $ (Just $ Format_JCC    (), Output_Format_Table)
		 "table.ledger" -> return $ (Just $ Format_Ledger (), Output_Format_Table)
		 "open"         -> return $ (Nothing                , Output_Format_Transaction Lang.Exercise_Opening)
		 "open.jcc"     -> return $ (Just $ Format_JCC    (), Output_Format_Transaction Lang.Exercise_Opening)
		 "open.ledger"  -> return $ (Just $ Format_Ledger (), Output_Format_Transaction Lang.Exercise_Opening)
		 "close"        -> return $ (Nothing                , Output_Format_Transaction Lang.Exercise_Closing)
		 "close.jcc"    -> return $ (Just $ Format_JCC    (), Output_Format_Transaction Lang.Exercise_Closing)
		 "close.ledger" -> return $ (Just $ Format_Ledger (), Output_Format_Transaction Lang.Exercise_Closing)
		 _              -> Write.fatal c Lang.Error_Option_Balance_Format
		return $ ctx{ctx_output_format})
	  "[table|close|open][.jcc|.ledger]") $
		C.translate c Lang.Help_Option_Balance_Format
	, Option "" ["eq"]
	 (ReqArg (\arg ctx -> do
		ctx_account_equilibrium <-
			fmap (\e -> (e, e)) $
			case Text.Parsec.runParser
				 (Ledger.read_account <* Text.Parsec.eof)
				 () "" arg of
			 Right acct -> return acct
			 _          -> Write.fatal c Lang.Error_Option_Equilibrium
		return $ ctx{ctx_account_equilibrium}) $
		C.translate c Lang.Type_Account) $
		C.translate c Lang.Help_Option_Equilibrium
	, Option "" ["eq-credit"]
	 (ReqArg (\arg ctx -> do
		ctx_account_equilibrium <-
			fmap (\e -> (fst $ ctx_account_equilibrium ctx, e)) $
			case Text.Parsec.runParser
				 (Ledger.read_account <* Text.Parsec.eof)
				 () "" arg of
			 Right acct -> return acct
			 _          -> Write.fatal c Lang.Error_Option_Equilibrium_Credit
		return $ ctx{ctx_account_equilibrium}) $
		C.translate c Lang.Type_Account) $
		C.translate c Lang.Help_Option_Equilibrium_Credit
	, Option "" ["eq-debit"]
	 (ReqArg (\arg ctx -> do
		ctx_account_equilibrium <-
			fmap (\e -> (e, snd $ ctx_account_equilibrium ctx)) $
			case Text.Parsec.runParser
				 (Ledger.read_account <* Text.Parsec.eof)
				 () "" arg of
			 Right acct -> return acct
			 _          -> Write.fatal c Lang.Error_Option_Equilibrium_Debit
		return $ ctx{ctx_account_equilibrium}) $
		C.translate c Lang.Type_Account) $
		C.translate c Lang.Help_Option_Equilibrium_Debit
	]

run :: C.Context -> [String] -> IO ()
run c args = do
	(ctx, inputs) <-
		first (\x ->
			case ctx_output x of
			 [] -> x{ctx_output=[(Write.Mode_Append, "-")]}
			 _  -> x) <$>
		Args.parse c usage options (context c, args)
	input_paths <- CLI.Env.paths c $ ctx_input ctx ++ inputs
	read_journals <- mapM (liftIO . journal_read ctx) input_paths
	case partitionEithers read_journals of
	 (errs@(_:_), _journals) -> Write.fatals c errs
	 ([], (journals::[Forall_Journal_Balance_by_Account])) -> do
		let bal_by_account =
			mconcat $
			fmap Format.journal_flatten $
			case fst $ ctx_output_format ctx of
			 Just f -> Format.journal_empty f:journals
			 Nothing -> journals
		now <- Date.now
		with_color <- Write.with_color c IO.stdout
		W.displayIO IO.stdout $
			W.renderPretty with_color 1.0 maxBound $
			case snd $ ctx_output_format ctx of
			 Output_Format_Table ->
				toDoc () $ Leijen.Table.table_of (c, ctx) bal_by_account
			 Output_Format_Transaction oc ->
				journal_equilibrium_transaction
				 (Const bal_by_account::Const Forall_Journal_Balance_by_Account ())
				 c ctx oc now
		{-
		Write.debug c $ "filter: transaction: " ++ show (ctx_filter_transaction ctx)
		Write.debug c $ "filter: posting: " ++ show (ctx_filter_posting ctx)
		Write.debug c $ "filter: balance: " ++ show (ctx_filter_balance ctx)
		let sty = Write.style { Write.style_pretty = True }
		-}

instance Leijen.Table.Table_of (C.Context, Context) Forall_Journal_Balance_by_Account where
	table_of (c, ctx) bal_by_account =
		let lang = C.lang c in
		let (rows_by_account, rows_by_unit) =
			case ctx_heritage ctx of
			 True  -> rows_of_balance_by_account $ expand bal_by_account
			 False -> rows_of_balance_by_account          bal_by_account in
		zipWith id
		 [ Leijen.Table.column (Lang.translate lang Lang.Title_Debit)   Leijen.Table.Align_Right
		 , Leijen.Table.column (Lang.translate lang Lang.Title_Credit)  Leijen.Table.Align_Right
		 , Leijen.Table.column (Lang.translate lang Lang.Title_Balance) Leijen.Table.Align_Right
		 , Leijen.Table.column (Lang.translate lang Lang.Title_Account) Leijen.Table.Align_Left
		 ] $
		rows_by_account $
		(if ctx_total_by_unit ctx
		 then zipWith (:)
			 [ Leijen.Table.Cell_Line '=' 0
			 , Leijen.Table.Cell_Line '=' 0
			 , Leijen.Table.Cell_Line '=' 0
			 , Leijen.Table.Cell_Line ' ' 0
			 ] . rows_by_unit
		 else id) $
		repeat []
		where
			expand
			 :: Forall_Journal_Balance_by_Account
			 -> Forall_Journal_Balance_by_Account_Expanded
			expand = Format.journal_wrap
			rows_of_balance_by_account
			 :: ( Format.Journal_Filter Context (Const bal_by_account) ()
			    , Format.Journal_Wrap bal_by_account Forall_Journal_Balance_by_Unit
			    , Format.Journal_Leijen_Table_Cells (Const bal_by_account) ()
			    )
			 => bal_by_account
			 -> ( [[Leijen.Table.Cell]] -> [[Leijen.Table.Cell]]
			    , [[Leijen.Table.Cell]] -> [[Leijen.Table.Cell]] )
			rows_of_balance_by_account =
				(***) Format.journal_leijen_table_cells
				      Format.journal_leijen_table_cells .
				(&&&) id sum_by_unit .
				Format.journal_filter ctx .
				Const
				where
					sum_by_unit
					 :: Format.Journal_Wrap bal_by_account Forall_Journal_Balance_by_Unit
					 => Const bal_by_account ()
					 -> Const Forall_Journal_Balance_by_Unit ()
					sum_by_unit = Const . Format.journal_wrap . getConst










-- * 'Balance.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
 = Balance.Balance_by_Account JCC.Account_Section
                              JCC.Unit
                              (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
 = Balance.Balance_by_Account Ledger.Account_Section
                              Ledger.Unit
                              (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 -> 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
 , Quantity.Addable q
 , Quantity.Zero q
 
 , Unit u
 ) => Format.Journal_Filter Context j (Balance.Balance_by_Account as u (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 ->
			TreeMap.map_Maybe_with_Path_and_Node
			 (\node account (Balance.Account_Sum bal) ->
				(if is_worth node bal then id else const Strict.Nothing) $
				case Map.mapMaybeWithKey
				 (\unit qty ->
					if Filter.test flt
						 ( (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 $ Balance.Account_Sum m
			 ) <$> j
		where
			is_worth
			 :: (Ord k0, Foldable t0, Quantity.Addable a0, Quantity.Zero a0)
			 => TreeMap.Node k0 x0
			 -> t0 (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
				|| Data.Foldable.any
					 (not . Quantity.quantity_null . Polarize.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
 , Quantity.Addable (Format.Journal_Quantity j)
 
 , Leijen.Table.Cell_of_forall_param j (TreeMap.Path as)
 
 , Balance_Account_Sum amt
 , Balance_Account_Sum_Unit amt ~ Format.Journal_Unit j
 , Balance_Account_Sum_Quantity amt ~ 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 Balance.Account_Sum bal = balance_by_account_sum balance in
			Map.foldrWithKey
			 (\unit qty ->
				zipWith (:)
				 [ cell_of $ (unit,) <$> Polarize.polarized_positive qty
				 , cell_of $ (unit,) <$> Polarize.polarized_negative qty
				 , cell_of (unit, Polarize.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_Account_Sum'

-- | A class to get a 'Balance.Account_Sum'
--   when operating on 'Balance.Balance_by_Account'
--   or 'Balance.Expanded' 'Balance.inclusive' field.
class Balance_Account_Sum amt where
	type Balance_Account_Sum_Unit     amt
	type Balance_Account_Sum_Quantity amt
	balance_by_account_sum
	 :: amt -> Balance.Account_Sum (Balance_Account_Sum_Unit amt)
	                               (Balance_Account_Sum_Quantity amt)
instance Balance_Account_Sum (Balance.Account_Sum u q) where
	type Balance_Account_Sum_Unit     (Balance.Account_Sum u q) = u
	type Balance_Account_Sum_Quantity (Balance.Account_Sum u q) = q
	balance_by_account_sum = id
instance Balance_Account_Sum (Balance.Account_Sum_Expanded u q) where
	type Balance_Account_Sum_Unit     (Balance.Account_Sum_Expanded u q) = u
	type Balance_Account_Sum_Quantity (Balance.Account_Sum_Expanded u q) = q
	balance_by_account_sum = Balance.inclusive










-- * '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
 = Balance.Expanded JCC.Account_Section
                    JCC.Unit
                    (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
 = Balance.Expanded Ledger.Account_Section
                    Ledger.Unit
                    (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
 , Quantity.Addable q
 , Quantity.Zero q
 , Unit u
 ) => Format.Journal_Filter Context j (Balance.Expanded as u (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 ->
			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
						 ( (Chart.account_tags account (Format.journal_chart j), account)
						 , (unit, qty)
						 )
					then Just qty
					else Nothing
				 ) (Balance.get_Account_Sum $ Balance.inclusive bal) of
				 m | Map.null m -> Strict.Nothing
				 m -> Strict.Just $ bal{Balance.inclusive=Balance.Account_Sum m}
			 ) <$> j
		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
					 && Data.Foldable.any
						 (not . Quantity.quantity_null . Polarize.depolarize)
						 (Balance.get_Account_Sum $ Balance.inclusive bal))
				-- NOTE: worth if Account's exclusive
				-- has at least a non-zero Amount
				|| (Data.Foldable.any
					 (not . Quantity.quantity_null . Polarize.depolarize)
					 (Balance.get_Account_Sum $ Balance.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
							 ( Data.Foldable.any
								 (not . Quantity.quantity_null . Polarize.depolarize)
							 . Balance.get_Account_Sum
							 . Balance.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 Balance.Balance_by_Account -> Balance.Expanded

instance
 ( Functor j
 , Journal_Balance_by_Account_Expanded j (Balance.Expanded as u q)
 
 -- NOTE: constraints from Balance.expanded
 , Ord as
 , Ord u
 , Quantity.Addable q
 ) => Format.Journal_Wrap (j (Balance.Balance_by_Account as u q))
                          Forall_Journal_Balance_by_Account_Expanded where
	journal_wrap =
		Forall_Journal_Balance_by_Account_Expanded .
		fmap 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











-- * 'Balance.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
 = Balance.Balance_by_Unit JCC.Account
                           JCC.Unit
                           (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
 = Balance.Balance_by_Unit Ledger.Account
                           Ledger.Unit
                           (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 Balance.Balance_by_Account -> Balance.Balance_by_Unit

instance
 ( Functor j
 , Journal_Balance_by_Unit j (Balance.Balance_by_Unit (Account.Account_Path as) u q)
 
 -- NOTE: constraints from Balance.by_unit_of_by_account
 , Account.Account (Account.Account_Path as)
 , Ord as
 , Ord u
 , Quantity.Addable q
 ) => Format.Journal_Wrap (j (Balance.Balance_by_Account as u q))
                          Forall_Journal_Balance_by_Unit where
	journal_wrap =
		Forall_Journal_Balance_by_Unit .
		fmap (flip 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 Balance.Expanded -> Balance.Balance_by_Unit

instance
 ( Functor j
 , Journal_Balance_by_Unit j (Balance.Balance_by_Unit (Account.Account_Path as) u q)
 
 -- NOTE: constraints from Balance.by_unit_of_expanded
 , Account.Account (Account.Account_Path as)
 , Ord as
 , Ord u
 , Quantity.Addable q
 ) => Format.Journal_Wrap (j (Balance.Expanded as u q))
                          Forall_Journal_Balance_by_Unit where
	journal_wrap =
		Forall_Journal_Balance_by_Unit .
		fmap (flip 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
 , Account.Account a
 , u ~ Format.Journal_Unit j
 , Ord u
 , q ~ Format.Journal_Quantity j
 , Quantity.Addable (Format.Journal_Quantity j)
 ) => Format.Journal_Leijen_Table_Cells j (Balance.Balance_by_Unit a u (Polarized q)) where
	journal_leijen_table_cells jnl acc =
		let Balance.Balance_by_Unit bal = Format.journal_content jnl in
		Map.foldrWithKey
		 (\unit amt ->
			let qty = Balance.unit_sum_quantity amt in
			zipWith (:)
				[ Leijen.Table.cell_of_forall_param jnl $ (unit,) <$> Polarize.polarized_positive qty
				, Leijen.Table.cell_of_forall_param jnl $ (unit,) <$> Polarize.polarized_negative qty
				, Leijen.Table.cell_of_forall_param jnl (unit, Polarize.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.Leijen_of_forall_param j [Format.Journal_Transaction j]
 ) => Journal (j:: * -> *) where
	journal_posting
	 :: forall m. j m
	 -> Account.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
	 -> (Date, [Date])
	 -> Map (Account.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
	 -> 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
 , Quantity.Zero (Format.Journal_Quantity j)
 , Quantity.Addable (Format.Journal_Quantity j)
 , unit ~ Format.Journal_Unit j
 ) => Journal_Equilibrium_Transaction
 j (Balance.Balance_by_Account as unit (Polarized quantity)) where
	journal_equilibrium_transaction
	 j c ctx oc now =
		let bal_by_account = Format.journal_content j in
		let Balance.Balance_by_Unit bal_by_unit =
			Balance.by_unit_of_by_account bal_by_account mempty in
		let postings =
			Map.foldlWithKey
			 (\acc unit Balance.Unit_Sum{Balance.unit_sum_quantity} ->
				let qty =
					(case oc of
					 Lang.Exercise_Closing -> id
					 Lang.Exercise_Opening -> negate) $
					Polarize.depolarize unit_sum_quantity in
				case Quantity.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.leijen_of_forall_param 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 (Balance.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)
					. Polarize.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)
-}