]> Git — Sourcephile - comptalang.git/blob - cli/Hcompta/CLI/Format/Ledger.hs
Modif : {Balance.Amount_Sum => Amount.Sum}.
[comptalang.git] / 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 (guard)
11 import qualified Data.List
12 import qualified Data.Text.Lazy as TL
13 import System.Environment as Env (getEnv)
14 import System.IO.Error (isDoesNotExistError)
15
16 import qualified Hcompta.Lib.Leijen as W
17 import Hcompta.Lib.Leijen (ToDoc(..))
18 import qualified Hcompta.Balance as Balance
19 import qualified Hcompta.CLI.Context as Context
20 import qualified Hcompta.CLI.Lang as Lang
21 import Hcompta.CLI.Lang (Lang)
22 import qualified Hcompta.CLI.Write as Write
23 import qualified Hcompta.Format.Ledger.Read as Ledger.Read
24 import qualified Hcompta.Format.Ledger.Write as Ledger.Write
25 import qualified Hcompta.Amount as Amount
26
27 -- | Return 'FilePath's containing 'Hcompta.Format.Ledger.Journal's:
28 --
29 -- * either those given if any,
30 -- * or the one in LEDGER_FILE environment variable if any,
31 -- * or the one in LEDGER environment variable if any.
32 paths :: Context.Context -> [FilePath] -> IO [FilePath]
33 paths context [] = do
34 tryJust (guard . isDoesNotExistError) $ Env.getEnv "LEDGER_FILE"
35 >>= \x -> case x of
36 Right ok -> return [ok]
37 Left _ko -> do
38 tryJust (guard . isDoesNotExistError) $ Env.getEnv "LEDGER"
39 >>= \xx -> case xx of
40 Right ok -> return [ok]
41 Left _ko -> do
42 let lang = Context.lang context
43 Write.fatal context $
44 toDoc lang $ Lang.Message_no_ledger_file_given
45 paths _context ps = return ps
46
47 instance ToDoc Lang Ledger.Read.Error where
48 toDoc lang err =
49 case err of
50 Ledger.Read.Error_date date -> toDoc lang date
51 Ledger.Read.Error_transaction_not_equilibrated tr unit_sums ->
52 i18n_transaction_not_equilibrated tr unit_sums
53 Lang.Message_the_following_transaction_is_not_equilibrated_because
54 Ledger.Read.Error_virtual_transaction_not_equilibrated tr unit_sums ->
55 i18n_transaction_not_equilibrated tr unit_sums
56 Lang.Message_the_following_virtual_transaction_is_not_equilibrated_because
57 Ledger.Read.Error_reading_file file_path exn ->
58 W.vsep $
59 [ toDoc lang $ Lang.Message_failed_to_read_file file_path
60 , W.text $ TL.pack $ show exn
61 ]
62 Ledger.Read.Error_including_file file_path errs ->
63 W.vsep $
64 [ toDoc lang $ Lang.Message_failed_to_include_file file_path
65 , toDoc lang errs
66 ]
67 where
68 i18n_transaction_not_equilibrated tr unit_sums msg =
69 W.vsep $
70 [ toDoc lang msg
71 , W.vsep $ Data.List.map
72 (\Balance.Unit_Sum{Balance.unit_sum_amount} ->
73 let amt = Amount.sum_balance unit_sum_amount in
74 toDoc lang $
75 Lang.Message_unit_sums_up_to_the_non_null_amount
76 (Amount.unit amt) amt
77 ) unit_sums
78 , W.space
79 , Ledger.Write.transaction tr
80 ]