]> Git — Sourcephile - comptalang.git/blob - cli/Hcompta/CLI/Format/Ledger.hs
Correction : lens n'est pas nécessaire pour le moment
[comptalang.git] / cli / Hcompta / CLI / Format / Ledger.hs
1 {-# LANGUAGE NamedFieldPuns #-}
2 module Hcompta.CLI.Format.Ledger where
3
4 import Control.Exception (tryJust)
5 import Control.Monad (guard)
6 import qualified Data.Map.Strict as Data.Map
7 import qualified Data.Text.Lazy as TL
8 import System.Environment as Env (getEnv)
9 import qualified System.IO as IO
10 import System.IO.Error (isDoesNotExistError)
11
12 import qualified Hcompta.Calc.Balance as Balance
13 import qualified Hcompta.CLI.Context as Context
14 import qualified Hcompta.CLI.Write as Write
15 import qualified Hcompta.Format.Ledger as Ledger
16 import qualified Hcompta.Format.Ledger.Balance as Ledger.Balance
17 import qualified Hcompta.Format.Ledger.Journal as Ledger.Journal
18 import qualified Hcompta.Format.Ledger.Write as Ledger.Write
19 import qualified Hcompta.Lib.Foldable as Lib.Foldable
20 import qualified Hcompta.Model.Transaction as Transaction
21
22 -- | Return 'FilePath's containing 'Hcompta.Format.Ledger.Journal's:
23 --
24 -- * either those given if any,
25 -- * or the one in LEDGER_FILE environment variable if any,
26 -- * or the one in LEDGER environment variable if any.
27 paths :: Context.Context -> [FilePath] -> IO [FilePath]
28 paths context [] = do
29 tryJust (guard . isDoesNotExistError) $ Env.getEnv "LEDGER_FILE"
30 >>= \x -> case x of
31 Right ok -> return [ok]
32 Left _ko -> do
33 tryJust (guard . isDoesNotExistError) $ Env.getEnv "LEDGER"
34 >>= \xx -> case xx of
35 Right ok -> return [ok]
36 Left _ko -> Write.fatal context $ concat
37 [ "no ledger file given, please use:"
38 , "\n - either -i FILE parameter,"
39 , "\n - or LEDGER_FILE environment variable."
40 ]
41 paths _context ps = return ps
42
43 equilibre :: Context.Context -> [Ledger.Journal] -> IO ()
44 equilibre context journals =
45 case Lib.Foldable.find Ledger.Balance.equilibre journals of
46 Nothing -> return ()
47 Just ((tr, eq), path) -> do
48 with_color <- Write.with_color context IO.stdout
49 Write.fatal context $ concat
50 [ "the following transaction is not equilibrated, because:"
51 , case eq of
52 Balance.Equilibre e | not $ Balance.is_equilibrable eq ->
53 concat $ Data.Map.elems $ Data.Map.mapWithKey
54 (\unit Balance.Unit_Sum{Balance.amount} -> concat
55 [ "\n- unit \""
56 , TL.unpack $ Ledger.Write.show with_color $ Ledger.Write.unit unit
57 , "\" sums up to the non-null amount: "
58 , TL.unpack $ Ledger.Write.show with_color $ Ledger.Write.amount amount
59 ])
60 e
61 _ -> ""
62 , "\nin ", show $ Transaction.sourcepos tr
63 , concat $ map (\j -> "\nincluded by \"" ++ Ledger.Journal.file j ++ "\"") path
64 , ":\n", TL.unpack $ Ledger.Write.show with_color $
65 Ledger.Write.transaction tr
66 ]