{-# LANGUAGE NamedFieldPuns #-} module Hcompta.CLI.Format.Ledger where import Control.Exception (tryJust) import Control.Monad (guard) import qualified Data.Map.Strict as Data.Map import qualified Data.Text.Lazy as TL import System.Environment as Env (getEnv) import qualified System.IO as IO import System.IO.Error (isDoesNotExistError) import qualified Hcompta.Calc.Balance as Balance import qualified Hcompta.CLI.Context as Context import qualified Hcompta.CLI.Write as Write import qualified Hcompta.Format.Ledger as Ledger import qualified Hcompta.Format.Ledger.Write as Ledger.Write import qualified Hcompta.Lib.Foldable as Lib.Foldable -- | 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 -> Write.fatal context $ concat [ "no ledger file given, please use:" , "\n - either -i FILE parameter," , "\n - or LEDGER_FILE environment variable." ] paths _context ps = return ps {- equilibre :: Context.Context -> [Ledger.Journal] -> IO () equilibre context journals = case Lib.Foldable.find Ledger.Balance.check_equilibrium journals of Nothing -> return () Just ((tr, deviation), path) -> do with_color <- Write.with_color context IO.stdout Write.fatal context $ concat [ "the following transaction is not equilibrated, because:" , case deviation of Balance.Deviation dev | not $ Balance.is_equilibrium_inferrable deviation -> 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 ]) dev _ -> "" , "\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 ] -}