{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
module Hcompta.CLI.Command.Stats where

import           Control.Monad (Monad(..), forM_, liftM, mapM)
import           Control.Monad.IO.Class (liftIO)
import           Control.Monad.Trans.Except (runExceptT)
import           Data.Either (Either(..), partitionEithers)
import           Data.Foldable (Foldable(..))
import           Data.List ((++))
import qualified Data.Map.Strict as Data.Map
import           Data.Maybe (Maybe(..))
import           Data.Monoid (Monoid(..), (<>))
import           Data.Text (Text)
import           Data.String (String)
import           Prelude (($), (.), Bounded(..), FilePath, IO, Num(..), flip, unlines)
import           Text.Show (Show(..))
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 Hcompta.Amount.Unit as Amount.Unit
import           Hcompta.Chart (Chart)
import qualified Hcompta.CLI.Args as Args
import qualified Hcompta.CLI.Context as C
import qualified Hcompta.CLI.Format.Ledger as CLI.Ledger
import qualified Hcompta.CLI.Lang as Lang
import qualified Hcompta.CLI.Write as Write
-- import qualified Hcompta.Date as Date
import qualified Hcompta.Filter as Filter
import qualified Hcompta.Filter.Read as Filter.Read
import qualified Hcompta.Format.Ledger as Ledger
import qualified Hcompta.Format.Ledger.Journal as Ledger.Journal
import qualified Hcompta.Format.Ledger.Read as Ledger.Read
import qualified Hcompta.Lib.Interval as Interval
import qualified Hcompta.Lib.Leijen as W
import qualified Hcompta.Stats as Stats

data Ctx
 =   Ctx
 { ctx_input              :: [FilePath]
 , ctx_filter_transaction :: Filter.Simplified
                             (Filter.Filter_Bool
                             (Filter.Filter_Transaction
                             (Chart, Ledger.Transaction)))
 } deriving (Show)

nil :: Ctx
nil =
	Ctx
	 { ctx_input = []
	 , ctx_filter_transaction = mempty
	 }

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_Stats
		, ""
		, C.translate c Lang.Section_Syntax
		, "  "++bin++" stats ["++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 Ctx
options c =
	[ 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 "t" ["transaction-filter"]
	 (ReqArg (\s ctx -> do
		ctx_filter_transaction <-
			liftM ((ctx_filter_transaction ctx <>) . Filter.simplify) $
			liftIO $ Filter.Read.read Filter.Read.filter_transaction s
			>>= \f -> case f of
			 Left  ko -> Write.fatal c $ ko
			 Right ok -> do
				Write.debug c $ "filter: transaction: " ++ show ok
				return ok
		return $ ctx{ctx_filter_transaction}) $
		C.translate c Lang.Type_Filter_Transaction) $
		C.translate c Lang.Help_Option_Filter_Transaction
	]

run :: C.Context -> [String] -> IO ()
run context args = do
	(ctx, inputs) <- Args.parse context usage options (nil, args)
	read_journals <-
		liftM Data.Either.partitionEithers $ do
		CLI.Ledger.paths context $ ctx_input ctx ++ inputs
		>>= do
			mapM $ \path -> do
				liftIO $ runExceptT $ Ledger.Read.file
				 (Ledger.Read.context (ctx_filter_transaction 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 context $ err
	 ([], journals) -> do
		Write.debug context $ "filter: transaction: " ++ show (ctx_filter_transaction ctx)
		let (files, stats) = ledger_stats ctx journals
		style_color <- Write.with_color context IO.stdout
		W.displayIO IO.stdout $ do
		W.renderPretty style_color 1.0 maxBound $ do
		doc_stats context ctx (files, stats)

ledger_stats
 :: Ctx
 -> [ Ledger.Journal (Stats.Stats (Chart, Ledger.Transaction)) ]
 -> ([FilePath], Stats.Stats (Chart, Ledger.Transaction))
ledger_stats _ctx =
	Data.Foldable.foldl'
	 (flip (\j ->
		flip mappend $
		Ledger.Journal.fold
		 (\Ledger.Journal
			 { Ledger.journal_sections=s
			 , Ledger.journal_file=f
			 } -> mappend ([f], s)
		 ) j mempty
	 ))
	 mempty

doc_stats
 :: C.Context
 -> Ctx
 -> ([FilePath], Stats.Stats (Chart, Ledger.Transaction))
 -> W.Doc
doc_stats c _ctx (files, stats) =
	let lang = C.lang c in
	h Lang.Header_Accounts <>
	(W.toDoc () $ Data.Map.size $ Stats.stats_accounts stats) <>
		(let depth = Stats.stats_accounts_depths stats in
		W.line <> h Lang.Header_Accounts_Depth <>
		W.toDoc () (Interval.limit $ Interval.low  depth) <>
		(W.bold $ W.dullyellow "..") <>
		W.toDoc () (Interval.limit $ Interval.high depth)) <>
	W.line <>
	h Lang.Header_Transactions <>
	(W.toDoc () $ Stats.stats_transactions stats) <>
		(case Stats.stats_transactions_span stats of
		 Nothing -> W.empty
		 Just date ->
			W.line <> h Lang.Header_Transactions_Date <>
			W.toDoc lang (Interval.limit $ Interval.low  date) <>
			(W.bold $ W.dullyellow "..") <>
			W.toDoc lang (Interval.limit $ Interval.high date)) <>
	W.line <>
	h Lang.Header_Units <>
	(W.toDoc () (Data.Map.size $
		Data.Map.delete Amount.Unit.nil $
		Stats.stats_units stats)) <> W.line <>
	h Lang.Header_Journals <>
	W.toDoc () (length $ files) <> W.line <>
	h Lang.Header_Tags <>
		((W.toDoc () (Data.Foldable.foldr
		 (flip $ Data.Foldable.foldr (+)) 0 $
		Stats.stats_tags stats)) <>
		W.line <>
		h Lang.Header_Tags_Distinct <>
		W.toDoc () (Data.Map.size $ Stats.stats_tags stats)) <>
	W.line
	where
		h :: Lang.Translate t [Text] => t -> W.Doc
		h t =
			foldMap
			 (\s -> (W.bold $ W.dullblack (W.toDoc () s)) <> (W.bold $ W.dullyellow ":"))
			 (C.translate c t::[Text])