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 TypeFamilies #-}
   8 {-# OPTIONS_GHC -fno-warn-orphans #-}
   9 module Hcompta.CLI.Format.JCC where
  10
  11 -- import           Control.DeepSeq (NFData)
  12 -- import           Control.Monad.Trans.Except (ExceptT(..))
  13 import           Data.Foldable (Foldable(..))
  14 import           Data.Function ((.))
  15 import qualified Data.List as List
  16 import qualified Data.Text as Text
  17 import qualified Data.Text.Lazy as TL
  18 import           Prelude (($))
  19 -- import           System.IO (IO)
  20 import           Text.Show (Show(..))
  21
  22 import           Hcompta.Date (Date)
  23 import qualified Hcompta.Balance as Balance
  24 -- import qualified Hcompta.CLI.Format as CLI.Format
  25 -- import           Hcompta.CLI.Format (Format(..))
  26 import qualified Hcompta.CLI.Lang as Lang
  27 import qualified Hcompta.Format.JCC as JCC
  28 import qualified Hcompta.Format.JCC.Amount as JCC.Amount
  29 import qualified Hcompta.Format.JCC.Amount.Write as JCC.Amount.Write
  30 import qualified Hcompta.Format.JCC.Read as JCC.Read
  31 import qualified Hcompta.Format.JCC.Write as JCC.Write
  32 -- import           Hcompta.Lib.Consable (Consable)
  33 import           Hcompta.Lib.Leijen (ToDoc(..))
  34 import qualified Hcompta.Lib.Leijen as W
  35 -- import qualified Hcompta.Lib.Parsec as Parsec
  36 import qualified Hcompta.Polarize as Polarize
  37 import qualified Hcompta.CLI.Lib.Leijen.Table as Leijen.Table
  38
  39 instance Lang.Translate JCC.Read.Error W.Doc where
  40         translate lang err =
  41                 case err of
  42                  JCC.Read.Error_date date -> toDoc lang date
  43                  JCC.Read.Error_transaction_not_equilibrated styles tr unit_sums ->
  44                         i18n_transaction_not_equilibrated styles tr unit_sums
  45                          Lang.Error_Transaction_The_following_transaction_is_not_equilibrated_because
  46                  JCC.Read.Error_reading_file file_path exn ->
  47                         W.vsep $
  48                          [ Lang.translate lang $ Lang.Error_Failed_to_read_file file_path
  49                          , W.text $ TL.pack $ show exn
  50                          ]
  51                  JCC.Read.Error_including_file file_path errs ->
  52                         W.vsep $
  53                          [ Lang.translate lang $ Lang.Error_Failed_to_include_file file_path
  54                          , Lang.translate lang errs
  55                          ]
  56                  JCC.Read.Error_account_anchor_unknown pos anchor ->
  57                         Lang.translate lang $ Lang.Error_Account_Anchor_unknown pos anchor
  58                  JCC.Read.Error_account_anchor_not_unique pos anchor ->
  59                         Lang.translate lang $ Lang.Error_Account_Anchor_is_not_unique pos anchor
  60                 where
  61                         i18n_transaction_not_equilibrated styles tr unit_sums msg =
  62                                 W.vsep $
  63                                  [ Lang.translate lang msg
  64                                  , W.vsep $ List.map
  65                                          (\(unit, Balance.Unit_Sum{Balance.unit_sum_quantity}) ->
  66                                                 Lang.translate lang $
  67                                                 Lang.Error_Transaction_JCC_Unit_sums_up_to_the_non_null_amount unit $
  68                                                 JCC.Amount.style styles $
  69                                                 JCC.Amount unit $
  70                                                 Polarize.depolarize unit_sum_quantity
  71                                          ) unit_sums
  72                                  , W.space
  73                                  , JCC.Write.transaction styles tr
  74                                  ]
  75
  76 instance Leijen.Table.Cell_of_forall_param JCC.Journal Date where
  77         cell_of_forall_param _ctx date =
  78                 Leijen.Table.cell
  79                  { Leijen.Table.cell_content = JCC.Write.date        date
  80                  , Leijen.Table.cell_width   = JCC.Write.date_length date
  81                  }
  82 instance Leijen.Table.Cell_of_forall_param JCC.Journal JCC.Account where
  83         cell_of_forall_param _ctx account =
  84                 Leijen.Table.cell
  85                  { Leijen.Table.cell_content = JCC.Write.account        account
  86                  , Leijen.Table.cell_width   = JCC.Write.account_length account
  87                  }
  88 instance Leijen.Table.Cell_of_forall_param JCC.Journal (JCC.Unit, JCC.Quantity) where
  89         cell_of_forall_param j (unit, qty) =
  90                 let sty = JCC.journal_amount_styles j in
  91                 let amt = JCC.Amount.Amount unit qty in
  92                 let sa  = JCC.Amount.style sty amt in
  93                 Leijen.Table.cell
  94                  { Leijen.Table.cell_content = JCC.Amount.Write.amount        sa
  95                  , Leijen.Table.cell_width   = JCC.Amount.Write.amount_length sa
  96                  }
  97 instance Leijen.Table.Cell_of_forall_param JCC.Journal JCC.Wording where
  98         cell_of_forall_param _j w =
  99                 Leijen.Table.cell
 100                  { Leijen.Table.cell_content = toDoc ()    w
 101                  , Leijen.Table.cell_width   = Text.length w
 102                  }
 103
 104 instance Foldable f => W.Leijen_of_forall_param JCC.Journal (f JCC.Transaction) where
 105         leijen_of_forall_param =
 106                 JCC.Write.transactions .
 107                 JCC.journal_amount_styles