{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
module Hcompta.CLI.Command.Print where

import           Control.Arrow (first)
import           Control.Applicative ((<$>))
import           Control.Monad.IO.Class (liftIO)
import           Control.Monad.Trans.Except (runExceptT)
import qualified Data.Either
import qualified Data.List
import qualified Data.Map.Strict as Data.Map
import qualified Data.Text.Lazy as TL
import           System.Console.GetOpt
                 ( ArgDescr(..)
                 , OptDescr(..)
                 , usageInfo )
import           System.Environment as Env (getProgName)
import           System.Exit (exitWith, ExitCode(..))
import qualified System.IO as IO

import qualified Hcompta.CLI.Args as Args
import qualified Hcompta.CLI.Context as Context
import qualified Hcompta.CLI.Write as Write
import qualified Hcompta.Calc.Balance as Balance
import qualified Hcompta.Format.Ledger.Balance as Ledger.Balance
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.Foldable as Lib.Foldable
import qualified Hcompta.Model.Journal
import qualified Hcompta.Model.Transaction as Transaction

data Ctx
 =   Ctx
 { ctx_input :: [FilePath]
 } deriving (Eq, Show)

nil :: Ctx
nil =
	Ctx
	 { ctx_input = []
	 }

usage :: IO String
usage = do
	bin <- Env.getProgName
	return $unlines $
		[ "SYNTAX "
		, "  "++bin++" print [option..]"
		, ""
		, usageInfo "OPTIONS" options
		]

options :: Args.Options Ctx
options =
	[ Option "h" ["help"]
	 (NoArg (\_ctx -> do
		usage >>= IO.hPutStr IO.stderr
		exitWith ExitSuccess))
	 "show this help"
	, Option "i" ["input"]
	 (ReqArg (\s ctx -> do
		return $ ctx{ctx_input=s:ctx_input ctx}) "FILE")
	 "read data from given file"
	]

run :: Context.Context -> [String] -> IO ()
run context args = do
	(ctx, _) <-
		first (\ctx -> ctx{ctx_input=reverse $ ctx_input ctx}) <$>
		Args.parse context usage options (nil, args)
	(flip mapM) (ctx_input ctx) $ \path -> do
		liftIO $ runExceptT $
			Ledger.Read.file path
		>>= \case
		 Left  ko -> return $ Left (path, ko)
		 Right ok -> return $ Right ok
	>>= return . Data.Either.partitionEithers
	>>= \case
	 (kos@(_:_), _oks) ->
		(flip mapM_) kos $ \(_path, ko) -> Write.fatal context ko
	 ([], journals) -> do
		with_color <- Write.with_color context IO.stdout
		case Lib.Foldable.find Ledger.Balance.equilibre journals of
		 Just ((tr, eq), path) ->
			Write.fatal context $ concat
			 [ "the following transaction is not equilibrated, because:"
			 , case eq of
				 Balance.Equilibre e | not $ Balance.is_equilibrable eq ->
					concat $ Data.Map.elems $ Data.Map.mapWithKey
					 (\unit Balance.Unit_Sum{Balance.amount} -> concat
						[ "\n- unit \""
						, TL.unpack $ Ledger.Write.show with_color $ Ledger.Write.unit unit
						, "\" sums up to the non-null amount: "
						, TL.unpack $ Ledger.Write.show with_color $ Ledger.Write.amount amount
						])
					 e
				 _ -> ""
			 , "\nin ", show $ Transaction.sourcepos tr
			 , concat $ map (\j -> "\nincluded by \"" ++ Ledger.Journal.file j ++ "\"") path
			 , ":\n", TL.unpack $ Ledger.Write.show with_color $
				Ledger.Write.transaction tr
			 ]
		 Nothing -> do
			let journal
				= Hcompta.Model.Journal.unions $
				Data.List.map Ledger.Journal.to_Model journals
			Ledger.Write.put with_color IO.stdout $ do
			Ledger.Write.journal journal