{-# 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 (guard) import qualified Data.List import qualified Data.Text.Lazy as TL import System.Environment as Env (getEnv) import System.IO.Error (isDoesNotExistError) import qualified Hcompta.Lib.Leijen as W import Hcompta.Lib.Leijen (ToDoc(..)) import qualified Hcompta.Balance as Balance import qualified Hcompta.CLI.Context as Context import qualified Hcompta.CLI.Lang as Lang import Hcompta.CLI.Lang (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 qualified Hcompta.Amount as Amount -- | 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 = Balance.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 ]