{-# LANGUAGE BangPatterns #-}
{-# 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.Journal where

import           Control.Arrow ((+++))
import           Control.Monad (Monad(..), liftM, mapM)
import           Control.Monad.IO.Class (liftIO)
import           Data.Bool
import           Data.Either (Either(..), partitionEithers)
import           Data.Foldable (Foldable(..))
import           Data.Function (($), (.), on)
import           Data.Functor (Functor(..), (<$>))
import           Data.List ((++))
import           Data.Maybe (Maybe(..))
import           Data.Monoid (Monoid(..))
import           Data.String (String)
import           Prelude (Bounded(..), unlines)
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.CLI.Args as Args
import qualified Hcompta.CLI.Context as C
import qualified Hcompta.CLI.Env as CLI.Env
import qualified Hcompta.CLI.Format as Format
import           Hcompta.CLI.Format.JCC ()
import           Hcompta.CLI.Format.Ledger ()
import           Hcompta.CLI.Format (Format(..), Formats)
import qualified Hcompta.CLI.Lang as Lang
import qualified Hcompta.CLI.Write as Write
import qualified Hcompta.Chart as Chart
import qualified Hcompta.Posting as Posting
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.JCC.Write as JCC.Write
import qualified Hcompta.Format.Ledger       as Ledger
import qualified Hcompta.Format.Ledger.Write as Ledger
import qualified Hcompta.Journal as Journal
-- import           Hcompta.Lib.Consable (Consable(..))
import qualified Hcompta.Lib.Leijen as W
import qualified Hcompta.Lib.Parsec as R

data Context
 =   Context
 { ctx_input              :: [FilePath]
 , ctx_input_format       :: Formats
 , ctx_output             :: [(Write.Mode, FilePath)]
 , ctx_output_format      :: Maybe Formats
 , ctx_align              :: Bool
 , ctx_reduce_date        :: Bool
 , ctx_filter_transaction :: forall t.
                             ( Filter.Transaction t
                             , Filter.Amount_Quantity
                               (Posting.Posting_Amount
                               (Filter.Transaction_Posting t))
                               ~ Filter.Amount.Quantity
                             ) => Journal_Filter t
 }

context :: Context
context =
	Context
	 { ctx_input              = []
	 , ctx_input_format       = mempty
	 , ctx_output             = []
	 , ctx_output_format      = Nothing
	 , ctx_align              = True
	 , ctx_reduce_date        = True
	 , ctx_filter_transaction = Filter.Simplified $ Right 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_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 Context
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 "if" ["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 "of" ["output-format"]
	 (OptArg (\arg ctx -> do
		ctx_output_format <- case arg of
		 Nothing       -> return $ Just $ Format_JCC ()
		 Just "jcc"    -> return $ Just $ Format_JCC ()
		 Just "ledger" -> return $ Just $ Format_Ledger ()
		 Just _        -> Write.fatal c $
			W.text "--output-format option expects \"jcc\", or \"ledger\" as value"
		return $ ctx{ctx_output_format})
	  "[jcc|ledger]")
	  "input 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
	, 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" ["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
	]

run :: C.Context -> [String] -> IO ()
run c args = do
	(ctx, inputs) <- 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])) -> do
		with_color <- Write.with_color c IO.stdout
		W.displayIO IO.stdout $
			W.renderPretty with_color 1.0 maxBound $
			journal_write $ mconcat $
			Format.journal_flatten <$>
				case ctx_output_format ctx of
				 Nothing -> journals
				 Just f -> Format.journal_empty f:journals

-- * Type 'Format_Journal'

type Format_Journal
 = Format
   (   JCC.Journal Journal_JCC)
   (Ledger.Journal Journal_Ledger)

type Journal_JCC    = Journal.Journal (   JCC.Charted    JCC.Transaction)
type Journal_Ledger = Journal.Journal (Ledger.Charted Ledger.Transaction)

-- * Class 'Journal'

class Journal j where
	journal_write :: j -> W.Doc

instance Format.Journal (JCC.Journal Journal_JCC) where
	type Journal_Format   (JCC.Journal Journal_JCC) = Format_Journal
	journal_format = Format_JCC
instance Journal (JCC.Journal Journal_JCC) where
	journal_write j =
		JCC.Write.transactions (JCC.journal_amount_styles j) $
		fmap Chart.charted $
		JCC.journal_content j

instance Format.Journal (Ledger.Journal Journal_Ledger) where
	type Journal_Format   (Ledger.Journal Journal_Ledger) = Format_Journal
	journal_format = Format_Ledger
instance Journal (Ledger.Journal Journal_Ledger) where
	journal_write j =
		Ledger.write_transactions (Ledger.journal_amount_styles j) $
		fmap Chart.charted $
		Ledger.journal_content j

-- * Type 'Forall_Journal'

data Forall_Journal
 = forall j m. ( Journal (j m)
               , Format.Journal (j m)
               , Format.Journal_Read j
               , Format.Journal_Monoid (j m)
               , Format.Journal_Format (j m) ~ Format_Journal )
 => Forall_Journal (j m)

instance Format.Journal Forall_Journal where
	type Journal_Format   Forall_Journal = Format_Journal
	journal_format  (Forall_Journal j) = Format.journal_format j
instance Format.Journal_Empty Forall_Journal where
	journal_empty f =
		case f of
		 Format_JCC    () -> Forall_Journal (mempty::JCC.Journal Journal_JCC)
		 Format_Ledger () -> Forall_Journal (mempty::Ledger.Journal Journal_Ledger)

instance Format.Journal_Monoid Forall_Journal where
	journal_flatten (Forall_Journal j) = Forall_Journal $ Format.journal_flatten j
	journal_fold f  (Forall_Journal j) = Format.journal_fold (f . Forall_Journal) j
instance Journal Forall_Journal where
	journal_write (Forall_Journal j) = journal_write j
instance Monoid Forall_Journal where
	mempty = Forall_Journal (mempty::JCC.Journal Journal_JCC)
	mappend x y =
		case (mappend `on` Format.journal_format) x y of
		 Format_JCC    j -> Forall_Journal j
		 Format_Ledger j -> Forall_Journal j
	mconcat js =
		case js of
		 [] -> mempty
		 j:jn -> foldl' mappend j jn

type Journal_Filter transaction
 = Filter.Simplified
   (Filter.Filter_Bool
   (Filter.Filter_Transaction transaction))
type Journal_Read_Cons txn
 = txn -> Filter.Filtered (Journal_Filter txn) txn

journal_read
 :: Context -> FilePath
 -> IO (Either (Format.Message W.Doc) Forall_Journal)
journal_read ctx =
	case ctx_input_format ctx of
	 Format_JCC () ->
		let wrap (j::JCC.Journal Journal_JCC) = Forall_Journal 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 Journal_Ledger) = Forall_Journal 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