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

import           Control.Arrow (first)
import           Control.Monad (Monad(..), forM_, liftM, mapM)
import           Control.Monad.IO.Class (liftIO)
import           Control.Monad.Trans.Except (runExceptT)
import           Data.Bool
import           Data.Either (Either(..), partitionEithers)
import           Data.Foldable (Foldable(..))
import           Data.Functor (Functor(..), (<$>))
import           Data.List ((++))
import           Data.Maybe (Maybe(..))
import           Data.Monoid (Monoid(..), (<>))
import           Data.String (String)
import           Data.Tuple (snd)
import           Prelude (($), (.), FilePath, IO, 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           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.Filter.Reduce as Filter.Reduce
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.Format.Ledger.Write as Ledger.Write
import qualified Hcompta.Lib.Leijen as W
import qualified Hcompta.Journal as Journal

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

nil :: Ctx
nil =
	Ctx
	 { ctx_input = []
	 , ctx_output = []
	 , ctx_align = True
	 , ctx_reduce_date = True
	 , 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_Journal
		, ""
		, C.translate c Lang.Section_Syntax
		, "  "++bin++" journal ["++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 "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
	, Option "" ["align"]
	 (OptArg (\arg ctx -> do
		ctx_align <- case arg of
		 Nothing    -> return $ True
		 Just "yes" -> return $ True
		 Just "no"  -> return $ False
		 Just _     -> Write.fatal c $
			W.text "--align option expects \"yes\", or \"no\" as value"
		return $ ctx{ctx_align})
	  "[yes|no]")
	 "align output"
	{- 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 "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 c args = do
	(ctx, inputs) <-
		first (\x ->
			case ctx_output x of
			 [] -> x{ctx_output=[(Write.Mode_Append, "-")]}
			 _  -> x) <$>
		Args.parse c usage options (nil, args)
	read_journals <-
		liftM Data.Either.partitionEithers $ do
		CLI.Ledger.paths c $ 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 c $ err
	 ([], journals) -> do
		Write.debug c $ "filter: transaction: " ++ show (ctx_filter_transaction ctx)
		{- NOTE: not used so far
		let reducer_date =
			if ctx_reduce_date ctx
			then Filter.Reduce.bool_date <$> ctx_filter_transaction ctx
			else mempty
		Write.debug c $ "filter: transaction: reducer: " ++ show reducer_date
		-}
		let sty = Write.style{ Write.style_pretty = ctx_align ctx }
		let (_chart, journal) = ledger_journal ctx $ journals
		Write.write c sty (ctx_output ctx) $ do
		Ledger.Write.transactions $ fmap snd journal

ledger_journal
 :: Ctx
 -> [ Ledger.Journal (Journal.Journal (Chart, Ledger.Transaction)) ]
 -> (Chart, Journal.Journal (Chart, Ledger.Transaction))
ledger_journal _ctx =
	Data.Foldable.foldl'
	 (flip (\j ->
		flip mappend $
		(Ledger.journal_chart j,) $
		Ledger.Journal.fold
		 (\Ledger.Journal
			 { Ledger.journal_sections=t
			 } -> mappend t
		 ) j mempty
	 ))
	 mempty