cli/Hcompta/CLI/Format/JCC.hs

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