]> Git — Sourcephile - comptalang.git/blob - cli/Hcompta/CLI/Format/JCC.hs
Adapte hcompta-cli.
[comptalang.git] / 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