cli/Hcompta/CLI/Format/Ledger.hs

   1 {-# LANGUAGE FlexibleContexts #-}
   2 {-# LANGUAGE FlexibleInstances #-}
   3 {-# LANGUAGE MultiParamTypeClasses #-}
   4 {-# LANGUAGE NamedFieldPuns #-}
   5 {-# LANGUAGE OverloadedStrings #-}
   6 {-# LANGUAGE RecordWildCards #-}
   7 {-# LANGUAGE TypeFamilies #-}
   8 {-# OPTIONS_GHC -fno-warn-orphans #-}
   9 module Hcompta.CLI.Format.Ledger where
  10
  11 import           Data.Foldable (Foldable(..))
  12 import           Data.Function (($), (.))
  13 import qualified Data.List as List
  14 import qualified Data.Text as Text
  15 import qualified Data.Text.Lazy as TL
  16 import           Text.Show (Show(..))
  17 import           Text.WalderLeijen.ANSI.Text (ToDoc(..))
  18 import qualified Text.WalderLeijen.ANSI.Text as W
  19
  20 import qualified Hcompta as H
  21 import qualified Hcompta.Ledger as Ledger
  22
  23 import qualified Hcompta.CLI.Lang as Lang
  24 import qualified Hcompta.CLI.Lib.Leijen.Table as Leijen.Table
  25
  26 instance Lang.Translate Ledger.Error_Read W.Doc where
  27         translate lang err =
  28                 case err of
  29                  Ledger.Error_Read_date date -> toDoc lang date
  30                  Ledger.Error_Read_transaction_not_equilibrated styles tr unit_sums ->
  31                         i18n_transaction_not_equilibrated styles tr unit_sums
  32                          Lang.Error_Transaction_The_following_transaction_is_not_equilibrated_because
  33                  Ledger.Error_Read_virtual_transaction_not_equilibrated styles tr unit_sums ->
  34                         i18n_transaction_not_equilibrated styles tr unit_sums
  35                          Lang.Error_Transaction_The_following_virtual_transaction_is_not_equilibrated_because
  36                  Ledger.Error_Read_reading_file file_path exn ->
  37                         W.vsep $
  38                          [ Lang.translate lang $ Lang.Error_Failed_to_read_file file_path
  39                          , W.text $ TL.pack $ show exn
  40                          ]
  41                  Ledger.Error_Read_including_file file_path errs ->
  42                         W.vsep $
  43                          [ Lang.translate lang $ Lang.Error_Failed_to_include_file file_path
  44                          , Lang.translate lang errs
  45                          ]
  46                 where
  47                         i18n_transaction_not_equilibrated styles tr unit_sums msg =
  48                                 W.vsep $
  49                                  [ Lang.translate lang msg
  50                                  , W.vsep $ List.map
  51                                          (\(unit, H.Balance_by_Unit_Sum{..}) ->
  52                                                 Lang.translate lang $
  53                                                 Lang.Error_Transaction_Ledger_Unit_sums_up_to_the_non_null_amount unit $
  54                                                 Ledger.amount_styled styles $
  55                                                 Ledger.Amount unit $
  56                                                 H.depolarize balance_by_unit_sum_quantity
  57                                          ) unit_sums
  58                                  , W.space
  59                                  , Ledger.write_transaction styles tr
  60                                  ]
  61
  62 instance Leijen.Table.Cell_of_forall_param Ledger.Journal H.Date where
  63         cell_of_forall_param _ctx date =
  64                 Leijen.Table.cell
  65                  { Leijen.Table.cell_content = Ledger.write_date        date
  66                  , Leijen.Table.cell_width   = Ledger.write_date_length date
  67                  }
  68 instance Leijen.Table.Cell_of_forall_param Ledger.Journal Ledger.Account where
  69         cell_of_forall_param _ctx account =
  70                 let posting_type = Ledger.Posting_Type_Regular in
  71                 Leijen.Table.cell
  72                  { Leijen.Table.cell_content = Ledger.write_account        posting_type account
  73                  , Leijen.Table.cell_width   = Ledger.write_account_length posting_type account
  74                  }
  75 instance Leijen.Table.Cell_of_forall_param Ledger.Journal (Ledger.Unit, Ledger.Quantity) where
  76         cell_of_forall_param j (unit, qty) =
  77                 let sty = Ledger.journal_amount_styles j in
  78                 let amt = Ledger.Amount unit qty in
  79                 let sa  = Ledger.amount_styled sty amt in
  80                 Leijen.Table.cell
  81                  { Leijen.Table.cell_content = Ledger.write_amount        sa
  82                  , Leijen.Table.cell_width   = Ledger.write_amount_length sa
  83                  }
  84 instance Leijen.Table.Cell_of_forall_param Ledger.Journal Ledger.Wording where
  85         cell_of_forall_param _j w =
  86                 Leijen.Table.cell
  87                  { Leijen.Table.cell_content = toDoc ()    w
  88                  , Leijen.Table.cell_width   = Text.length w
  89                  }
  90
  91 instance Foldable f => W.ToDoc1 Ledger.Journal (f Ledger.Transaction) where
  92         toDoc1 =
  93                 Ledger.write_transactions .
  94                 Ledger.journal_amount_styles