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

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 ((++), replicate)
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 Context
import qualified Hcompta.CLI.Format.Ledger as CLI.Ledger
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_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_align = True
	 , ctx_reduce_date = True
	 , ctx_filter_transaction = mempty
	 }

usage :: IO String
usage = do
	bin <- Env.getProgName
	let pad = replicate (length bin) ' '
	return $unlines $
		[ "SYNTAX "
		, "  "++bin++" journal [-i FILE_JOURNAL]"
		, "  "++pad++"         [-t FILTER_TRANSACTION]"
		, "  "++pad++"         [FILE_JOURNAL] [...]"
		, ""
		, usageInfo "OPTIONS" options
		]

options :: Args.Options Ctx
options =
	[ Option "h" ["help"]
	 (NoArg (\_context _ctx -> do
		usage >>= IO.hPutStr IO.stderr
		exitSuccess))
	 "show this help"
	, Option "i" ["input"]
	 (ReqArg (\s _context ctx -> do
		return $ ctx{ctx_input=s:ctx_input ctx}) "FILE")
	 "read data from given file, multiple uses merge the data as would a concatenation do"
	, Option "" ["align"]
	 (OptArg (\arg context ctx -> do
		ctx_align <- case arg of
		 Nothing    -> return $ True
		 Just "yes" -> return $ True
		 Just "no"  -> return $ False
		 Just _     -> Write.fatal context $
			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 context ctx -> do
		ctx_reduce_date <- case arg of
		 Nothing    -> return $ True
		 Just "yes" -> return $ True
		 Just "no"  -> return $ False
		 Just _     -> Write.fatal context $
			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 context 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 context $ ko
			 Right ok -> do
				Write.debug context $ "filter: transaction: " ++ show ok
				return ok
		return $ ctx{ctx_filter_transaction}) "FILTER_TRANSACTION")
	 "filter at transaction level, multiple uses are merged with a logical AND"
	]

run :: Context.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)
		{- 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 context $ "filter: transaction: reducer: " ++ show reducer_date
		-}
		style_color <- Write.with_color context IO.stdout
		let sty = Ledger.Write.Style
			 { Ledger.Write.style_align = ctx_align ctx
			 , Ledger.Write.style_color
			 }
		let (_chart, journal) = ledger_journal ctx $ journals
		Ledger.Write.put sty IO.stdout $ 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