cli/Hcompta/CLI/Format/Ledger.hs

   1 {-# LANGUAGE FlexibleContexts #-}
   2 {-# LANGUAGE FlexibleInstances #-}
   3 {-# LANGUAGE MultiParamTypeClasses #-}
   4 {-# LANGUAGE NamedFieldPuns #-}
   5 {-# LANGUAGE OverloadedStrings #-}
   6 {-# OPTIONS_GHC -fno-warn-orphans #-}
   7 module Hcompta.CLI.Format.Ledger where
   8
   9 import           Control.Exception (tryJust)
  10 import           Control.Monad (Monad(..), guard)
  11 import           Data.Either (Either(..))
  12 import qualified Data.List as List
  13 import qualified Data.Text.Lazy as TL
  14 import           Prelude (($), (.), FilePath, IO)
  15 import           System.Environment as Env (getEnv)
  16 import           System.IO.Error (isDoesNotExistError)
  17 import           Text.Show (Show(..))
  18
  19 import qualified Hcompta.Balance as Balance
  20 import qualified Hcompta.CLI.Context as C
  21 import qualified Hcompta.CLI.Lang as Lang
  22 import qualified Hcompta.CLI.Write as Write
  23 import qualified Hcompta.Format.Ledger as Ledger
  24 import qualified Hcompta.Format.Ledger.Amount as Ledger.Amount
  25 import qualified Hcompta.Format.Ledger.Read as Ledger.Read
  26 import qualified Hcompta.Format.Ledger.Write as Ledger.Write
  27 import           Hcompta.Lib.Leijen (ToDoc(..))
  28 import qualified Hcompta.Lib.Leijen as W
  29 import qualified Hcompta.Polarize as Polarize
  30
  31 -- | Return 'FilePath's containing 'Hcompta.Format.Ledger.Journal's:
  32 --
  33 -- * either those given if any,
  34 -- * or the one in LEDGER_FILE environment variable if any,
  35 -- * or the one in LEDGER environment variable if any.
  36 paths :: C.Context -> [FilePath] -> IO [FilePath]
  37 paths c [] = do
  38         tryJust (guard . isDoesNotExistError) $ Env.getEnv "LEDGER_FILE"
  39         >>= \x -> case x of
  40          Right ok -> return [ok]
  41          Left  _ko -> do
  42                 tryJust (guard . isDoesNotExistError) $ Env.getEnv "LEDGER"
  43                 >>= \xx -> case xx of
  44                  Right ok  -> return [ok]
  45                  Left  _ko -> Write.fatal c Lang.Error_No_input_file_given
  46 paths _c ps = return ps
  47
  48 instance Lang.Translate Ledger.Read.Error W.Doc where
  49         translate lang err =
  50                 case err of
  51                  Ledger.Read.Error_date date -> toDoc lang date
  52                  Ledger.Read.Error_transaction_not_equilibrated styles tr unit_sums ->
  53                         i18n_transaction_not_equilibrated styles tr unit_sums
  54                          Lang.Error_Transaction_The_following_transaction_is_not_equilibrated_because
  55                  Ledger.Read.Error_virtual_transaction_not_equilibrated styles tr unit_sums ->
  56                         i18n_transaction_not_equilibrated styles tr unit_sums
  57                          Lang.Error_Transaction_The_following_virtual_transaction_is_not_equilibrated_because
  58                  Ledger.Read.Error_reading_file file_path exn ->
  59                         W.vsep $
  60                          [ Lang.translate lang $ Lang.Error_Failed_to_read_file file_path
  61                          , W.text $ TL.pack $ show exn
  62                          ]
  63                  Ledger.Read.Error_including_file file_path errs ->
  64                         W.vsep $
  65                          [ Lang.translate lang $ Lang.Error_Failed_to_include_file file_path
  66                          , Lang.translate lang errs
  67                          ]
  68                 where
  69                         i18n_transaction_not_equilibrated styles tr unit_sums msg =
  70                                 W.vsep $
  71                                  [ Lang.translate lang msg
  72                                  , W.vsep $ List.map
  73                                          (\(unit, Balance.Unit_Sum{Balance.unit_sum_quantity}) ->
  74                                                 Lang.translate lang $
  75                                                 Lang.Error_Transaction_Unit_sums_up_to_the_non_null_amount unit $
  76                                                 Ledger.Amount.style styles $
  77                                                 Ledger.Amount unit $
  78                                                 Polarize.depolarize unit_sum_quantity
  79                                          ) unit_sums
  80                                  , W.space
  81                                  , Ledger.Write.transaction styles tr
  82                                  ]