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