cli/Hcompta/CLI/Format/Ledger.hs

   1 {-# LANGUAGE NamedFieldPuns #-}
   2 module Hcompta.CLI.Format.Ledger where
   3
   4 import           Control.Exception (tryJust)
   5 import           Control.Monad (guard)
   6 import qualified Data.Map.Strict as Data.Map
   7 import qualified Data.Text.Lazy as TL
   8 import           System.Environment as Env (getEnv)
   9 import qualified System.IO as IO
  10 import           System.IO.Error (isDoesNotExistError)
  11
  12 import qualified Hcompta.Calc.Balance as Balance
  13 import qualified Hcompta.CLI.Context as Context
  14 import qualified Hcompta.CLI.Write as Write
  15 import qualified Hcompta.Format.Ledger as Ledger
  16 import qualified Hcompta.Format.Ledger.Balance as Ledger.Balance
  17 import qualified Hcompta.Format.Ledger.Journal as Ledger.Journal
  18 import qualified Hcompta.Format.Ledger.Write as Ledger.Write
  19 import qualified Hcompta.Lib.Foldable as Lib.Foldable
  20 import qualified Hcompta.Model.Transaction as Transaction
  21
  22 -- | Return 'FilePath's containing 'Hcompta.Format.Ledger.Journal's:
  23 --
  24 -- * either those given if any,
  25 -- * or the one in LEDGER_FILE environment variable if any,
  26 -- * or the one in LEDGER environment variable if any.
  27 paths :: Context.Context -> [FilePath] -> IO [FilePath]
  28 paths context [] = do
  29         tryJust (guard . isDoesNotExistError) $ Env.getEnv "LEDGER_FILE"
  30         >>= \x -> case x of
  31          Right ok -> return [ok]
  32          Left  _ko -> do
  33                 tryJust (guard . isDoesNotExistError) $ Env.getEnv "LEDGER"
  34                 >>= \xx -> case xx of
  35                  Right ok -> return [ok]
  36                  Left  _ko -> Write.fatal context $ concat
  37                          [ "no ledger file given, please use:"
  38                          , "\n - either -i FILE parameter,"
  39                          , "\n - or LEDGER_FILE environment variable."
  40                          ]
  41 paths _context ps = return ps
  42
  43 equilibre :: Context.Context -> [Ledger.Journal] -> IO ()
  44 equilibre context journals =
  45         case Lib.Foldable.find Ledger.Balance.check_equilibrium journals of
  46          Nothing -> return ()
  47          Just ((tr, deviation), path) -> do
  48                 with_color <- Write.with_color context IO.stdout
  49                 Write.fatal context $ concat
  50                  [ "the following transaction is not equilibrated, because:"
  51                  , case deviation of
  52                          Balance.Deviation dev | not $ Balance.is_equilibrium_inferrable deviation ->
  53                                 concat $ Data.Map.elems $ Data.Map.mapWithKey
  54                                  (\unit Balance.Unit_Sum{Balance.amount} -> concat
  55                                         [ "\n- unit \""
  56                                         , TL.unpack $ Ledger.Write.show with_color $ Ledger.Write.unit unit
  57                                         , "\" sums up to the non-null amount: "
  58                                         , TL.unpack $ Ledger.Write.show with_color $ Ledger.Write.amount amount
  59                                         ])
  60                                  dev
  61                          _ -> ""
  62                  , "\nin ", show $ Transaction.sourcepos tr
  63                  , concat $ map (\j -> "\nincluded by \"" ++ Ledger.Journal.file j ++ "\"") path
  64                  , ":\n", TL.unpack $ Ledger.Write.show with_color $
  65                         Ledger.Write.transaction tr
  66                  ]