{-# 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.GL where

import           Control.Applicative (Const(..), (<$>))
import           Control.Arrow (first, (+++))
import           Control.Monad (Monad(..), liftM, mapM)
import           Control.Monad.IO.Class (liftIO)
import           Data.Bool
import           Data.Decimal (Decimal)
import           Data.Either (Either(..), partitionEithers)
import           Data.Foldable (Foldable(..))
import           Data.Function (($), (.), on, id, flip)
import           Data.Functor (Functor(..))
import           Data.List ((++), repeat)
import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import           Data.Maybe (Maybe(..))
import           Data.Monoid (Monoid(..))
import           Data.Ord (Ord)
import qualified Data.Sequence as Seq
import qualified Data.Strict.Maybe as Strict
import           Data.String (String)
import           Data.Text (Text)
import           Prelude (Bounded(..), 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           System.IO (FilePath, IO)

import qualified Hcompta.Account as Account
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.Ledger ()
import           Hcompta.CLI.Format.JCC ()
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.Filter as Filter
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.GL as GL
import           Hcompta.Lib.Leijen (toDoc, ToDoc(..))
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.Filter.Amount as Filter.Amount
import           Hcompta.CLI.Format (Format(..), Formats)
import qualified Hcompta.CLI.Format as Format
import qualified Hcompta.Lib.Leijen as W
import qualified Hcompta.Lib.Parsec as R
import qualified Hcompta.Unit as Unit
import qualified Hcompta.Quantity as 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_gl          :: forall b.
                             ( Filter.GL b
                             , Filter.Amount_Quantity
                               (Filter.GL_Amount b)
                               ~ Filter.Amount.Quantity
                             ) => Filter.Simplified
                                  (Filter.Filter_Bool
                                  (Filter.Filter_GL b))
 , ctx_input              :: [FilePath]
 , ctx_input_format       :: Formats
 , ctx_output             :: [(Write.Mode, FilePath)]
 , ctx_output_format      :: Maybe Formats

 -- , ctx_filter_gl          :: Filter.Simplified
 --                             (Filter.Filter_Bool
 --                             (Filter.Filter_GL
 --                             ( (Account_Tags, Ledger.Account)
 --                             , Date
 --                             , (Ledger.Unit, Polarize.Polarized Ledger.Quantity)
 --                             , (Ledger.Unit, Polarize.Polarized Ledger.Quantity) )))
 -- , ctx_filter_posting     :: Filter.Simplified
 --                             (Filter.Filter_Bool
 --                             (Filter.Filter_Posting
 --                             (Ledger.Charted Ledger.Posting)))
 , ctx_reduce_date        :: Bool
 } -- deriving (Show)

context :: Context
context =
	Context
	 { ctx_filter_gl          = Filter.Simplified $ Right True
	 -- , ctx_filter_posting     = Filter.Simplified $ Right True
	 , ctx_filter_transaction = Filter.Simplified $ Right True
	 , ctx_input              = []
	 , ctx_input_format       = mempty
	 , ctx_output             = []
	 , ctx_output_format      = mempty
	 , ctx_reduce_date        = True
	 }

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_General_Ledger
		, ""
		, C.translate c Lang.Section_Syntax
		, "  "++bin++" gl ["++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 "g" ["filter-gl"]
	 (ReqArg (\s ctx -> do
		filter <-
			R.runParserT_with_Error
			 Filter.Read.filter_gl
			 Filter.Read.context "" s
		case filter of
		 Left (ko::[R.Error Filter.Read.Error]) -> Write.fatal c ko
		 Right flt ->
			return $
				ctx{ctx_filter_gl =
					Filter.and (ctx_filter_gl ctx) $
					(Filter.simplify $
						Filter.Read.get_Forall_Filter_GL_Decimal <$> flt)
				 }) $
		C.translate c Lang.Type_Filter_General_Ledger) $
		C.translate c Lang.Help_Option_Filter_General_Ledger
	{-, Option "p" ["filter-posting"]
	 (ReqArg (\s ctx -> do
		ctx_filter_posting <-
			liftM ((ctx_filter_posting ctx <>) . Filter.simplify) $
			liftIO $ Filter.Read.read Filter.Read.filter_posting s
			>>= \f -> case f of
			 Left  ko -> Write.fatal c $ ko
			 Right ok -> return ok
		return $ ctx{ctx_filter_posting}) $
		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 "F" ["output-format"]
	 (ReqArg (\arg ctx -> do
		ctx_output_format <- case arg of
		 "jcc"    -> return $ Just $ Format_JCC ()
		 "ledger" -> return $ Just $ Format_Ledger ()
		 _        -> Write.fatal c $
			W.text "--output-format option expects \"jcc\", or \"ledger\" as value"
		return $ ctx{ctx_output_format})
	  "[jcc|ledger]") $
		"output format"
	, 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 c 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"
	-}
	]

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, 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_GL])) -> do
		let gl =
			mconcat $
			fmap Format.journal_flatten $
			case ctx_output_format ctx of
			 Just f -> Format.journal_empty f:journals
			 Nothing -> journals
		with_color <- Write.with_color c IO.stdout
		W.displayIO IO.stdout $
			W.renderPretty with_color 1.0 maxBound $
			toDoc () $ Leijen.Table.table_of (c, ctx) gl
		{-
		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)
		-}

instance Leijen.Table.Table_of (C.Context, Context) Forall_Journal_GL where
	table_of (c, ctx) gl =
		let lang = C.lang c in
		zipWith id
		 [ Leijen.Table.column (Lang.translate lang Lang.Title_Account)         Leijen.Table.Align_Left
		 , Leijen.Table.column (Lang.translate lang Lang.Title_Date)            Leijen.Table.Align_Left
		 , 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_Running_debit)   Leijen.Table.Align_Right
		 , Leijen.Table.column (Lang.translate lang Lang.Title_Running_credit)  Leijen.Table.Align_Right
		 , Leijen.Table.column (Lang.translate lang Lang.Title_Running_balance) Leijen.Table.Align_Right
		 , Leijen.Table.column (Lang.translate lang Lang.Title_Description)     Leijen.Table.Align_Left
		 ] $
		Format.journal_leijen_table_cells
		 (Format.journal_filter ctx $
			(Const::x -> Const x ()) gl) $
		repeat []


-- * 'GL.GL'

-- ** Type 'Format_GL'

type Format_Journal_GL
 = Format
   (   JCC.Journal GL_JCC)
   (Ledger.Journal GL_Ledger)

-- JCC
type GL_JCC
 = GL.GL (JCC.Charted JCC.Transaction)
 -- = GL.GL JCC.Transaction
instance Format.Journal (JCC.Journal GL_JCC) where
	type Journal_Format   (JCC.Journal GL_JCC)
	 = Format_Journal_GL
	journal_format = Format_JCC

-- Ledger
type GL_Ledger
 -- = GL.GL Ledger.Transaction
 = GL.GL (Ledger.Charted Ledger.Transaction)
instance Format.Journal (Ledger.Journal GL_Ledger) where
	type Journal_Format   (Ledger.Journal GL_Ledger)
	 = Format_Journal_GL
	journal_format = Format_Ledger

-- ** Class 'Journal'

class
 ( Format.Journal_Read j
 , Ord (Account.Account_Section (Format.Journal_Account j))
 , Leijen.Table.Cell_of_forall_param j
    (TreeMap.Path (Account.Account_Section
     (GL.Posting_Account (Format.Journal_Posting j))))
 , Leijen.Table.Cell_of_forall_param j
    (Format.Journal_Unit j, Format.Journal_Quantity j)
 , Leijen.Table.Cell_of_forall_param j
    (TreeMap.Path (Account.Account_Section (GL.Posting_Account
     (Chart.Charted (Format.Journal_Account j)
      (Format.Journal_Posting j)))))
 , Polarize.Polarizable (Format.Journal_Quantity j)
 ) => Journal j
 where
	journal_transaction_wording
	 :: forall m. j m
	 -> Format.Journal_Transaction j
	 -> Text
	journal_posting_amounts
	 :: forall m. j m
	 -> Format.Journal_Posting j
	 -> Map (Format.Journal_Unit j)
	        (Format.Journal_Quantity j)
	journal_posting_amounts_set
	 :: forall m. j m
	 -> Map (Format.Journal_Unit j)
	        (Format.Journal_Quantity j)
	 -> Format.Journal_Posting j
	 -> Format.Journal_Posting j

instance Journal JCC.Journal
 where
	journal_transaction_wording _j = JCC.transaction_wording
	journal_posting_amounts     _j = JCC.posting_amounts
	journal_posting_amounts_set _j posting_amounts p =
		p { JCC.posting_amounts }
instance Journal Ledger.Journal
 where
	journal_transaction_wording _j = Ledger.transaction_wording
	journal_posting_amounts     _j = Ledger.posting_amounts
	journal_posting_amounts_set _j posting_amounts p =
		p { Ledger.posting_amounts }

-- ** Class 'Journal_GL'

class
 ( Format.Journal (j m)
 , Format.Journal_Format (j m) ~ Format_Journal_GL
 , Format.Journal_Read j
 , Format.Journal_Monoid (j m)
 -- , Format.Journal_Wrap (j m) Forall_Journal_GL_Expanded
 , Format.Journal_Leijen_Table_Cells j m
 , Format.Journal_Filter Context j m
 ) => Journal_GL j m

instance Journal_GL JCC.Journal    GL_JCC
instance Journal_GL Ledger.Journal GL_Ledger

-- ** Type 'Forall_Journal_GL'

data    Forall_Journal_GL
 = forall j m. Journal_GL  j m
 =>     Forall_Journal_GL (j m)

instance Format.Journal Forall_Journal_GL where
	type Journal_Format   Forall_Journal_GL = Format_Journal_GL
	journal_format
	 (Forall_Journal_GL j) =
		Format.journal_format j
instance Format.Journal_Empty Forall_Journal_GL where
	journal_empty f =
		case f of
		 Format_JCC    () -> Forall_Journal_GL (mempty::JCC.Journal GL_JCC)
		 Format_Ledger () -> Forall_Journal_GL (mempty::Ledger.Journal GL_Ledger)
instance Format.Journal_Monoid Forall_Journal_GL where
	journal_flatten
	 (Forall_Journal_GL j) =
		Forall_Journal_GL $
		Format.journal_flatten j
	journal_fold f (Forall_Journal_GL j) =
		Format.journal_fold (f . Forall_Journal_GL) j
instance Monoid Forall_Journal_GL where
	mempty = Forall_Journal_GL (mempty::JCC.Journal GL_JCC)
	mappend x y =
		case (mappend `on` Format.journal_format) x y of
		 Format_JCC    j -> Forall_Journal_GL j
		 Format_Ledger j -> Forall_Journal_GL 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_GL)
journal_read ctx =
	case ctx_input_format ctx of
	 Format_JCC () ->
		let wrap (j::JCC.Journal GL_JCC)
			 = Forall_Journal_GL 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 GL_Ledger)
			 = Forall_Journal_GL 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


-- Instances 'Format.Journal_Filter'

instance
 ( Functor j
 , Format.Journal_Chart j
 , Journal j
 , Journal_GL j (GL.GL t)
 , GL.Transaction t
 , Format.Journal_Account_Section j ~ Text
 , GL.Transaction_Posting t
   ~ Chart.Charted (Format.Journal_Account j)
                   (Format.Journal_Posting j)
 , GL.Posting_Quantity (GL.Transaction_Posting t)
   ~ Map (Format.Journal_Unit j)
         (Polarized (Format.Journal_Quantity j))
 , Format.Journal_Quantity j ~ Decimal
 , Format.Journal_Account_Section j
   ~ Account.Account_Section (GL.Posting_Account (GL.Transaction_Posting t))
 , Ord (Format.Journal_Unit j)
 , Unit.Unit (Format.Journal_Unit j)
 ) => Format.Journal_Filter Context j (GL.GL t) where
	journal_filter ctx j =
		GL.GL .
		TreeMap.map_Maybe_with_Path
		 (\acct expanded_lines ->
			let chart = Format.journal_chart j in
			case Map.mapMaybeWithKey
			 (\date seq_lines ->
				case foldMap
				 (\line@GL.GL_Line
				 { GL.gl_line_transaction = _t
				 , GL.gl_line_posting     = p
				 , GL.gl_line_sum         = s
				 } ->
					Map.foldlWithKey
					 (\acc unit qty ->
						let sqty = (Map.!) s unit in
						if Filter.test (ctx_filter_gl ctx)
						 ( (Chart.account_tags acct chart, acct)
						 , date
						 , (unit, Polarize.polarize qty)
						 , (unit, sqty)
						 )
						then (Seq.|>) acc line
						 { GL.gl_line_posting =
							journal_posting_amounts_set j
							 (Map.singleton unit qty) <$> p
						 , GL.gl_line_sum = Map.singleton unit sqty
						 }
						else acc
					 )
					 Seq.empty
					 (journal_posting_amounts j $ Chart.charted p)
				 ) seq_lines
				 of
				 m | Seq.null m -> Nothing
				 m -> Just m
			 )
			 (GL.inclusive expanded_lines)
			 of
				m | Map.null m -> Strict.Nothing
				m -> Strict.Just m
		 ) .
		(\(GL.Expanded gl) -> gl) .
		GL.expanded <$> j
instance Format.Journal_Filter Context (Const Forall_Journal_GL) () where
	journal_filter ctx
	 (Const (Forall_Journal_GL j)) =
		Const $ Forall_Journal_GL $
		Format.journal_filter ctx j

-- Instances 'Format.Journal_Leijen_Table_Cells'

instance
 ( Format.Journal_Content j
 , Journal j
 
 , Quantity.Addable (Format.Journal_Quantity j)
 , GL.Transaction_Posting t
   ~ Chart.Charted (Format.Journal_Account j)
                   (Format.Journal_Posting j)
 , Format.Journal_Transaction j ~ GL.Transaction_Line t
 , GL.Posting_Quantity (Chart.Charted (Format.Journal_Account j)
                       (Format.Journal_Posting j))
   ~ Map (Format.Journal_Unit j)
         (Polarized (Format.Journal_Quantity j))
 , GL.Posting_Quantity (Format.Journal_Posting j)
   ~ Map (Format.Journal_Unit j)
         (Polarized (Format.Journal_Quantity j))
 -- , GL.Posting_Account t ~ Format.Journal_Account j
 -- , Leijen.Table.Cell_of_forall_param j (TreeMap.Path as)
 , Leijen.Table.Cell_of_forall_param j Date
 , Leijen.Table.Cell_of_forall_param j Text
 , Ord (Format.Journal_Unit j)
 , GL.Transaction t
 ) => Format.Journal_Leijen_Table_Cells j (GL.GL t) where
	journal_leijen_table_cells jnl =
		flip (TreeMap.foldr_with_Path
		 (\account ->
			flip $ Map.foldrWithKey
			 (\date ->
				flip $ foldr
				 (\GL.GL_Line
					 { GL.gl_line_transaction = t
					 , GL.gl_line_posting     = p
					 , GL.gl_line_sum         = s
					 } ->
					flip (Map.foldrWithKey
					 (\unit qty ->
						let ms = Map.lookup unit s in
						zipWith (:)
						 [ cell_of account
						 , cell_of date
						 , cell_of $ (unit,) <$> Polarize.polarizable_positive qty
						 , cell_of $ (unit,) <$> Polarize.polarizable_negative qty
						 , cell_of $ (unit,) <$> (ms >>= Polarize.polarized_positive)
						 , cell_of $ (unit,) <$> (ms >>= Polarize.polarized_negative)
						 , cell_of $ (unit,) . Polarize.depolarize <$> ms
						 , cell_of $ journal_transaction_wording jnl t
						 ]
					 ))
					 (journal_posting_amounts jnl $ Chart.charted p)
				 )
			 )
		 )) $
		 (\(GL.GL x) -> x)
		 (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_GL) () where
	journal_leijen_table_cells
	 (Const (Forall_Journal_GL j)) =
		Format.journal_leijen_table_cells j
























{-
-- Instances GL.GL -> GL.Expanded

instance
 ( Functor j
 , Journal_GL_Expanded j (GL.Expanded t)
 
 -- NOTE: constraint from GL.expanded
 , GL.Transaction t
 ) => Format.Journal_Wrap (j (GL.GL t))
                          Forall_Journal_GL_Expanded where
	journal_wrap =
		Forall_Journal_GL_Expanded .
		fmap GL.expanded

instance Format.Journal_Wrap Forall_Journal_GL
                             Forall_Journal_GL_Expanded where
	journal_wrap (Forall_Journal_GL j) = Format.journal_wrap j
-}
{-
-- * 'GL.GL_Expanded'

-- ** Type 'Format_GL_Expanded'

type Format_Journal_GL_Expanded
 = Format
   (   JCC.Journal GL_Expanded_JCC)
   (Ledger.Journal GL_Expanded_Ledger)

-- JCC
type GL_Expanded_JCC
 = GL.Expanded (JCC.Charted JCC.Transaction)
instance Format.Journal (JCC.Journal GL_Expanded_JCC) where
	type Journal_Format   (JCC.Journal GL_Expanded_JCC)
	 = Format_Journal_GL_Expanded
	journal_format = Format_JCC

-- Ledger
type GL_Expanded_Ledger
 = GL.Expanded (Ledger.Charted Ledger.Transaction)
instance Format.Journal (Ledger.Journal GL_Expanded_Ledger) where
	type Journal_Format   (Ledger.Journal GL_Expanded_Ledger)
	 = Format_Journal_GL_Expanded
	journal_format = Format_Ledger

-- ** Class 'Journal_GL_Expanded'

class
 ( Format.Journal (j m)
 , Format.Journal_Format (j m) ~ Format_Journal_GL_Expanded
 -- , Format.Journal_Leijen_Table_Cells j m
 , Format.Journal_Filter Context j m
 ) => Journal_GL_Expanded j m where
	journal_posting_amounts
	 :: j m
	 -> Format.Journal_Posting j
	 -> Map (Format.Journal_Unit j)
	        (Format.Journal_Quantity j)
	journal_posting_amounts_set
	 :: j m
	 -> Map (Format.Journal_Unit j)
	        (Format.Journal_Quantity j)
	 -> Format.Journal_Posting j
	 -> Format.Journal_Posting j

instance Journal_GL_Expanded    JCC.Journal GL_Expanded_JCC
 where
	journal_posting_amounts     _j = JCC.posting_amounts
	journal_posting_amounts_set _j posting_amounts p =
		p { JCC.posting_amounts }
instance Journal_GL_Expanded Ledger.Journal GL_Expanded_Ledger
 where
	journal_posting_amounts     _j = Ledger.posting_amounts
	journal_posting_amounts_set _j posting_amounts p =
		p { Ledger.posting_amounts }

-- ** Type 'Forall_Journal_GL_Expanded'

data    Forall_Journal_GL_Expanded
 = forall j m. Journal_GL_Expanded  j m
 =>     Forall_Journal_GL_Expanded (j m)

instance Format.Journal Forall_Journal_GL_Expanded where
	type Journal_Format   Forall_Journal_GL_Expanded = Format_Journal_GL_Expanded
	journal_format
	 (Forall_Journal_GL_Expanded j) =
		Format.journal_format j

-- Instances 'Format.Journal_Filter'

instance
 ( Functor j
 , Format.Journal_Chart j
 , Journal_GL_Expanded j (GL.Expanded t)
 , GL.Transaction t
 , Format.Journal_Account_Section j ~ Text
 , GL.Transaction_Posting t ~ Chart.Charted (Format.Journal_Account j) (Format.Journal_Posting j)
 , GL.Posting_Quantity (GL.Transaction_Posting t)
   ~ Map (Format.Journal_Unit j) (Polarized (Format.Journal_Quantity j))
 , Format.Journal_Quantity j ~ Decimal
 , Format.Journal_Account_Section j
   ~ Account.Account_Section (GL.Posting_Account (GL.Transaction_Posting t))
 , Ord (Format.Journal_Unit j)
 , Unit.Unit (Format.Journal_Unit j)
 ) => Format.Journal_Filter Context j (GL.Expanded t) where
	journal_filter ctx j =
		GL.Expanded .
		TreeMap.map_Maybe_with_Path
		 (\acct expanded_lines ->
			let chart = Format.journal_chart j in
			case Map.mapMaybeWithKey
			 (\date seq_lines ->
				case foldMap
				 (\line@GL.GL_Line
				 { GL.gl_line_transaction = _t
				 , GL.gl_line_posting     = Chart.Charted ch p
				 , GL.gl_line_sum         = s
				 } ->
					Map.foldlWithKey
					 (\acc unit qty ->
						let sqty = (Map.!) s unit in
						if Filter.test (ctx_filter_gl ctx)
						 ( (Chart.account_tags acct chart, acct)
						 , date
						 , (unit, Polarize.polarize qty)
						 , (unit, sqty)
						 )
						then (Seq.|>) acc line
						 { GL.gl_line_posting =
							Chart.Charted ch $
							journal_posting_amounts_set j
							 (Map.singleton unit qty) p
						 , GL.gl_line_sum = Map.singleton unit sqty
						 }
						else acc
					 )
					 Seq.empty
					 (journal_posting_amounts j p)
				 ) seq_lines
				 of
				 m | Seq.null m -> Nothing
				 m -> Just m
			 )
			 (GL.inclusive expanded_lines)
			 of
				m | Map.null m -> Strict.Nothing
				m -> Strict.Just $ expanded_lines { GL.inclusive=m }
		 ) .
		(\(GL.Expanded gl) -> gl) <$> j

instance Format.Journal_Filter Context (Const Forall_Journal_GL_Expanded) () where
	journal_filter ctx
	 (Const (Forall_Journal_GL_Expanded j)) =
		Const $ Forall_Journal_GL_Expanded $
		Format.journal_filter ctx j
-}

{-
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, args)
	read_journals <-
		liftM partitionEithers $ do
		CLI.Env.paths c $ ctx_input ctx ++ inputs
		>>= do
			mapM $ \path -> do
				liftIO $ runExceptT $ Ledger.Read.file
				 (Ledger.Read.context ( ctx_filter_transaction ctx
				                      , ctx_filter_posting     ctx )
				                      Ledger.journal)
				 path
				>>= \x -> case x of
				 Left  ko -> return $ Left (path, ko)
				 Right ok -> return $ Right ok
	case read_journals of
	 (errs@(_:_), _journals) ->
		forM_ errs $ \(_path, err) -> do
			Write.fatal c $ err
	 ([], journals) -> do
		Write.debug c $ "filter: transaction: " ++ show (ctx_filter_transaction ctx)
		Write.debug c $ "filter: posting: " ++ show (ctx_filter_posting ctx)
		Write.debug c $ "filter: gl: " ++ show (ctx_filter_gl ctx)
		let (amount_styles, gl) = ledger_gl ctx journals
		let lang = C.lang c
		Write.write c Write.style (ctx_output ctx) $ do
		toDoc () $ do
		zipWith id
		 [ Table.column (Lang.translate lang Lang.Title_Account)         Table.Align_Left
		 , Table.column (Lang.translate lang Lang.Title_Date)            Table.Align_Left
		 , Table.column (Lang.translate lang Lang.Title_Debit)           Table.Align_Right
		 , Table.column (Lang.translate lang Lang.Title_Credit)          Table.Align_Right
		 , Table.column (Lang.translate lang Lang.Title_Running_debit)   Table.Align_Right
		 , Table.column (Lang.translate lang Lang.Title_Running_credit)  Table.Align_Right
		 , Table.column (Lang.translate lang Lang.Title_Running_balance) Table.Align_Right
		 , Table.column (Lang.translate lang Lang.Title_Description)     Table.Align_Left
		 ] $ do
		write_gl amount_styles gl (repeat [])
-}

{-
ledger_gl
 :: Context
 -> [ Ledger.Journal (GL.GL (Ledger.Charted Ledger.Transaction)) ]
 -> ( Ledger.Amount.Styles
    , GL (Ledger.Charted Ledger.Transaction)
    )
ledger_gl ctx journals =
	let (_chart, amount_styles, gl) =
		foldl'
		 (flip (\j ->
			flip mappend $
			( Ledger.journal_chart j
			, Ledger.journal_amount_styles j
			, ) $
			Ledger.Journal.fold
			 (\Ledger.Journal
				 { Ledger.journal_sections=g
				 } -> mappend g
			 ) j mempty
		 ))
		 mempty journals in
	(amount_styles,) $
	GL.GL $
	TreeMap.map_Maybe_with_Path
	 (\acct expanded_lines ->
		case Map.mapMaybeWithKey
		 (\date seq_lines ->
			case foldMap
			 (\line@GL.GL_Line
			 { GL.gl_line_transaction = _t
			 , GL.gl_line_posting     = Ledger.Charted c p
			 , GL.gl_line_sum         = s
			 } ->
				Map.foldlWithKey
				 (\acc unit qty ->
					let sqty = (Map.!) s unit in
					if Filter.test (ctx_filter_gl ctx)
					 ( (Chart.account_tags acct c, acct)
					 , date
					 , (unit, Polarize.polarize qty)
					 , (unit, sqty)
					 )
					then (Seq.|>) acc line
					 { GL.gl_line_posting = Ledger.Charted c p
						 { Ledger.posting_amounts = Map.singleton unit qty }
					 , GL.gl_line_sum = Map.singleton unit sqty
					 }
					else acc
				 )
				 Seq.empty
				 (Ledger.posting_amounts p)
			 ) seq_lines of
			 m | Seq.null m -> Nothing
			 m -> Just m
		 )
		 (GL.inclusive expanded_lines) of
			m | Map.null m -> Strict.Nothing
			m -> Strict.Just m
		) $
	GL.expanded gl

write_gl
 :: Ledger.Amount.Styles
 -> GL (Ledger.Charted Ledger.Transaction)
 -> [[Table.Cell]]
 -> [[Table.Cell]]
write_gl amount_styles (GL gl) =
	flip (TreeMap.foldr_with_Path
	 (\acct ->
		flip $ Map.foldrWithKey
		 (\date ->
			flip (foldr
			 (\GL.GL_Line
				 { GL.gl_line_transaction = Ledger.Charted _ t
				 , GL.gl_line_posting     = Ledger.Charted _ p
				 , GL.gl_line_sum         = s
				 } ->
				flip (Map.foldrWithKey
				 (\unit qty ->
					let ms = Map.lookup unit s in
					zipWith (:)
						[ let ptype = Ledger.Posting_Type_Regular in
							Table.cell
							 { Table.cell_content = Ledger.Write.account        ptype acct
							 , Table.cell_width   = Ledger.Write.account_length ptype acct
							 }
						, Table.cell
						 { Table.cell_content = Date.Write.date        date
						 , Table.cell_width   = Date.Write.date_length date
						 }
						, cell_amount unit (Polarize.polarizable_positive qty)
						, cell_amount unit (Polarize.polarizable_negative qty)
						, cell_amount unit (ms >>= Polarize.polarized_positive)
						, cell_amount unit (ms >>= Polarize.polarized_negative)
						, cell_amount unit (liftM Polarize.depolarize ms)
						, let descr = Ledger.transaction_wording t in
							Table.cell
							 { Table.cell_content = toDoc ()    descr
							 , Table.cell_width   = Text.length descr
							 }
						]
				 ))
				 (Ledger.posting_amounts p)
			 ))
		 )
	 ))
	 gl
	where
		cell_amount :: Ledger.Unit -> Maybe Ledger.Quantity -> Table.Cell
		cell_amount unit mq =
			case mq of
			 Nothing -> Table.cell
			 Just q ->
				let a  = Ledger.Amount.Amount unit q in
				let sa = Ledger.Amount.style amount_styles a in
				Table.cell
				 { Table.cell_content = Amount.Write.amount        sa
				 , Table.cell_width   = Amount.Write.amount_length sa
				 }
-}