{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Hcompta.CLI.Format.Ledger where

import           Control.Exception (tryJust)
import           Control.Monad (Monad(..), guard)
import           Data.Either (Either(..))
import qualified Data.List
import qualified Data.Text.Lazy as TL
import           Prelude (($), (.), FilePath, IO)
import           System.Environment as Env (getEnv)
import           System.IO.Error (isDoesNotExistError)
import           Text.Show (Show(..))

import qualified Hcompta.Amount as Amount
import qualified Hcompta.Balance as Balance
import qualified Hcompta.CLI.Context as Context
import           Hcompta.CLI.Lang (Lang)
import qualified Hcompta.CLI.Lang as Lang
import qualified Hcompta.CLI.Write as Write
import qualified Hcompta.Format.Ledger.Read as Ledger.Read
import qualified Hcompta.Format.Ledger.Write as Ledger.Write
import           Hcompta.Lib.Leijen (ToDoc(..))
import qualified Hcompta.Lib.Leijen as W

-- | Return 'FilePath's containing 'Hcompta.Format.Ledger.Journal's:
--
-- * either those given if any,
-- * or the one in LEDGER_FILE environment variable if any,
-- * or the one in LEDGER environment variable if any.
paths :: Context.Context -> [FilePath] -> IO [FilePath]
paths context [] = do
	tryJust (guard . isDoesNotExistError) $ Env.getEnv "LEDGER_FILE"
	>>= \x -> case x of
	 Right ok -> return [ok]
	 Left  _ko -> do
		tryJust (guard . isDoesNotExistError) $ Env.getEnv "LEDGER"
		>>= \xx -> case xx of
		 Right ok -> return [ok]
		 Left  _ko -> do
			let lang = Context.lang context
			Write.fatal context $
				toDoc lang $ Lang.Message_no_ledger_file_given
paths _context ps = return ps

instance ToDoc Lang Ledger.Read.Error where
	toDoc lang err =
		case err of
		 Ledger.Read.Error_date date -> toDoc lang date
		 Ledger.Read.Error_transaction_not_equilibrated tr unit_sums ->
			i18n_transaction_not_equilibrated tr unit_sums
			 Lang.Message_the_following_transaction_is_not_equilibrated_because
		 Ledger.Read.Error_virtual_transaction_not_equilibrated tr unit_sums ->
			i18n_transaction_not_equilibrated tr unit_sums
			 Lang.Message_the_following_virtual_transaction_is_not_equilibrated_because
		 Ledger.Read.Error_reading_file file_path exn ->
			W.vsep $
			 [ toDoc lang $ Lang.Message_failed_to_read_file file_path
			 , W.text $ TL.pack $ show exn
			 ]
		 Ledger.Read.Error_including_file file_path errs ->
			W.vsep $
			 [ toDoc lang $ Lang.Message_failed_to_include_file file_path
			 , toDoc lang errs
			 ]
		where
			i18n_transaction_not_equilibrated tr unit_sums msg =
				W.vsep $
				 [ toDoc lang msg
				 , W.vsep $ Data.List.map
					 (\Balance.Unit_Sum{Balance.unit_sum_amount} ->
						let amt = Amount.sum_balance unit_sum_amount in
						toDoc lang $
						Lang.Message_unit_sums_up_to_the_non_null_amount
						 (Amount.unit amt) amt
					 ) unit_sums
				 , W.space
				 , Ledger.Write.transaction tr
				 ]